September 2005 - cl-soap-cvs@common-lisp.net

[cl-soap-cvs] CVS update: cl-soap/src/wsdl.lisp
by scaekenberghe＠common-lisp.net 13 Sep '05

13 Sep '05

Update of /project/cl-soap/cvsroot/cl-soap/src In directory common-lisp.net:/tmp/cvs-serv7414/src Modified Files: wsdl.lisp Log Message: added describe-wsdl-soap to print a human readable description of a wdsl-document-definition first, very limited, implementation of wsdl-soap-call (works in limited cases) Date: Tue Sep 13 21:23:49 2005 Author: scaekenberghe Index: cl-soap/src/wsdl.lisp diff -u cl-soap/src/wsdl.lisp:1.4 cl-soap/src/wsdl.lisp:1.5 --- cl-soap/src/wsdl.lisp:1.4 Mon Sep 12 16:28:40 2005 +++ cl-soap/src/wsdl.lisp Tue Sep 13 21:23:48 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: wsdl.lisp,v 1.4 2005/09/12 14:28:40 scaekenberghe Exp $ +;;;; $Id: wsdl.lisp,v 1.5 2005/09/13 19:23:48 scaekenberghe Exp $ ;;;; ;;;; The basic WSDL protocol: we parse the generic and soap specific parts ;;;; @@ -38,17 +38,18 @@ ((binding :accessor get-binding :initarg :binding :initform nil) (extension :accessor get-extension :initarg :extension :initform nil))) -(defclass wsdl-binding (abstract-wsdl-definition) +(defclass wsdl-extensions-mixin () + ((extensions :accessor get-extensions :initarg :extensions :initform nil))) + +(defclass wsdl-binding (abstract-wsdl-definition wsdl-extensions-mixin) ((type :accessor get-type :initarg :type :initform nil) - (operations :accessor get-operations :initarg :operations :initform nil) - (extensions :accessor get-extensions :initarg :extensions :initform nil))) + (operations :accessor get-operations :initarg :operations :initform nil))) (defclass wsdl-port-type (abstract-wsdl-definition) ((operations :accessor get-operations :initarg :operations :initform nil))) -(defclass wsdl-operation-element () - ((message :accessor get-message :initarg :message :initform nil) - (extensions :accessor get-extensions :initarg :extensions :initform nil))) +(defclass wsdl-operation-element (wsdl-extensions-mixin) + ((message :accessor get-message :initarg :message :initform nil))) (defmethod print-object ((object wsdl-operation-element) out) (print-unreadable-object (object out :type t :identity t) @@ -63,9 +64,8 @@ (defclass wsdl-fault (wsdl-operation-element) ()) -(defclass wsdl-operation (abstract-wsdl-definition) - ((elements :accessor get-elements :initarg :elements :initform nil) - (extensions :accessor get-extensions :initarg :extensions :initform nil))) +(defclass wsdl-operation (abstract-wsdl-definition wsdl-extensions-mixin) + ((elements :accessor get-elements :initarg :elements :initform nil))) (defclass wsdl-part () ((name :accessor get-name :initarg :name :initform nil) @@ -296,8 +296,92 @@ (with-input-from-string (in buffer) (parse-wsdl in)))) +;; Interpreting the WSDL model + +(defun actual-name (qname) + "For now we ignore prefixes ;-)" + (multiple-value-bind (prefix identifier) + (s-xml:split-identifier qname) + (declare (ignore prefix)) + identifier)) + +(defun find-item-named (item-name sequence) + (find (actual-name item-name) sequence :test #'string-equal :key #'get-name)) + +(defmethod get-service-named ((wsdl-document-definitions wsdl-document-definitions) service-name) + (find-item-named service-name (get-services wsdl-document-definitions))) + +(defmethod get-port-named ((wsdl-service wsdl-service) port-name) + (find-item-named port-name (get-ports wsdl-service))) + +(defmethod get-binding-named ((wsdl-document-definitions wsdl-document-definitions) binding-name) + (find-item-named binding-name (get-bindings wsdl-document-definitions))) + +(defmethod get-port-type-named ((wsdl-document-definitions wsdl-document-definitions) port-type-name) + (find-item-named port-type-name (get-port-types wsdl-document-definitions))) + +(defmethod get-message-named ((wsdl-document-definitions wsdl-document-definitions) message-name) + (find-item-named message-name (get-messages wsdl-document-definitions))) + +(defmethod get-operation-named ((wsdl-binding wsdl-binding) operation-name) + (find-item-named operation-name (get-operations wsdl-binding))) + +(defmethod get-operation-named ((wsdl-port-type wsdl-port-type) operation-name) + (find-item-named operation-name (get-operations wsdl-port-type))) + +(defun find-item-of-class (class-name sequence) + (let ((class (find-class class-name))) + (find-if #'(lambda (c) (eql c class)) sequence :key #'class-of))) + +(defmethod get-operation-element ((wsdl-operation wsdl-operation) operation-element-type) + (find-item-of-class operation-element-type (get-elements wsdl-operation))) + +(defmethod get-extension-of-class ((wsdl-extensions-mixin wsdl-extensions-mixin) extension-type) + (find-item-of-class extension-type (get-extensions wsdl-extensions-mixin))) + +;; Describing WSDL + +(defun describe-wsdl-soap (wsdl-document-definitions) + "Print a high-level description of the services/ports/operations in wsdl-document-definitions" + (format t "WSDL Document Definitions~@[ named ~a~]~%" (get-name wsdl-document-definitions)) + (loop :for service :in (get-services wsdl-document-definitions) :do + (format t " Service: ~a~%" (get-name service)) + (loop :for port :in (get-ports service) :do + (format t " Port: ~a~%" (get-name port)) + (format t " SOAP Address Location ~s~%" (get-location (get-extension port))) + (let* ((binding-name (get-binding port)) + (binding (get-binding-named wsdl-document-definitions binding-name)) + (port-type-name (get-type binding)) + (port-type (get-port-type-named wsdl-document-definitions port-type-name))) + (format t " Binding: ~a~%" binding-name) + (loop :for operation :in (get-operations binding) :do + (format t " Operation: ~a~%" (get-name operation)) + (let* ((operation-details (get-operation-named port-type (get-name operation))) + (input-element (get-operation-element operation-details 'wsdl-input)) + (output-element (get-operation-element operation-details 'wsdl-output)) + (input-message (get-message-named wsdl-document-definitions + (get-message input-element))) + (output-message (get-message-named wsdl-document-definitions + (get-message output-element)))) + (format t " Input: ~a~%" (get-name input-message)) + (loop :for part :in (get-parts input-message) :do + (format t " Part: ~a ~@[(type ~a)~]~@[(element ~a)~]~%" + (get-name part) (get-type part) (get-element part))) + (format t " Output: ~a~%" (get-name output-message)) + (loop :for part :in (get-parts output-message) :do + (format t " Part: ~a ~@[(type ~a)~]~@[(element ~a)~]~%" + (get-name part) (get-type part) (get-element part)))))))) + (values)) + ;; Using WSDL to make structured SOAP calls +;; wsdl: either an instance of wsdl-document-definitions, a string url, a stream to parse, a pathname +;; operation-name: string naming the operation to invoke +;; service-name: string of service to use (if nil, use first service found) +;; port-name: string of port of service to use (if nil, use first port found) +;; input: plist ("name1" value1 "name2" value2 ...) of actual parameters to use +;; output: what to do with the result (if nil: use the contents of the first part of the output message, if possible) + (defun wsdl-soap-call (wsdl operation-name &key @@ -306,13 +390,73 @@ input output) "Use WSDL to make a SOAP call of operation/port/service using input/output" - (declare (ignore wsdl operation-name service-name port-name input output)) - ;; wsdl: either an instance of wsdl-document-definitions, a string url, a stream to parse, a pathname - ;; operation-name: string naming the operation to invoke - ;; service-name: string of service to use (if nil, use first service found) - ;; port-name: string of port of service to use (if nil, use first port found) - ;; input: plist ("name1" value1 "name2" value2) of actual parameters to use - ;; output: what to do with the result (if nil: use the contents of the first part of the output message, if possible) - t) + (declare (ignore output)) + (let* ((wsdl-document-definitions (etypecase wsdl + (wsdl-document-definitions wsdl) + (string (parse-wsdl-url wsdl)) + (pathname (parse-wsdl-file wsdl)))) + (service (if service-name + (get-service-named wsdl-document-definitions service-name) + (first (get-services wsdl-document-definitions)))) + (port (if port-name + (get-port-named service port-name) + (first (get-ports service)))) + (address-location-url (get-location (get-extension port))) + (soap-end-point (make-soap-end-point address-location-url)) + (binding (get-binding-named wsdl-document-definitions (get-binding port))) + (soap-binding (get-extension-of-class binding 'wsdl-soap-binding)) + (port-type (get-port-type-named wsdl-document-definitions (get-type binding))) + (binding-operation (get-operation-named binding operation-name)) + (soap-operation (get-extension-of-class binding-operation 'wsdl-soap-operation)) + (soap-action (get-soap-action soap-operation)) + (binding-operation-input (get-operation-element binding-operation 'wsdl-input)) + (soap-input-body (get-extension-of-class binding-operation-input 'wsdl-soap-body)) + (binding-operation-output (get-operation-element binding-operation 'wsdl-output)) + (soap-output-body (get-extension-of-class binding-operation-output 'wsdl-soap-body)) + (port-type-operation (get-operation-named port-type operation-name)) + (input-message (get-message-named wsdl-document-definitions + (get-message (get-operation-element port-type-operation 'wsdl-input)))) + (output-message (get-message-named wsdl-document-definitions + (get-message (get-operation-element port-type-operation 'wsdl-output))))) + (if (string-equal (get-transport soap-binding) "http://schemas.xmlsoap.org/soap/http") + (if (and (string-equal (get-style soap-binding) "rpc") + (string-equal (get-use soap-input-body) "encoded") + (string-equal (get-use soap-output-body) "encoded") + (string-equal (get-encoding-style soap-input-body) "http://schemas.xmlsoap.org/soap/encoding/") + (string-equal (get-encoding-style soap-output-body) "http://schemas.xmlsoap.org/soap/encoding/")) + (let ((input-namespace-uri (get-namespace soap-input-body)) + (output-namespace-uri (get-namespace soap-output-body)) + (actual-input-parameters '())) + (if (equal input-namespace-uri output-namespace-uri) + (s-xml:register-namespace input-namespace-uri "ns1" :ns1) + (error "The case where input and output namespaces differ is not yet supported")) + (loop :for part :in (get-parts input-message) :do + (let* ((value (second (member (get-name part) input :test #'equal)))) + (if value + (push `((,(intern (get-name part) :keyword) + xsi::|type| ,(get-type part)) + ,(princ-to-string value)) + actual-input-parameters) + (error "No input binding found for ~a:~a" (get-name input-message) (get-name part))))) + (let* ((input-wrapper (intern (get-name binding-operation) :ns1)) + (result (soap-call soap-end-point + '() + `((,input-wrapper + soapenv:|encodingStyle| ,+soap-enc-ns-uri+ + :|xmlns:ns1| ,input-namespace-uri) + ,@(nreverse actual-input-parameters)) + :soap-action soap-action)) + (output-wrapper (intern (get-name output-message) :ns1)) + (result-values '())) + (if (eql (lxml-get-tag result) output-wrapper) + (progn + (loop :for part :in (get-parts output-message) :do + (let ((part-element (lxml-find-tag (intern (get-name part) :keyword) (rest result)))) + ;; add type conversions ;-) + (push (rest part-element) result-values))) + (nreverse result-values)) + (error "Expected <~a> element" output-wrapper)))) + (error "Only standard SOAP RPC style currently supported as binding")) + (error "Only standard SOAP HTTP transport currently supported as binding")))) ;;;; eof

1 0

[cl-soap-cvs] CVS update: cl-soap/test/test-wsdl.lisp cl-soap/test/test-basic.lisp
by scaekenberghe＠common-lisp.net 12 Sep '05

12 Sep '05

Update of /project/cl-soap/cvsroot/cl-soap/test In directory common-lisp.net:/tmp/cvs-serv11181/test Modified Files: test-basic.lisp Added Files: test-wsdl.lisp Log Message: unimplemented API for making SOAP calls supported by WSDL Date: Mon Sep 12 16:28:41 2005 Author: scaekenberghe Index: cl-soap/test/test-basic.lisp diff -u cl-soap/test/test-basic.lisp:1.3 cl-soap/test/test-basic.lisp:1.4 --- cl-soap/test/test-basic.lisp:1.3 Sat Sep 10 21:56:28 2005 +++ cl-soap/test/test-basic.lisp Mon Sep 12 16:28:41 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: test-basic.lisp,v 1.3 2005/09/10 19:56:28 scaekenberghe Exp $ +;;;; $Id: test-basic.lisp,v 1.4 2005/09/12 14:28:41 scaekenberghe Exp $ ;;;; ;;;; Some test for the basic SOAP protocol ;;;; @@ -103,13 +103,13 @@ "Calling Axis's User Guide Example 3 'echo'" (let ((ns "http://example3.userguide.samples")) (s-xml:register-namespace ns "ns1" :ns1) - (let* ((local (make-soap-end-point "http://localhost:9090/axis/services/MyService")) + (let* ((local (make-soap-end-point "http://localhost:8080/axis/services/MyService")) (result (soap-call local '() `((ns1::|serviceMethod| soapenv:|encodingStyle| ,+soap-enc-ns-uri+ :|xmlns:ns1| ,ns) - ((:|arg2| xsi::|type| "xsd:string") + ((:|arg| xsi::|type| "xsd:string") ,string))))) (if (eql (lxml-get-tag result) 'ns1::|serviceMethodResponse|) (let ((contents (lxml-find-tag :|serviceMethodReturn| (rest result))))

1 0

[cl-soap-cvs] CVS update: cl-soap/src/soap.lisp cl-soap/src/wsdl.lisp
by scaekenberghe＠common-lisp.net 12 Sep '05

12 Sep '05

Update of /project/cl-soap/cvsroot/cl-soap/src In directory common-lisp.net:/tmp/cvs-serv11181/src Modified Files: soap.lisp wsdl.lisp Log Message: unimplemented API for making SOAP calls supported by WSDL Date: Mon Sep 12 16:28:40 2005 Author: scaekenberghe Index: cl-soap/src/soap.lisp diff -u cl-soap/src/soap.lisp:1.4 cl-soap/src/soap.lisp:1.5 --- cl-soap/src/soap.lisp:1.4 Sat Sep 10 21:57:50 2005 +++ cl-soap/src/soap.lisp Mon Sep 12 16:28:39 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: soap.lisp,v 1.4 2005/09/10 19:57:50 scaekenberghe Exp $ +;;;; $Id: soap.lisp,v 1.5 2005/09/12 14:28:39 scaekenberghe Exp $ ;;;; ;;;; The basic SOAP protocol ;;;; @@ -79,6 +79,12 @@ ;;; Call Interface +(defvar *last-soap-call-xml* nil + "When *debug-stream* is non-nil, will contain the last SOAP call's parsed XML") + +(defvar *last-soap-result-xml* nil + "When *debug-stream* is non-nil, will contain the last SOAP result's parsed XML") + (defun soap-call (server-end-point header body @@ -96,6 +102,7 @@ (call-xml (s-xml:print-xml-string call-soap-envelope :pretty t)) result-xml result-soap-envelope) (when *debug-stream* + (setf *last-soap-call-xml* call-soap-envelope) (format *debug-stream* ";; SOAP CALL sending: ~a~%" call-xml)) (setf result-xml (do-http-request (get-url server-end-point) :method :POST @@ -105,6 +112,8 @@ (when *debug-stream* (format *debug-stream* ";; SOAP CALL receiving: ~a~%" result-xml)) (setf result-soap-envelope (s-xml:parse-xml-string result-xml)) + (when *debug-stream* + (setf *last-soap-result-xml* result-soap-envelope)) (if (eql (lxml-get-tag result-soap-envelope) 'soapenv:|Envelope|) ;; we ignore returned headers for now ;; only the first child of the body is returned, unless it is a fault Index: cl-soap/src/wsdl.lisp diff -u cl-soap/src/wsdl.lisp:1.3 cl-soap/src/wsdl.lisp:1.4 --- cl-soap/src/wsdl.lisp:1.3 Mon Sep 12 13:24:01 2005 +++ cl-soap/src/wsdl.lisp Mon Sep 12 16:28:40 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: wsdl.lisp,v 1.3 2005/09/12 11:24:01 scaekenberghe Exp $ +;;;; $Id: wsdl.lisp,v 1.4 2005/09/12 14:28:40 scaekenberghe Exp $ ;;;; ;;;; The basic WSDL protocol: we parse the generic and soap specific parts ;;;; @@ -295,5 +295,24 @@ (let ((buffer (do-http-request url))) (with-input-from-string (in buffer) (parse-wsdl in)))) + +;; Using WSDL to make structured SOAP calls + +(defun wsdl-soap-call (wsdl + operation-name + &key + service-name + port-name + input + output) + "Use WSDL to make a SOAP call of operation/port/service using input/output" + (declare (ignore wsdl operation-name service-name port-name input output)) + ;; wsdl: either an instance of wsdl-document-definitions, a string url, a stream to parse, a pathname + ;; operation-name: string naming the operation to invoke + ;; service-name: string of service to use (if nil, use first service found) + ;; port-name: string of port of service to use (if nil, use first port found) + ;; input: plist ("name1" value1 "name2" value2) of actual parameters to use + ;; output: what to do with the result (if nil: use the contents of the first part of the output message, if possible) + t) ;;;; eof

1 0

[cl-soap-cvs] CVS update: cl-soap/src/namespaces.lisp cl-soap/src/wsdl.lisp
by scaekenberghe＠common-lisp.net 12 Sep '05

12 Sep '05

Update of /project/cl-soap/cvsroot/cl-soap/src In directory common-lisp.net:/tmp/cvs-serv30908/src Modified Files: namespaces.lisp wsdl.lisp Log Message: added parsing of WSDL SOAP extension elements Date: Mon Sep 12 13:24:01 2005 Author: scaekenberghe Index: cl-soap/src/namespaces.lisp diff -u cl-soap/src/namespaces.lisp:1.4 cl-soap/src/namespaces.lisp:1.5 --- cl-soap/src/namespaces.lisp:1.4 Fri Sep 9 16:18:02 2005 +++ cl-soap/src/namespaces.lisp Mon Sep 12 13:24:01 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: namespaces.lisp,v 1.4 2005/09/09 14:18:02 scaekenberghe Exp $ +;;;; $Id: namespaces.lisp,v 1.5 2005/09/12 11:24:01 scaekenberghe Exp $ ;;;; ;;;; Definition of some standard XML namespaces commonly needed for SOAP ;;;; @@ -73,7 +73,7 @@ (defpackage :wsdl-soap (:nicknames "wsdl-soap") - (:export) + (:export "address" "binding" "operation" "body" "header" "fault" "headerfault") (:documentation "Package for symbols in the WSDL Soap Bindings XML Namespace")) (defparameter *wsdl-soap-ns* (s-xml:register-namespace +wsdl-soap-ns-uri+ "soap" :wsdl-soap)) Index: cl-soap/src/wsdl.lisp diff -u cl-soap/src/wsdl.lisp:1.2 cl-soap/src/wsdl.lisp:1.3 --- cl-soap/src/wsdl.lisp:1.2 Fri Sep 9 16:17:37 2005 +++ cl-soap/src/wsdl.lisp Mon Sep 12 13:24:01 2005 @@ -1,8 +1,8 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: wsdl.lisp,v 1.2 2005/09/09 14:17:37 scaekenberghe Exp $ +;;;; $Id: wsdl.lisp,v 1.3 2005/09/12 11:24:01 scaekenberghe Exp $ ;;;; -;;;; The basic WSDL protocol +;;;; The basic WSDL protocol: we parse the generic and soap specific parts ;;;; ;;;; Copyright (C) 2005 Sven Van Caekenberghe, Beta Nine BVBA. All Rights Reserved. ;;;; @@ -13,7 +13,7 @@ (in-package :cl-soap) -;;; Generic Soap Model +;;; Generic WSDL Model (defclass abstract-wsdl-definition () ((name :accessor get-name :initarg :name :initform nil) @@ -36,17 +36,19 @@ (defclass wsdl-port (abstract-wsdl-definition) ((binding :accessor get-binding :initarg :binding :initform nil) - (network-address))) + (extension :accessor get-extension :initarg :extension :initform nil))) (defclass wsdl-binding (abstract-wsdl-definition) ((type :accessor get-type :initarg :type :initform nil) - (operations :accessor get-operations :initarg :operations :initform nil))) + (operations :accessor get-operations :initarg :operations :initform nil) + (extensions :accessor get-extensions :initarg :extensions :initform nil))) (defclass wsdl-port-type (abstract-wsdl-definition) ((operations :accessor get-operations :initarg :operations :initform nil))) (defclass wsdl-operation-element () - ((message :accessor get-message :initarg :message :initform nil))) + ((message :accessor get-message :initarg :message :initform nil) + (extensions :accessor get-extensions :initarg :extensions :initform nil))) (defmethod print-object ((object wsdl-operation-element) out) (print-unreadable-object (object out :type t :identity t) @@ -62,7 +64,8 @@ ()) (defclass wsdl-operation (abstract-wsdl-definition) - ((elements :accessor get-elements :initarg :elements :initform nil))) + ((elements :accessor get-elements :initarg :elements :initform nil) + (extensions :accessor get-extensions :initarg :extensions :initform nil))) (defclass wsdl-part () ((name :accessor get-name :initarg :name :initform nil) @@ -77,60 +80,107 @@ ((parts :accessor get-parts :initarg :parts :initform nil))) (defclass wsdl-type (abstract-wsdl-definition) + ;; to be finished !!! ((data-type-definitions))) -;;; WSDL SOAP Model +;;; WSDL SOAP Model Extension Elements -(defclass wsdl-soap-service (wsdl-service) - ((location))) +(defclass wsdl-soap-address () + ((location :accessor get-location :initarg :location :initform "http://localhost"))) -(defclass wsdl-soap-binding (wsdl-binding) - ((style) - (transport))) - -(defclass wsdl-soap-operation (wsdl-operation) - ((soap-action) - (style))) - -(defclass wsdl-soap-body () - ((parts) - (use) - (encoding-style) - (namespace))) - -(defclass wsdl-soap-fault () - ((name) - (use) - (encoding-style) - (namespace))) - -(defclass wsdl-soap-header () - ((message) - (part) - (use) - (encoding-style) - (namespace))) +(defmethod print-object ((object wsdl-soap-address) out) + (print-unreadable-object (object out :type t :identity t) + (prin1 (or (get-location object) "unknown") out))) + +(defclass wsdl-soap-binding () + ((style :accessor get-style :initarg :style :initform "document") + (transport :accessor get-transport :initarg :transport :initform "http://schemas.xmlsoap.org/soap/http"))) + +(defclass wsdl-soap-operation () + ((soap-action :accessor get-soap-action :initarg :soap-action :initform nil) + (style :accessor get-style :initarg :style :initform nil))) + +(defclass wsdl-soap-operation-element () + ((use :accessor get-use :initarg :use :initform nil) + (encoding-style :accessor get-encoding-style :initarg :encoding-style :initform nil) + (namespace :accessor get-namespace :initarg :namespace :initform nil))) + +(defclass wsdl-soap-body (wsdl-soap-operation-element) + ((parts :accessor get-parts :initarg :parts :initform nil))) + +(defclass wsdl-soap-fault (wsdl-soap-operation-element) + ((name :accessor get-name :initarg :name :initform nil))) + +(defclass wsdl-soap-header (wsdl-soap-operation-element) + ((message :accessor get-message :initarg :message :initform nil) + (part :accessor get-part :initarg :part :initform nil))) (defclass wsdl-soap-header-fault (wsdl-soap-header) ()) ;; Parsing +;; one day we should handle <import> statements ;-) + +(defun lxml->operation-element (lxml) + (let* ((attributes (lxml-get-attributes lxml)) + (message (getf attributes :|message|)) + (class (ecase (lxml-get-tag lxml) + (wsdl:|input| 'wsdl-input) + (wsdl:|output| 'wsdl-output) + (wsdl:|fault| 'wsdl-fault))) + (operation-element (make-instance class :message message))) + (loop :for element :in (rest lxml) + :do (case (lxml-get-tag element) + (wsdl:|documentation| (setf (get-documentation operation-element) + (rest element))) + (wsdl-soap:|body| (let ((attributes (lxml-get-attributes element))) + (push (make-instance 'wsdl-soap-body + :use (getf attributes :|use|) + :encoding-style (getf attributes :|encodingStyle|) + :namespace (getf attributes :|namespace|) + :parts (getf attributes :|parts|)) + (get-extensions operation-element)))) + (wsdl-soap:|fault| (let ((attributes (lxml-get-attributes element))) + (push (make-instance 'wsdl-soap-fault + :use (getf attributes :|use|) + :encoding-style (getf attributes :|encodingStyle|) + :namespace (getf attributes :|namespace|) + :name (getf attributes :|name|)) + (get-extensions operation-element)))) + (wsdl-soap:|header| (let ((attributes (lxml-get-attributes element))) + (push (make-instance 'wsdl-soap-header + :use (getf attributes :|use|) + :encoding-style (getf attributes :|encodingStyle|) + :namespace (getf attributes :|namespace|) + :part (getf attributes :|part|) + :message (getf attributes :|message|)) + (get-extensions operation-element)))) + (wsdl-soap:|headerfault| (let ((attributes (lxml-get-attributes element))) + (push (make-instance 'wsdl-soap-header-fault + :use (getf attributes :|use|) + :encoding-style (getf attributes :|encodingStyle|) + :namespace (getf attributes :|namespace|) + :part (getf attributes :|part|) + :message (getf attributes :|message|)) + (get-extensions operation-element)))))) + operation-element)) + (defun lxml->operation (lxml) (let* ((attributes (lxml-get-attributes lxml)) (name (getf attributes :|name|)) (wsdl-operation (make-instance 'wsdl-operation :name name))) (loop :for element :in (rest lxml) :do (case (lxml-get-tag element) - (wsdl:|input| (push (make-instance 'wsdl-input - :message (getf (lxml-get-attributes element) :|message|)) - (get-elements wsdl-operation))) - (wsdl:|output| (push (make-instance 'wsdl-output - :message (getf (lxml-get-attributes element) :|message|)) - (get-elements wsdl-operation))) - (wsdl:|fault| (push (make-instance 'wsdl-fault - :message (getf (lxml-get-attributes element) :|message|)) - (get-elements wsdl-operation))))) + (wsdl:|documentation| (setf (get-documentation wsdl-operation) + (rest element))) + (wsdl-soap:|operation| (let ((attributes (lxml-get-attributes element))) + (push (make-instance 'wsdl-soap-operation + :style (getf attributes :|style|) + :soap-action (getf attributes :|soapAction|)) + (get-extensions wsdl-operation)))) + ((wsdl:|input| wsdl:|output| wsdl:|fault|) (push (lxml->operation-element element) + (get-elements wsdl-operation))))) wsdl-operation)) (defun lxml->port-type (lxml) @@ -139,6 +189,8 @@ (wsdl-port-type (make-instance 'wsdl-port-type :name name))) (loop :for element :in (rest lxml) :do (case (lxml-get-tag element) + (wsdl:|documentation| (setf (get-documentation wsdl-port-type) + (rest element))) (wsdl:|operation| (push (lxml->operation element) (get-operations wsdl-port-type))))) wsdl-port-type)) @@ -160,6 +212,8 @@ (wsdl-message (make-instance 'wsdl-message :name name))) (loop :for element :in (rest lxml) :do (case (lxml-get-tag element) + (wsdl:|documentation| (setf (get-documentation wsdl-message) + (rest element))) (wsdl:|part| (push (lxml->part element) (get-parts wsdl-message))))) wsdl-message)) @@ -171,6 +225,13 @@ (wsdl-binding (make-instance 'wsdl-binding :name name :type type))) (loop :for element :in (rest lxml) :do (case (lxml-get-tag element) + (wsdl:|documentation| (setf (get-documentation wsdl-binding) + (rest element))) + (wsdl-soap:|binding| (let ((attributes (lxml-get-attributes element))) + (push (make-instance 'wsdl-soap-binding + :style (getf attributes :|style|) + :transport (getf attributes :|transport|)) + (get-extensions wsdl-binding)))) (wsdl:|operation| (push (lxml->operation element) (get-operations wsdl-binding))))) wsdl-binding)) @@ -180,6 +241,13 @@ (name (getf attributes :|name|)) (binding (getf attributes :|binding|)) (wsdl-port (make-instance 'wsdl-port :name name :binding binding))) + (loop :for element :in (rest lxml) + :do (case (lxml-get-tag element) + (wsdl:|documentation| (setf (get-documentation wsdl-port) + (rest element))) + (wsdl-soap:|address| (setf (get-extension wsdl-port) + (make-instance 'wsdl-soap-address + :location (getf (lxml-get-attributes element) :|location|)))))) wsdl-port)) (defun lxml->service (lxml) @@ -188,6 +256,8 @@ (wsdl-service (make-instance 'wsdl-service :name name))) (loop :for element :in (rest lxml) :do (case (lxml-get-tag element) + (wsdl:|documentation| (setf (get-documentation wsdl-service) + (rest element))) (wsdl:|port| (push (lxml->port element) (get-ports wsdl-service))))) wsdl-service))

1 0

[cl-soap-cvs] CVS update: cl-soap/src/soap.lisp
by scaekenberghe＠common-lisp.net 10 Sep '05

10 Sep '05

Update of /project/cl-soap/cvsroot/cl-soap/src In directory common-lisp.net:/tmp/cvs-serv29935/src Modified Files: soap.lisp Log Message: making clear that we only handle a single soap body elementCVS: ---------------------------------------------------------------------- Date: Sat Sep 10 21:57:50 2005 Author: scaekenberghe Index: cl-soap/src/soap.lisp diff -u cl-soap/src/soap.lisp:1.3 cl-soap/src/soap.lisp:1.4 --- cl-soap/src/soap.lisp:1.3 Fri Sep 9 13:21:16 2005 +++ cl-soap/src/soap.lisp Sat Sep 10 21:57:50 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: soap.lisp,v 1.3 2005/09/09 11:21:16 scaekenberghe Exp $ +;;;; $Id: soap.lisp,v 1.4 2005/09/10 19:57:50 scaekenberghe Exp $ ;;;; ;;;; The basic SOAP protocol ;;;; @@ -79,8 +79,16 @@ ;;; Call Interface -(defun soap-call (server-end-point header body &key soap-action envelope-attributes header-attributes body-attributes) +(defun soap-call (server-end-point + header + body + &key + soap-action + envelope-attributes + header-attributes + body-attributes) "Make a SOAP Call to server-end-point using headers and body" + ;; only one single body element is allowed/supported for now (let* ((call-soap-envelope (soap-envelope header body :envelope-attributes envelope-attributes :header-attributes header-attributes

1 0

[cl-soap-cvs] CVS update: cl-soap/test/test-basic.lisp
by scaekenberghe＠common-lisp.net 10 Sep '05

10 Sep '05

Update of /project/cl-soap/cvsroot/cl-soap/test In directory common-lisp.net:/tmp/cvs-serv29909/test Modified Files: test-basic.lisp Log Message: added the random.org example (contributed by carlos.ungil(a)bluewin.ch) Date: Sat Sep 10 21:56:28 2005 Author: scaekenberghe Index: cl-soap/test/test-basic.lisp diff -u cl-soap/test/test-basic.lisp:1.2 cl-soap/test/test-basic.lisp:1.3 --- cl-soap/test/test-basic.lisp:1.2 Thu Sep 8 17:39:46 2005 +++ cl-soap/test/test-basic.lisp Sat Sep 10 21:56:28 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: test-basic.lisp,v 1.2 2005/09/08 15:39:46 scaekenberghe Exp $ +;;;; $Id: test-basic.lisp,v 1.3 2005/09/10 19:56:28 scaekenberghe Exp $ ;;;; ;;;; Some test for the basic SOAP protocol ;;;; @@ -76,6 +76,26 @@ (coerce (read-from-string (second contents)) 'float) (error "Expected a <Result> element"))) (error "Expected a <getRateResponse> element"))))) + +;; contributed by carlos.ungil(a)bluewin.ch +;; http://www.random.org/soap.html +;; http://www.random.org/RandomDotOrg.wsdl +;; http://www.random.org/clients/soap/ + +(defun get-random-number (&key unsigned) + "Returns a true random number in the interval [2^31, 2^31) or [0, 2^31)" + (let ((ns "urn:RandomDotOrg")) + (s-xml:register-namespace ns "ns1" :ns1) + (let* ((rng (make-soap-end-point "http://www.random.org/cgi-bin/Random.cgi")) + (result (soap-call rng + nil + (if unsigned + `((ns1::|lrand48| :|xmlns:ns1| ,ns)) + `((ns1::|mrand48| :|xmlns:ns1| ,ns)))))) + (if (or (eql (lxml-get-tag result) 'ns1::|lrand48Response|) + (eql (lxml-get-tag result) 'ns1::|mrand48Response|)) + (values (parse-integer (second (second result)))) + (error "Expected a <lrand48Response> or <mrand48Response> element"))))) ;; accessing local AXIS services

1 0

[cl-soap-cvs] CVS update: cl-soap/src/lxml.lisp
by scaekenberghe＠common-lisp.net 10 Sep '05

10 Sep '05

Update of /project/cl-soap/cvsroot/cl-soap/src In directory common-lisp.net:/tmp/cvs-serv29873/src Modified Files: lxml.lisp Log Message: single symbols are also lxml Date: Sat Sep 10 21:55:19 2005 Author: scaekenberghe Index: cl-soap/src/lxml.lisp diff -u cl-soap/src/lxml.lisp:1.2 cl-soap/src/lxml.lisp:1.3 --- cl-soap/src/lxml.lisp:1.2 Fri Sep 9 16:17:37 2005 +++ cl-soap/src/lxml.lisp Sat Sep 10 21:55:19 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: lxml.lisp,v 1.2 2005/09/09 14:17:37 scaekenberghe Exp $ +;;;; $Id: lxml.lisp,v 1.3 2005/09/10 19:55:19 scaekenberghe Exp $ ;;;; ;;;; Some tools to manipulate lxml ;;;; @@ -14,14 +14,14 @@ (in-package :cl-soap) (defun lxml-get-tag (lxml) - (if (symbolp (first lxml)) - (first lxml) - (first (first lxml)))) + (cond ((symbolp lxml) lxml) + ((stringp lxml) '()) + ((symbolp (first lxml)) (first lxml)) + (t (first (first lxml))))) (defun lxml-get-attributes (lxml) - (if (symbolp (first lxml)) - '() - (rest (first lxml)))) + (cond ((or (symbolp lxml) (stringp lxml) (symbolp (first lxml))) '()) + (t (rest (first lxml))))) (defun lxml-find-tag (tag lxml) (find tag lxml :key #'lxml-get-tag))

1 0

[cl-soap-cvs] CVS update: public_html/index.html
by scaekenberghe＠common-lisp.net 09 Sep '05

09 Sep '05

Update of /project/cl-soap/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv21978 Modified Files: index.html Log Message: added cvs instructions Date: Fri Sep 9 21:30:14 2005 Author: scaekenberghe Index: public_html/index.html diff -u public_html/index.html:1.2 public_html/index.html:1.3 --- public_html/index.html:1.2 Mon Sep 5 10:03:12 2005 +++ public_html/index.html Fri Sep 9 21:30:14 2005 @@ -18,10 +18,19 @@ <ul> <li>Setup of a public open source project (on <a href="http://common-lisp.net">common-lisp.net</a> ). <ul> - <li>The official project home is + <li>The official project home is <a href="http://common-lisp.net/project/cl-soap">http://common-lisp.net/project/cl-soap</a></li> <li>The CVS repository can be found at <a href="http://common-lisp.net/cgi-bin/viewcvs.cgi/?cvsroot=cl-soap">http://common-lisp.net/cgi-bin/viewcvs.cgi/?cvsroot=cl-soap</a></li> + <li>To get the code through CVS: + <pre>$ cvs -d:pserver:anonymous@common-lisp.net:/project/cl-soap/cvsroot login +Logging in to :pserver:anonymous@common-lisp.net:2401/project/cl-soap/cvsroot +CVS password: +$ cvs -d:pserver:anonymous@common-lisp.net:/project/cl-soap/cvsroot co cl-soap +cvs server: Updating cl-soap +...</pre> + Specifiy 'anonymous' as password. Afterwards, keep up to date by issuing <tt>cvs update</tt> in the cl-soap directory. + </li> <li>The following mailing list are available: <a href="http://common-lisp.net/mailman/listinfo/cl-soap-devel">CL-SOAP-DEVEL</a> as well as @@ -80,6 +89,6 @@ Initial developers and contributors will include Sven Van Caekenberghe (Beta Nine), Alain Picard (Memetrics), Ivan Melotte (Beta Nine) and Nicky Peeters (Beta Nine). -$Id: index.html,v 1.2 2005/09/05 08:03:12 scaekenberghe Exp $ +$Id: index.html,v 1.3 2005/09/09 19:30:14 scaekenberghe Exp $ </body> </html>

1 0

[cl-soap-cvs] CVS update: cl-soap/src/namespaces.lisp
by scaekenberghe＠common-lisp.net 09 Sep '05

09 Sep '05

Update of /project/cl-soap/cvsroot/cl-soap/src In directory common-lisp.net:/tmp/cvs-serv1240/src Modified Files: namespaces.lisp Log Message: more exports Date: Fri Sep 9 16:18:02 2005 Author: scaekenberghe Index: cl-soap/src/namespaces.lisp diff -u cl-soap/src/namespaces.lisp:1.3 cl-soap/src/namespaces.lisp:1.4 --- cl-soap/src/namespaces.lisp:1.3 Fri Sep 9 16:17:37 2005 +++ cl-soap/src/namespaces.lisp Fri Sep 9 16:18:02 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: namespaces.lisp,v 1.3 2005/09/09 14:17:37 scaekenberghe Exp $ +;;;; $Id: namespaces.lisp,v 1.4 2005/09/09 14:18:02 scaekenberghe Exp $ ;;;; ;;;; Definition of some standard XML namespaces commonly needed for SOAP ;;;; @@ -62,7 +62,7 @@ (:nicknames "wsdl") (:export "definitions" "documentation" - "portType" "message" "operation" "port" "service" "binding" "part" "input" "output" "fault") + "portType" "message" "operation" "port" "service" "binding" "part" "input" "output" "fault" "types") (:documentation "Package for symbols in the WSDL XML Namespace")) (defparameter *wsdl-ns* (s-xml:register-namespace +wsdl-ns-uri+ "wsdl" :wsdl))

1 0

[cl-soap-cvs] CVS update: cl-soap/src/lxml.lisp cl-soap/src/namespaces.lisp cl-soap/src/wsdl.lisp
by scaekenberghe＠common-lisp.net 09 Sep '05

09 Sep '05

Update of /project/cl-soap/cvsroot/cl-soap/src In directory common-lisp.net:/tmp/cvs-serv1218/src Modified Files: lxml.lisp namespaces.lisp wsdl.lisp Log Message: first code to parse generic (non-soap-binding) wsdl into a lisp model Date: Fri Sep 9 16:17:38 2005 Author: scaekenberghe Index: cl-soap/src/lxml.lisp diff -u cl-soap/src/lxml.lisp:1.1 cl-soap/src/lxml.lisp:1.2 --- cl-soap/src/lxml.lisp:1.1 Mon Sep 5 10:35:55 2005 +++ cl-soap/src/lxml.lisp Fri Sep 9 16:17:37 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: lxml.lisp,v 1.1 2005/09/05 08:35:55 scaekenberghe Exp $ +;;;; $Id: lxml.lisp,v 1.2 2005/09/09 14:17:37 scaekenberghe Exp $ ;;;; ;;;; Some tools to manipulate lxml ;;;; @@ -17,6 +17,11 @@ (if (symbolp (first lxml)) (first lxml) (first (first lxml)))) + +(defun lxml-get-attributes (lxml) + (if (symbolp (first lxml)) + '() + (rest (first lxml)))) (defun lxml-find-tag (tag lxml) (find tag lxml :key #'lxml-get-tag)) Index: cl-soap/src/namespaces.lisp diff -u cl-soap/src/namespaces.lisp:1.2 cl-soap/src/namespaces.lisp:1.3 --- cl-soap/src/namespaces.lisp:1.2 Thu Sep 8 17:39:42 2005 +++ cl-soap/src/namespaces.lisp Fri Sep 9 16:17:37 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: namespaces.lisp,v 1.2 2005/09/08 15:39:42 scaekenberghe Exp $ +;;;; $Id: namespaces.lisp,v 1.3 2005/09/09 14:17:37 scaekenberghe Exp $ ;;;; ;;;; Definition of some standard XML namespaces commonly needed for SOAP ;;;; @@ -60,7 +60,9 @@ (defpackage :wsdl (:nicknames "wsdl") - (:export) + (:export + "definitions" "documentation" + "portType" "message" "operation" "port" "service" "binding" "part" "input" "output" "fault") (:documentation "Package for symbols in the WSDL XML Namespace")) (defparameter *wsdl-ns* (s-xml:register-namespace +wsdl-ns-uri+ "wsdl" :wsdl)) Index: cl-soap/src/wsdl.lisp diff -u cl-soap/src/wsdl.lisp:1.1 cl-soap/src/wsdl.lisp:1.2 --- cl-soap/src/wsdl.lisp:1.1 Mon Sep 5 10:35:55 2005 +++ cl-soap/src/wsdl.lisp Fri Sep 9 16:17:37 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: wsdl.lisp,v 1.1 2005/09/05 08:35:55 scaekenberghe Exp $ +;;;; $Id: wsdl.lisp,v 1.2 2005/09/09 14:17:37 scaekenberghe Exp $ ;;;; ;;;; The basic WSDL protocol ;;;; @@ -16,33 +16,41 @@ ;;; Generic Soap Model (defclass abstract-wsdl-definition () - ((name) - (documentation))) + ((name :accessor get-name :initarg :name :initform nil) + (documentation :accessor get-documentation :initarg :documentation :initform nil))) + +(defmethod print-object ((object abstract-wsdl-definition) out) + (print-unreadable-object (object out :type t :identity t) + (prin1 (or (get-name object) "anonymous") out))) (defclass wsdl-document-definitions (abstract-wsdl-definition) - ((target-namespace) - (types) - (messages) - (port-types) - (bindings) - (services))) + ((target-namespace :accessor get-target-namespace :initarg :target-namespace :initform nil) + (types :accessor get-types :initarg :types :initform nil) + (messages :accessor get-messages :initarg :messages :initform nil) + (port-types :accessor get-port-types :initarg :port-types :initform nil) + (bindings :accessor get-bindings :initarg :bindings :initform nil) + (services :accessor get-services :initarg :bindings :initform nil))) (defclass wsdl-service (abstract-wsdl-definition) - ((ports))) + ((ports :accessor get-ports :initarg :ports :initform nil))) (defclass wsdl-port (abstract-wsdl-definition) - ((binding) + ((binding :accessor get-binding :initarg :binding :initform nil) (network-address))) (defclass wsdl-binding (abstract-wsdl-definition) - ((type) - (operations))) + ((type :accessor get-type :initarg :type :initform nil) + (operations :accessor get-operations :initarg :operations :initform nil))) (defclass wsdl-port-type (abstract-wsdl-definition) - ((operations))) + ((operations :accessor get-operations :initarg :operations :initform nil))) (defclass wsdl-operation-element () - ((message))) + ((message :accessor get-message :initarg :message :initform nil))) + +(defmethod print-object ((object wsdl-operation-element) out) + (print-unreadable-object (object out :type t :identity t) + (prin1 (get-message object) out))) (defclass wsdl-input (wsdl-operation-element) ()) @@ -54,15 +62,19 @@ ()) (defclass wsdl-operation (abstract-wsdl-definition) - ((elements))) + ((elements :accessor get-elements :initarg :elements :initform nil))) (defclass wsdl-part () - ((name) - (element) - (type))) + ((name :accessor get-name :initarg :name :initform nil) + (element :accessor get-element :initarg :element :initform nil) + (type :accessor get-type :initarg :type :initform nil))) + +(defmethod print-object ((object wsdl-part) out) + (print-unreadable-object (object out :type t :identity t) + (prin1 (or (get-name object) "anonymous") out))) (defclass wsdl-message (abstract-wsdl-definition) - ((parts))) + ((parts :accessor get-parts :initarg :parts :initform nil))) (defclass wsdl-type (abstract-wsdl-definition) ((data-type-definitions))) @@ -101,5 +113,117 @@ (defclass wsdl-soap-header-fault (wsdl-soap-header) ()) + +;; Parsing + +(defun lxml->operation (lxml) + (let* ((attributes (lxml-get-attributes lxml)) + (name (getf attributes :|name|)) + (wsdl-operation (make-instance 'wsdl-operation :name name))) + (loop :for element :in (rest lxml) + :do (case (lxml-get-tag element) + (wsdl:|input| (push (make-instance 'wsdl-input + :message (getf (lxml-get-attributes element) :|message|)) + (get-elements wsdl-operation))) + (wsdl:|output| (push (make-instance 'wsdl-output + :message (getf (lxml-get-attributes element) :|message|)) + (get-elements wsdl-operation))) + (wsdl:|fault| (push (make-instance 'wsdl-fault + :message (getf (lxml-get-attributes element) :|message|)) + (get-elements wsdl-operation))))) + wsdl-operation)) + +(defun lxml->port-type (lxml) + (let* ((attributes (lxml-get-attributes lxml)) + (name (getf attributes :|name|)) + (wsdl-port-type (make-instance 'wsdl-port-type :name name))) + (loop :for element :in (rest lxml) + :do (case (lxml-get-tag element) + (wsdl:|operation| (push (lxml->operation element) + (get-operations wsdl-port-type))))) + wsdl-port-type)) + +(defun lxml->part (lxml) + (let* ((attributes (lxml-get-attributes lxml)) + (name (getf attributes :|name|)) + (element (getf attributes :|element|)) + (type (getf attributes :|type|)) + (wsdl-part (make-instance 'wsdl-part + :name name + :element element + :type type))) + wsdl-part)) + +(defun lxml->message (lxml) + (let* ((attributes (lxml-get-attributes lxml)) + (name (getf attributes :|name|)) + (wsdl-message (make-instance 'wsdl-message :name name))) + (loop :for element :in (rest lxml) + :do (case (lxml-get-tag element) + (wsdl:|part| (push (lxml->part element) + (get-parts wsdl-message))))) + wsdl-message)) + +(defun lxml->binding (lxml) + (let* ((attributes (lxml-get-attributes lxml)) + (name (getf attributes :|name|)) + (type (getf attributes :|type|)) + (wsdl-binding (make-instance 'wsdl-binding :name name :type type))) + (loop :for element :in (rest lxml) + :do (case (lxml-get-tag element) + (wsdl:|operation| (push (lxml->operation element) + (get-operations wsdl-binding))))) + wsdl-binding)) + +(defun lxml->port (lxml) + (let* ((attributes (lxml-get-attributes lxml)) + (name (getf attributes :|name|)) + (binding (getf attributes :|binding|)) + (wsdl-port (make-instance 'wsdl-port :name name :binding binding))) + wsdl-port)) + +(defun lxml->service (lxml) + (let* ((attributes (lxml-get-attributes lxml)) + (name (getf attributes :|name|)) + (wsdl-service (make-instance 'wsdl-service :name name))) + (loop :for element :in (rest lxml) + :do (case (lxml-get-tag element) + (wsdl:|port| (push (lxml->port element) + (get-ports wsdl-service))))) + wsdl-service)) + +(defun parse-wsdl (in) + (let ((lxml (s-xml:parse-xml in))) + (if (eql (lxml-get-tag lxml) 'wsdl:|definitions|) + (let* ((attributes (lxml-get-attributes lxml)) + (name (getf attributes :|name|)) + (target-namespace (getf attributes :|targetNamespace|)) + (wsdl-document-definitions (make-instance 'wsdl-document-definitions + :name name + :target-namespace target-namespace))) + (loop :for element :in (rest lxml) + :do (case (lxml-get-tag element) + (wsdl:|documentation| (setf (get-documentation wsdl-document-definitions) + (rest element))) + (wsdl:|types|) + (wsdl:|message| (push (lxml->message element) + (get-messages wsdl-document-definitions))) + (wsdl:|portType| (push (lxml->port-type element) + (get-port-types wsdl-document-definitions))) + (wsdl:|binding| (push (lxml->binding element) + (get-bindings wsdl-document-definitions))) + (wsdl:|service| (push (lxml->service element) + (get-services wsdl-document-definitions))))) + wsdl-document-definitions) + (error "Expected a WSDL <definitions> element")))) + +(defun parse-wsdl-file (pathname) + (with-open-file (in pathname) + (parse-wsdl in))) + +(defun parse-wsdl-url (url) + (let ((buffer (do-http-request url))) + (with-input-from-string (in buffer) + (parse-wsdl in)))) ;;;; eof

1 0