lisp/net/soap-inspect.el

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