lisp/net/soap-inspect.el

   1 ;;; soap-inspect.el --- Interactive WSDL inspector    -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2010-2016 Free Software Foundation, Inc.
   4
   5 ;; Author: Alexandru Harsanyi <AlexHarsanyi@gmail.com>
   6 ;; Created: October 2010
   7 ;; Keywords: soap, web-services, comm, hypermedia
   8 ;; Package: soap-client
   9 ;; Homepage: https://github.com/alex-hhh/emacs-soap-client
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; GNU Emacs is free software: you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation, either version 3 of the License, or
  16 ;; (at your option) any later version.
  17
  18 ;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  25
  26 ;;; Commentary:
  27 ;;
  28 ;; This package provides an inspector for a WSDL document loaded with
  29 ;; `soap-load-wsdl' or `soap-load-wsdl-from-url'.  To use it, evaluate:
  30 ;;
  31 ;; (soap-inspect *wsdl*)
  32 ;;
  33 ;; This will pop-up the inspector buffer.  You can click on ports, operations
  34 ;; and types to explore the structure of the wsdl document.
  35 ;;
  36
  37 \f
  38 ;;; Code:
  39
  40 (eval-when-compile (require 'cl))
  41
  42 (require 'soap-client)
  43
  44 ;;; sample-value
  45
  46 (defun soap-sample-value (type)
  47   "Provide a sample value for TYPE, a WSDL type.
  48 A sample value is a LISP value which soap-client.el will accept
  49 for encoding it using TYPE when making SOAP requests.
  50
  51 This is a generic function, depending on TYPE a specific function
  52 will be called."
  53   (let ((sample-value (get (aref type 0) 'soap-sample-value)))
  54     (if sample-value
  55         (funcall sample-value type)
  56         (error "Cannot provide sample value for type %s" (aref type 0)))))
  57
  58 (defun soap-sample-value-for-xs-basic-type (type)
  59   "Provide a sample value for TYPE, an xs-basic-type.
  60 This is a specialization of `soap-sample-value' for xs-basic-type
  61 objects."
  62   (case (soap-xs-basic-type-kind type)
  63     (string "a string")
  64     (anyURI "an URI")
  65     (QName "a QName")
  66     (dateTime "a time-value-p or string")
  67     (boolean "t or nil")
  68     ((long int integer byte unsignedInt) 42)
  69     ((float double) 3.14)
  70     (base64Binary "a string")
  71     (t (format "%s" (soap-xs-basic-type-kind type)))))
  72
  73 (defun soap-sample-value-for-xs-element (element)
  74   "Provide a sample value for ELEMENT, a WSDL element.
  75 This is a specialization of `soap-sample-value' for xs-element
  76 objects."
  77   (if (soap-xs-element-name element)
  78       (cons (intern (soap-xs-element-name element))
  79             (soap-sample-value (soap-xs-element-type element)))
  80       (soap-sample-value (soap-xs-element-type element))))
  81
  82 (defun soap-sample-value-for-xs-attribute (attribute)
  83   "Provide a sample value for ATTRIBUTE, a WSDL attribute.
  84 This is a specialization of `soap-sample-value' for
  85 soap-xs-attribute objects."
  86   (if (soap-xs-attribute-name attribute)
  87       (cons (intern (soap-xs-attribute-name attribute))
  88             (soap-sample-value (soap-xs-attribute-type attribute)))
  89     (soap-sample-value (soap-xs-attribute-type attribute))))
  90
  91 (defun soap-sample-value-for-xs-attribute-group (attribute-group)
  92   "Provide a sample value for ATTRIBUTE-GROUP, a WSDL attribute group.
  93 This is a specialization of `soap-sample-value' for
  94 soap-xs-attribute objects."
  95   (let ((sample-values nil))
  96     (dolist (attribute (soap-xs-attribute-group-attributes attribute-group))
  97       (if (soap-xs-attribute-name attribute)
  98           (setq sample-values
  99                 (append sample-values
 100                         (cons (intern (soap-xs-attribute-name attribute))
 101                               (soap-sample-value (soap-xs-attribute-type
 102                                                   attribute)))))
 103         (setq sample-values
 104               (append sample-values
 105                       (soap-sample-value
 106                        (soap-xs-attribute-type attribute))))))))
 107
 108 (defun soap-sample-value-for-xs-simple-type (type)
 109   "Provide a sample value for TYPE, a `soap-xs-simple-type'.
 110 This is a specialization of `soap-sample-value' for
 111 `soap-xs-simple-type' objects."
 112   (append
 113    (mapcar 'soap-sample-value-for-xs-attribute
 114            (soap-xs-type-attributes type))
 115    (cond
 116     ((soap-xs-simple-type-enumeration type)
 117      (let ((enumeration (soap-xs-simple-type-enumeration type)))
 118        (nth (random (length enumeration)) enumeration)))
 119     ((soap-xs-simple-type-pattern type)
 120      (format "a string matching %s" (soap-xs-simple-type-pattern type)))
 121     ((soap-xs-simple-type-length-range type)
 122      (destructuring-bind (low . high) (soap-xs-simple-type-length-range type)
 123        (cond
 124          ((and low high)
 125           (format "a string between %d and %d chars long" low high))
 126          (low (format "a string at least %d chars long" low))
 127          (high (format "a string at most %d chars long" high))
 128          (t (format "a string OOPS")))))
 129     ((soap-xs-simple-type-integer-range type)
 130      (destructuring-bind (min . max) (soap-xs-simple-type-integer-range type)
 131        (cond
 132          ((and min max) (+ min (random (- max min))))
 133          (min (+ min (random 10)))
 134          (max (random max))
 135          (t (random 100)))))
 136     ((consp (soap-xs-simple-type-base type)) ; an union of values
 137      (let ((base (soap-xs-simple-type-base type)))
 138        (soap-sample-value (nth (random (length base)) base))))
 139     ((soap-xs-basic-type-p (soap-xs-simple-type-base type))
 140      (soap-sample-value (soap-xs-simple-type-base type))))))
 141
 142 (defun soap-sample-value-for-xs-complex-type (type)
 143   "Provide a sample value for TYPE, a `soap-xs-complex-type'.
 144 This is a specialization of `soap-sample-value' for
 145 `soap-xs-complex-type' objects."
 146   (append
 147    (mapcar 'soap-sample-value-for-xs-attribute
 148            (soap-xs-type-attributes type))
 149    (case (soap-xs-complex-type-indicator type)
 150      (array
 151       (let* ((element-type (soap-xs-complex-type-base type))
 152              (sample1 (soap-sample-value element-type))
 153              (sample2 (soap-sample-value element-type)))
 154         ;; Our sample value is a vector of two elements, but any number of
 155         ;; elements are permissible
 156         (vector sample1 sample2 '&etc)))
 157      ((sequence choice all)
 158       (let ((base (soap-xs-complex-type-base type)))
 159         (let ((value (append (and base (soap-sample-value base))
 160                              (mapcar #'soap-sample-value
 161                                      (soap-xs-complex-type-elements type)))))
 162           (if (eq (soap-xs-complex-type-indicator type) 'choice)
 163               (cons '***choice-of*** value)
 164             value)))))))
 165
 166 (defun soap-sample-value-for-message (message)
 167   "Provide a sample value for a WSDL MESSAGE.
 168 This is a specialization of `soap-sample-value' for
 169 `soap-message' objects."
 170   ;; NOTE: parameter order is not considered.
 171   (let (sample-value)
 172     (dolist (part (soap-message-parts message))
 173       (push (soap-sample-value (cdr part)) sample-value))
 174     (nreverse sample-value)))
 175
 176 (progn
 177   ;; Install soap-sample-value methods for our types
 178   (put (aref (make-soap-xs-basic-type) 0)
 179        'soap-sample-value
 180        'soap-sample-value-for-xs-basic-type)
 181
 182   (put (aref (make-soap-xs-element) 0)
 183        'soap-sample-value
 184        'soap-sample-value-for-xs-element)
 185
 186   (put (aref (make-soap-xs-attribute) 0)
 187        'soap-sample-value
 188        'soap-sample-value-for-xs-attribute)
 189
 190   (put (aref (make-soap-xs-attribute) 0)
 191        'soap-sample-value
 192        'soap-sample-value-for-xs-attribute-group)
 193
 194   (put (aref (make-soap-xs-simple-type) 0)
 195        'soap-sample-value
 196        'soap-sample-value-for-xs-simple-type)
 197
 198   (put (aref (make-soap-xs-complex-type) 0)
 199        'soap-sample-value
 200        'soap-sample-value-for-xs-complex-type)
 201
 202   (put (aref (make-soap-message) 0)
 203        'soap-sample-value
 204        'soap-sample-value-for-message))
 205
 206
 207 \f
 208 ;;; soap-inspect
 209
 210 (defvar soap-inspect-previous-items nil
 211   "A stack of previously inspected items in the *soap-inspect* buffer.
 212 Used to implement the BACK button.")
 213
 214 (defvar soap-inspect-current-item nil
 215   "The current item being inspected in the *soap-inspect* buffer.")
 216
 217 (progn
 218   (make-variable-buffer-local 'soap-inspect-previous-items)
 219   (make-variable-buffer-local 'soap-inspect-current-item))
 220
 221 (defun soap-inspect (element)
 222   "Inspect a SOAP ELEMENT in the *soap-inspect* buffer.
 223 The buffer is populated with information about ELEMENT with links
 224 to its sub elements.  If ELEMENT is the WSDL document itself, the
 225 entire WSDL can be inspected."
 226   (let ((inspect (get (aref element 0) 'soap-inspect)))
 227     (unless inspect
 228       (error "Soap-inspect: no inspector for element"))
 229
 230     (with-current-buffer (get-buffer-create "*soap-inspect*")
 231       (setq buffer-read-only t)
 232       (let ((inhibit-read-only t))
 233         (erase-buffer)
 234
 235         (when soap-inspect-current-item
 236           (push soap-inspect-current-item
 237                 soap-inspect-previous-items))
 238         (setq soap-inspect-current-item element)
 239
 240         (funcall inspect element)
 241
 242         (unless (null soap-inspect-previous-items)
 243           (insert "\n\n")
 244           (insert-text-button
 245            "[back]"
 246            'type 'soap-client-describe-back-link
 247            'item element)
 248           (insert "\n"))
 249         (goto-char (point-min))
 250         (pop-to-buffer (current-buffer))))))
 251
 252
 253 (define-button-type 'soap-client-describe-link
 254     'face 'link
 255     'help-echo "mouse-2, RET: describe item"
 256     'follow-link t
 257     'action (lambda (button)
 258               (let ((item (button-get button 'item)))
 259                 (soap-inspect item)))
 260     'skip t)
 261
 262 (define-button-type 'soap-client-describe-back-link
 263     'face 'link
 264     'help-echo "mouse-2, RET: browse the previous item"
 265     'follow-link t
 266     'action (lambda (_button)
 267               (let ((item (pop soap-inspect-previous-items)))
 268                 (when item
 269                   (setq soap-inspect-current-item nil)
 270                   (soap-inspect item))))
 271     'skip t)
 272
 273 (defun soap-insert-describe-button (element)
 274   "Insert a button to inspect ELEMENT when pressed."
 275   (insert-text-button
 276    (soap-element-fq-name element)
 277    'type 'soap-client-describe-link
 278    'item element))
 279
 280 (defun soap-inspect-xs-basic-type (type)
 281   "Insert information about TYPE, a soap-xs-basic-type, in the current buffer."
 282   (insert "Basic type: " (soap-element-fq-name type))
 283   (insert "\nSample value:\n")
 284   (pp (soap-sample-value type) (current-buffer)))
 285
 286 (defun soap-inspect-xs-element (element)
 287   "Insert information about ELEMENT, a soap-xs-element, in the current buffer."
 288   (insert "Element: " (soap-element-fq-name element))
 289   (insert "\nType: ")
 290   (soap-insert-describe-button (soap-xs-element-type element))
 291   (insert "\nAttributes:")
 292   (when (soap-xs-element-optional? element)
 293     (insert " optional"))
 294   (when (soap-xs-element-multiple? element)
 295     (insert " multiple"))
 296   (insert "\nSample value:\n")
 297   (pp (soap-sample-value element) (current-buffer)))
 298
 299 (defun soap-inspect-xs-attribute (attribute)
 300   "Insert information about ATTRIBUTE, a soap-xs-attribute, in
 301 the current buffer."
 302   (insert "Attribute: " (soap-element-fq-name attribute))
 303   (insert "\nType: ")
 304   (soap-insert-describe-button (soap-xs-attribute-type attribute))
 305   (insert "\nSample value:\n")
 306   (pp (soap-sample-value attribute) (current-buffer)))
 307
 308 (defun soap-inspect-xs-attribute-group (attribute-group)
 309   "Insert information about ATTRIBUTE-GROUP, a
 310 soap-xs-attribute-group, in the current buffer."
 311   (insert "Attribute group: " (soap-element-fq-name attribute-group))
 312   (insert "\nSample values:\n")
 313   (pp (soap-sample-value attribute-group) (current-buffer)))
 314
 315 (defun soap-inspect-xs-simple-type (type)
 316   "Insert information about TYPE, a soap-xs-simple-type, in the current buffer."
 317   (insert "Simple type: " (soap-element-fq-name type))
 318   (insert "\nBase: " )
 319   (if (listp (soap-xs-simple-type-base type))
 320       (let ((first-time t))
 321         (dolist (b (soap-xs-simple-type-base type))
 322           (unless first-time
 323             (insert ", ")
 324             (setq first-time nil))
 325           (soap-insert-describe-button b)))
 326       (soap-insert-describe-button (soap-xs-simple-type-base type)))
 327   (insert "\nAttributes: ")
 328   (dolist (attribute (soap-xs-simple-type-attributes type))
 329     (let ((name (or (soap-xs-attribute-name attribute) "*inline*"))
 330           (type (soap-xs-attribute-type attribute)))
 331       (insert "\n\t")
 332       (insert name)
 333       (insert "\t")
 334       (soap-insert-describe-button type)))
 335   (when (soap-xs-simple-type-enumeration type)
 336     (insert "\nEnumeration values: ")
 337     (dolist (e (soap-xs-simple-type-enumeration type))
 338       (insert "\n\t")
 339       (pp e)))
 340   (when (soap-xs-simple-type-pattern type)
 341     (insert "\nPattern: " (soap-xs-simple-type-pattern type)))
 342   (when (car (soap-xs-simple-type-length-range type))
 343     (insert "\nMin length: "
 344             (number-to-string (car (soap-xs-simple-type-length-range type)))))
 345   (when (cdr (soap-xs-simple-type-length-range type))
 346     (insert "\nMin length: "
 347             (number-to-string (cdr (soap-xs-simple-type-length-range type)))))
 348   (when (car (soap-xs-simple-type-integer-range type))
 349     (insert "\nMin value: "
 350             (number-to-string (car (soap-xs-simple-type-integer-range type)))))
 351   (when (cdr (soap-xs-simple-type-integer-range type))
 352     (insert "\nMin value: "
 353             (number-to-string (cdr (soap-xs-simple-type-integer-range type)))))
 354   (insert "\nSample value:\n")
 355   (pp (soap-sample-value type) (current-buffer)))
 356
 357 (defun soap-inspect-xs-complex-type (type)
 358   "Insert information about TYPE in the current buffer.
 359 TYPE is a `soap-xs-complex-type'"
 360   (insert "Complex type: " (soap-element-fq-name type))
 361   (insert "\nKind: ")
 362   (case (soap-xs-complex-type-indicator type)
 363     ((sequence all)
 364      (insert "a sequence ")
 365      (when (soap-xs-complex-type-base type)
 366        (insert "extending ")
 367        (soap-insert-describe-button (soap-xs-complex-type-base type)))
 368      (insert "\nAttributes: ")
 369      (dolist (attribute (soap-xs-complex-type-attributes type))
 370        (let ((name (or (soap-xs-attribute-name attribute) "*inline*"))
 371              (type (soap-xs-attribute-type attribute)))
 372          (insert "\n\t")
 373          (insert name)
 374          (insert "\t")
 375          (soap-insert-describe-button type)))
 376      (insert "\nElements: ")
 377      (let ((name-width 0)
 378            (type-width 0))
 379        (dolist (element (soap-xs-complex-type-elements type))
 380          (let ((name (or (soap-xs-element-name element) "*inline*"))
 381                (type (soap-xs-element-type element)))
 382            (setq name-width (max name-width (length name)))
 383            (setq type-width
 384                  (max type-width (length (soap-element-fq-name type))))))
 385        (setq name-width (+ name-width 2))
 386        (setq type-width (+ type-width 2))
 387        (dolist (element (soap-xs-complex-type-elements type))
 388          (let ((name (or (soap-xs-element-name element) "*inline*"))
 389                (type (soap-xs-element-type element)))
 390            (insert "\n\t")
 391            (insert name)
 392            (insert (make-string (- name-width (length name)) ?\ ))
 393            (soap-insert-describe-button type)
 394            (insert
 395             (make-string
 396              (- type-width (length (soap-element-fq-name type))) ?\ ))
 397          (when (soap-xs-element-multiple? element)
 398            (insert " multiple"))
 399          (when (soap-xs-element-optional? element)
 400            (insert " optional"))))))
 401     (choice
 402      (insert "a choice ")
 403      (when (soap-xs-complex-type-base type)
 404        (insert "extending ")
 405        (soap-insert-describe-button (soap-xs-complex-type-base type)))
 406      (insert "\nElements: ")
 407      (dolist (element (soap-xs-complex-type-elements type))
 408        (insert "\n\t")
 409        (soap-insert-describe-button element)))
 410     (array
 411      (insert "an array of ")
 412      (soap-insert-describe-button (soap-xs-complex-type-base type))))
 413   (insert "\nSample value:\n")
 414   (pp (soap-sample-value type) (current-buffer)))
 415
 416
 417 (defun soap-inspect-message (message)
 418   "Insert information about MESSAGE into the current buffer."
 419   (insert "Message name: " (soap-element-fq-name message) "\n")
 420   (insert "Parts:\n")
 421   (dolist (part (soap-message-parts message))
 422     (insert "\t" (symbol-name (car part))
 423             " type: ")
 424     (soap-insert-describe-button (cdr part))
 425     (insert "\n")))
 426
 427 (defun soap-inspect-operation (operation)
 428   "Insert information about OPERATION into the current buffer."
 429   (insert "Operation name: " (soap-element-fq-name operation) "\n")
 430   (let ((input (soap-operation-input operation)))
 431     (insert "\tInput: " (symbol-name (car input)) " (" )
 432     (soap-insert-describe-button (cdr input))
 433     (insert ")\n"))
 434   (let ((output (soap-operation-output operation)))
 435     (insert "\tOutput: " (symbol-name (car output)) " (")
 436     (soap-insert-describe-button (cdr output))
 437     (insert ")\n"))
 438
 439   (insert "\n\nSample invocation:\n")
 440   (let ((sample-message-value
 441          (soap-sample-value (cdr (soap-operation-input operation))))
 442         (funcall (list 'soap-invoke '*WSDL* "SomeService"
 443                        (soap-element-name operation))))
 444     (let ((sample-invocation
 445            (append funcall (mapcar 'cdr sample-message-value))))
 446       (pp sample-invocation (current-buffer)))))
 447
 448 (defun soap-inspect-port-type (port-type)
 449   "Insert information about PORT-TYPE into the current buffer."
 450   (insert "Port-type name: " (soap-element-fq-name port-type) "\n")
 451   (insert "Operations:\n")
 452   (loop for o being the hash-values of
 453        (soap-namespace-elements (soap-port-type-operations port-type))
 454        do (progn
 455             (insert "\t")
 456             (soap-insert-describe-button (car o)))))
 457
 458 (defun soap-inspect-binding (binding)
 459   "Insert information about BINDING into the current buffer."
 460   (insert "Binding: " (soap-element-fq-name binding) "\n")
 461   (insert "\n")
 462   (insert "Bound operations:\n")
 463   (let* ((ophash (soap-binding-operations binding))
 464          (operations (loop for o being the hash-keys of ophash
 465                         collect o))
 466          op-name-width)
 467
 468     (setq operations (sort operations 'string<))
 469
 470     (setq op-name-width (loop for o in operations maximizing (length o)))
 471
 472     (dolist (op operations)
 473       (let* ((bound-op (gethash op ophash))
 474              (soap-action (soap-bound-operation-soap-action bound-op))
 475              (use (soap-bound-operation-use bound-op)))
 476         (unless soap-action
 477           (setq soap-action ""))
 478         (insert "\t")
 479         (soap-insert-describe-button (soap-bound-operation-operation bound-op))
 480         (when (or use (not (equal soap-action "")))
 481           (insert (make-string (- op-name-width (length op)) ?\s))
 482           (insert " (")
 483           (insert soap-action)
 484           (when use
 485             (insert " " (symbol-name use)))
 486           (insert ")"))
 487         (insert "\n")))))
 488
 489 (defun soap-inspect-port (port)
 490   "Insert information about PORT into the current buffer."
 491   (insert "Port name:   " (soap-element-name port) "\n"
 492           "Service URL: " (soap-port-service-url port) "\n"
 493           "Binding:     ")
 494   (soap-insert-describe-button (soap-port-binding port)))
 495
 496 (defun soap-inspect-wsdl (wsdl)
 497   "Insert information about WSDL into the current buffer."
 498   (insert "WSDL Origin: " (soap-wsdl-origin wsdl) "\n")
 499   (insert "Ports:")
 500   (dolist (p (soap-wsdl-ports wsdl))
 501     (insert "\n--------------------\n")
 502     ;; (soap-insert-describe-button p)
 503     (soap-inspect-port p))
 504   (insert "\n--------------------\nNamespace alias table:\n")
 505   (dolist (a (soap-wsdl-alias-table wsdl))
 506     (insert "\t" (car a) " => " (cdr a) "\n")))
 507
 508 (progn
 509   ;; Install the soap-inspect methods for our types
 510
 511   (put (aref (make-soap-xs-basic-type) 0) 'soap-inspect
 512        'soap-inspect-xs-basic-type)
 513
 514   (put (aref (make-soap-xs-element) 0) 'soap-inspect
 515        'soap-inspect-xs-element)
 516
 517   (put (aref (make-soap-xs-simple-type) 0) 'soap-inspect
 518        'soap-inspect-xs-simple-type)
 519
 520   (put (aref (make-soap-xs-complex-type) 0) 'soap-inspect
 521        'soap-inspect-xs-complex-type)
 522
 523   (put (aref (make-soap-xs-attribute) 0) 'soap-inspect
 524        'soap-inspect-xs-attribute)
 525
 526   (put (aref (make-soap-xs-attribute-group) 0) 'soap-inspect
 527        'soap-inspect-xs-attribute-group)
 528
 529   (put (aref (make-soap-message) 0) 'soap-inspect
 530        'soap-inspect-message)
 531   (put (aref (make-soap-operation) 0) 'soap-inspect
 532        'soap-inspect-operation)
 533
 534   (put (aref (make-soap-port-type) 0) 'soap-inspect
 535        'soap-inspect-port-type)
 536
 537   (put (aref (make-soap-binding) 0) 'soap-inspect
 538        'soap-inspect-binding)
 539
 540   (put (aref (make-soap-port) 0) 'soap-inspect
 541        'soap-inspect-port)
 542
 543   (put (aref (soap-make-wsdl "origin") 0) 'soap-inspect
 544        'soap-inspect-wsdl))
 545
 546 (provide 'soap-inspect)
 547 ;;; soap-inspect.el ends here