code.delx.au - gnu-emacs/blob - lisp/net/soap-inspect.el

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