- cl-soap-cvs@common-lisp.net - mailman3.common-lisp.net

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

15 Sep '05

Update of /project/cl-soap/cvsroot/cl-soap/test In directory common-lisp.net:/tmp/cvs-serv23840/test Modified Files: test-wsdl.lisp Log Message: marked which function don't work and why Date: Thu Sep 15 15:31:54 2005 Author: scaekenberghe Index: cl-soap/test/test-wsdl.lisp diff -u cl-soap/test/test-wsdl.lisp:1.1 cl-soap/test/test-wsdl.lisp:1.2 --- cl-soap/test/test-wsdl.lisp:1.1 Mon Sep 12 16:28:41 2005 +++ cl-soap/test/test-wsdl.lisp Thu Sep 15 15:31:54 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: test-wsdl.lisp,v 1.1 2005/09/12 14:28:41 scaekenberghe Exp $ +;;;; $Id: test-wsdl.lisp,v 1.2 2005/09/15 13:31:54 scaekenberghe Exp $ ;;;; ;;;; Some test for the WSDL structured SOAP protocol ;;;; @@ -17,6 +17,7 @@ ;; http://xmethods.net (defun xmethods-get-quote (symbol) + ;; doesn't work: response element incorrectly described in wsdl wrt wire usage ?? (wsdl-soap-call "http://services.xmethods.net/soap/urn:xmethods-delayed-quotes.wsdl" "getQuote" :input `("symbol" ,symbol))) @@ -37,6 +38,7 @@ ;; http://www.random.org/clients/soap/ (defun get-random-number (&key unsigned) + ;; doesn't work: response element incorrectly described in wsdl wrt wire usage ?? "Returns a true random number in the interval [2^31, 2^31) or [0, 2^31)" (wsdl-soap-call "http://www.random.org/RandomDotOrg.wsdl" (if unsigned "lrand48" "mrand48"))) @@ -44,6 +46,8 @@ ;; accessing local AXIS services (defun axis-example3-echo (string) + ;; doesn't work: different input/output namespaces currently not supported + ;; furthermore namespaces seem to be described inconsistently in wsdl wrt wire usage ?? (wsdl-soap-call "http://localhost:8080/axis/services/MyService?wsdl" "serviceMethod" :input `("arg" ,string)))

1 0

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

15 Sep '05

Update of /project/cl-soap/cvsroot/cl-soap/src In directory common-lisp.net:/tmp/cvs-serv23561/src Modified Files: package.lisp Log Message: added exports to define the public API Date: Thu Sep 15 15:31:11 2005 Author: scaekenberghe Index: cl-soap/src/package.lisp diff -u cl-soap/src/package.lisp:1.1 cl-soap/src/package.lisp:1.2 --- cl-soap/src/package.lisp:1.1 Mon Sep 5 10:35:55 2005 +++ cl-soap/src/package.lisp Thu Sep 15 15:31:11 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: package.lisp,v 1.1 2005/09/05 08:35:55 scaekenberghe Exp $ +;;;; $Id: package.lisp,v 1.2 2005/09/15 13:31:11 scaekenberghe Exp $ ;;;; ;;;; Definition of the CL-SOAP package ;;;; @@ -15,7 +15,21 @@ (defpackage :cl-soap (:use :common-lisp) - (:export) + (:export + ;; standard soap + #:make-soap-end-point #:soap-call + standard-soap-fault #:fault-code #:fault-string #:fault-actor #:fault-detail + #:*debug-stream* *last-soap-call-xml* *last-soap-result-xml* + +soap-enc-ns-uri+ + ;; wsdl + #:parse-wsdl #:parse-wsdl-file #:parse-wsdl-url #:describe-wsdl-soap + #:wsdl-soal-call + ;; xsd + #:parse-xsd #:parse-xsd-file #:parse-xsd-url + ;; lxml + #:lxml-get-tag #:lxml-get-attributes #:lxml-find-tag + ;; html-client + #:do-http-request #:make-http-client-state #:close-all-connections) (:documentation "The Common Lisp SOAP package")) ;;;; eof

1 0

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

15 Sep '05

Update of /project/cl-soap/cvsroot/cl-soap/src In directory common-lisp.net:/tmp/cvs-serv23294/src Modified Files: http-client.lisp Log Message: added https support for lispworks Date: Thu Sep 15 15:30:44 2005 Author: scaekenberghe Index: cl-soap/src/http-client.lisp diff -u cl-soap/src/http-client.lisp:1.4 cl-soap/src/http-client.lisp:1.5 --- cl-soap/src/http-client.lisp:1.4 Wed Sep 14 09:30:02 2005 +++ cl-soap/src/http-client.lisp Thu Sep 15 15:30:44 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: http-client.lisp,v 1.4 2005/09/14 07:30:02 scaekenberghe Exp $ +;;;; $Id: http-client.lisp,v 1.5 2005/09/15 13:30:44 scaekenberghe Exp $ ;;;; ;;;; A basic HTTP client, somewhat API compatible with portableaserve's do-http-request ;;;; Copied from another project (basic authorization support removed) @@ -21,10 +21,14 @@ (defclass http-client-state () ((data :initform nil))) -(defvar *default-http-client-state* (make-instance 'http-client-state)) +(defun make-http-client-state () + "Make a new HTTP client state object to hold open (keepalive) connections" + (make-instance 'http-client-state)) + +(defvar *default-http-client-state* (make-http-client-state)) (defclass http-server-state () - ((host-port :accessor get-host-port :initarg :host-port) + ((scheme-host-port :accessor get-scheme-host-port :initarg :scheme-host-port) (socket :accessor get-socket :initarg :socket :initform nil))) ;; low level output @@ -99,16 +103,17 @@ ;; connection / server state management -(defmethod get-http-server-state ((http-client-state http-client-state) host-port) +(defmethod get-http-server-state ((http-client-state http-client-state) scheme-host-port) (with-slots (data) http-client-state - (let ((server-state (find host-port data :key #'get-host-port :test #'string-equal))) + (let ((server-state (find scheme-host-port data :key #'get-scheme-host-port :test #'string-equal))) (unless server-state - (push (setf server-state (make-instance 'http-server-state :host-port host-port)) + (push (setf server-state (make-instance 'http-server-state :scheme-host-port scheme-host-port)) data)) server-state))) (defmethod close-all-connections ((http-client-state http-client-state) &key abort) + "Close all open connections in http-client-state (optionaly aborting them)" (with-slots (data) http-client-state (dolist (http-server-state data) @@ -116,30 +121,36 @@ (when connection (ignore-errors (close connection :abort abort))))))) -(defun open-socket-stream (host port) - #+lispworks (comm:open-tcp-stream host port) - #+openmcl (ccl:make-socket :remote-host host :remote-port port) - #+clisp (socket:socket-connect port host) - #+cmu (sys:make-fd-stream (ext:connect-to-inet-socket host port) :input t :output t :buffering :none) - #+sbcl (let ((socket (make-instance 'sb-bsd-sockets:inet-socket :type :stream :protocol :tcp))) - (sb-bsd-sockets:socket-connect socket - (car - (sb-bsd-sockets:host-ent-addresses - (sb-bsd-sockets:get-host-by-name host))) - port) - (sb-bsd-sockets:socket-make-stream socket :element-type 'character :input t :output t :buffering :none))) +(defun open-socket-stream (scheme host port) + #+lispworks (ecase scheme + (:http (comm:open-tcp-stream host port)) + (:https (comm:open-tcp-stream host port :ssl-ctx t))) + #+openmcl (when (eql scheme :http) + (ccl:make-socket :remote-host host :remote-port port)) + #+clisp (when (eql scheme :http) + (socket:socket-connect port host)) + #+cmu (when (eql scheme :http) + (sys:make-fd-stream (ext:connect-to-inet-socket host port) :input t :output t :buffering :none)) + #+sbcl (when (eql scheme :http) + (let ((socket (make-instance 'sb-bsd-sockets:inet-socket :type :stream :protocol :tcp))) + (sb-bsd-sockets:socket-connect socket + (car + (sb-bsd-sockets:host-ent-addresses + (sb-bsd-sockets:get-host-by-name host))) + port) + (sb-bsd-sockets:socket-make-stream socket :element-type 'character :input t :output t :buffering :none)))) -(defun get-open-connection (host port state &key force-new) +(defun get-open-connection (scheme host port state &key force-new) (if state - (let* ((host-port (format nil "~a:~d" host port)) - (server-state (get-http-server-state state host-port)) + (let* ((scheme-host-port (format nil "~a://~a:~d" scheme host port)) + (server-state (get-http-server-state state scheme-host-port)) (connection (get-socket server-state))) (if (and connection (open-stream-p connection) (not force-new)) (values connection :keep-alive) (progn (when connection (ignore-errors (close connection))) - (values (setf (get-socket server-state) (open-socket-stream host port)) :new)))) - (values (open-socket-stream host port) :new))) + (values (setf (get-socket server-state) (open-socket-stream scheme host port)) :new)))) + (values (open-socket-stream scheme host port) :new))) ;; high level HTTP protocol @@ -167,7 +178,9 @@ content content-type headers) "Write an HTTP request, full header and body, to stream" - (format-http-request-line stream "~a ~a~@[?~a~] HTTP/1.1" method (puri:uri-path uri) (puri:uri-query uri)) + (format-http-request-line stream + "~a ~a~@[?~a~] HTTP/1.1" + method (if (puri:uri-path uri) (puri:uri-path uri) "/") (puri:uri-query uri)) (format-http-request-line stream "Host: ~a:~d" (puri:uri-host uri) (puri:uri-port uri)) (format-http-request-line stream "User-Agent: ~a" *http-client-agent*) (format-http-request-line stream "Accept: ~a" *http-client-accept*) @@ -206,11 +219,15 @@ (declare (ignore proxy)) (assert (member method '(:get :put :post :delete :head))) (setf uri (puri:parse-uri uri)) - (let* ((host (puri:uri-host uri)) - (port (or (puri:uri-port uri) (setf (puri:uri-port uri) 80)))) + (let* ((scheme (puri:uri-scheme uri)) + (host (puri:uri-host uri)) + (port (or (puri:uri-port uri) + (setf (puri:uri-port uri) (ecase scheme + (:http 80) + (:https 443)))))) (multiple-value-bind (connection keep-alive) ;; state could hold an open (kept alive) connection to host:port - (get-open-connection host port state) + (get-open-connection scheme host port state) (flet ((execute-request-response () (values-list `(,@(multiple-value-list (do-one-request-response connection uri method @@ -225,7 +242,7 @@ ((or stream-error #+lispworks comm:socket-error) () (when keep-alive (setf keep-alive :new - connection (get-open-connection host port state :force-new t)) + connection (get-open-connection scheme host port state :force-new t)) (execute-request-response)))) (unless state (close connection)))))))

1 0

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

15 Sep '05

Update of /project/cl-soap/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv15796 Modified Files: index.html Log Message: added wsdl parse/describe example Date: Thu Sep 15 13:42:49 2005 Author: scaekenberghe Index: public_html/index.html diff -u public_html/index.html:1.4 public_html/index.html:1.5 --- public_html/index.html:1.4 Thu Sep 15 13:35:55 2005 +++ public_html/index.html Thu Sep 15 13:42:49 2005 @@ -96,7 +96,20 @@ Check out the test/test-basic.lisp file for more examples. </li> <li>WSDL with SOAP bindings in url/file/stream form can now be parsed into a Common Lisp representation. Use parse-wsdl, parse-wsdl-file and parse-wsdl-url.</li> - <li>The WSDL SOAP CL representation can be inspected and printed using describe-wsdl-soap.</li> + <li>The WSDL SOAP CL representation can be inspected and printed using describe-wsdl-soap. For example: + <pre>CL-SOAP> (describe-wsdl-soap (parse-wsdl-url "http://www.xmethods.net/sd/2001/CurrencyExchangeService.wsdl")) +WSDL Document Definitions named CurrencyExchangeService + Service: CurrencyExchangeService + Port: CurrencyExchangePort + SOAP Address Location "http://services.xmethods.net:80/soap" + Binding: tns:CurrencyExchangeBinding + Operation: getRate + Input: getRateRequest + Part: country2 (type xsd:string) + Part: country1 (type xsd:string) + Output: getRateResponse + Part: Result (type xsd:float)</pre> + </li> <li>There is a partial implementation for making SOAP calls with structured WSDL support, for example: <pre>(defun xmethods-get-rate (country1 country2) (wsdl-soap-call "http://www.xmethods.net/sd/2001/CurrencyExchangeService.wsdl" @@ -144,6 +157,6 @@ Initial developers and contributors will include Sven Van Caekenberghe (Beta Nine), Alain Picard (Memetrics), Ivan Melotte (Beta Nine) and Nicky Peeters (Beta Nine). <p> -<p>$Id: index.html,v 1.4 2005/09/15 11:35:55 scaekenberghe Exp $</p> +<p>$Id: index.html,v 1.5 2005/09/15 11:42:49 scaekenberghe Exp $</p> </body> </html>

1 0

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

15 Sep '05

Update of /project/cl-soap/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv15756 Modified Files: index.html Log Message: updated with installation instructions, status and some example code Date: Thu Sep 15 13:35:55 2005 Author: scaekenberghe Index: public_html/index.html diff -u public_html/index.html:1.3 public_html/index.html:1.4 --- public_html/index.html:1.3 Fri Sep 9 21:30:14 2005 +++ public_html/index.html Thu Sep 15 13:35:55 2005 @@ -52,6 +52,61 @@ <li>Good debugging support as well as initial unit and functional tests will be added.</li> </ul> </p> +<h3>Installation Instructions</h3> +<p> +<ul> +<li>Get the source code for CL-SOAP through CVS as described above.</li> +<li>Get the source code for <a href="http://common-lisp.net/project/s-xml">S-XML</a> + through CVS (<em>do not use a released version</em>).</li> +<li>Get a recent version of the <a href="http://puri.b9.com/">PURI</a> package.</li> +<li>Make sure ASDF works for you, add the *.asd files of the packages you just downloaded +(see the <a href="http://constantly.at/lisp/asdf"/>asdf manual</a>).</li> +<li>With all of the above done: + <pre>(asd:oos 'asdf:load-op :cl-soap)</pre> + should load all code into your lisp image (and compile it if necessary). +</li> +<li>Check out the example/test code in the <tt>test</tt> directory.</li> +<li>May the source be with you, always.</li> +</ul> +</p> +<h3>Status</h3> +<p> +<ul> + <li>S-XML was extended to support XML Namespaces</li> + <li>Basic, manual SOAP calls are now possible, for example: + <pre>(defun xmethods-get-quote (symbol) + "Calling http://services.xmethods.net/soap/urn:xmethods-delayed-quotes.wsdl" + (let ((ns "urn:xmethods-delayed-quotes")) + (s-xml:register-namespace ns "ns1" :ns1) + (let* ((xmethods (make-soap-end-point "http://64.124.140.30:9090/soap")) + (result (soap-call xmethods + '() + `((ns1::|getQuote| + soapenv:|encodingStyle| ,+soap-enc-ns-uri+ + :|xmlns:ns1| ,ns) + ((:|symbol| xsi::|type| "xsd:string") + ,symbol)) + :soap-action "urn:xmethods-delayed-quotes#getQuote"))) + (if (eql (lxml-get-tag result) 'ns1::|getQuoteResponse|) + (let ((contents (lxml-find-tag :|Result| (rest result)))) + (if contents + (coerce (read-from-string (second contents)) 'float) + (error "Expected a <Result> element"))) + (error "Expected a <getQuoteResponse> element")))))</pre> + Check out the test/test-basic.lisp file for more examples. + </li> + <li>WSDL with SOAP bindings in url/file/stream form can now be parsed into a Common Lisp representation. Use parse-wsdl, parse-wsdl-file and parse-wsdl-url.</li> + <li>The WSDL SOAP CL representation can be inspected and printed using describe-wsdl-soap.</li> + <li>There is a partial implementation for making SOAP calls with structured WSDL support, for example: + <pre>(defun xmethods-get-rate (country1 country2) + (wsdl-soap-call "http://www.xmethods.net/sd/2001/CurrencyExchangeService.wsdl" + "getRate" + :input `("country1" ,country1 "country2" ,country2)))</pre> + </li> + <li>Some partial support for XML Schema Defintion types definition in WSDL is being implemented.</li> + <li>Lot's of work remains to be done! All help is welcome.</li> +</ul> +</p> <h3>Next Phase(s) (Future)</h3> <p> <ul> @@ -89,6 +144,6 @@ Initial developers and contributors will include Sven Van Caekenberghe (Beta Nine), Alain Picard (Memetrics), Ivan Melotte (Beta Nine) and Nicky Peeters (Beta Nine). <p> -<p>$Id: index.html,v 1.3 2005/09/09 19:30:14 scaekenberghe Exp $</p> +<p>$Id: index.html,v 1.4 2005/09/15 11:35:55 scaekenberghe Exp $</p> </body> </html>

1 0

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

14 Sep '05

Update of /project/cl-soap/cvsroot/cl-soap/src In directory common-lisp.net:/tmp/cvs-serv26398/src Modified Files: http-client.lisp Log Message: renamed close to close-all-connections to prevent conflict function<>generic-function added open-socket-stream implementations for multiple CL implementations (from s-xml-rpc/sysdeps.lisp) Date: Wed Sep 14 09:30:03 2005 Author: scaekenberghe Index: cl-soap/src/http-client.lisp diff -u cl-soap/src/http-client.lisp:1.3 cl-soap/src/http-client.lisp:1.4 --- cl-soap/src/http-client.lisp:1.3 Fri Sep 9 13:21:16 2005 +++ cl-soap/src/http-client.lisp Wed Sep 14 09:30:02 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: http-client.lisp,v 1.3 2005/09/09 11:21:16 scaekenberghe Exp $ +;;;; $Id: http-client.lisp,v 1.4 2005/09/14 07:30:02 scaekenberghe Exp $ ;;;; ;;;; A basic HTTP client, somewhat API compatible with portableaserve's do-http-request ;;;; Copied from another project (basic authorization support removed) @@ -108,7 +108,7 @@ data)) server-state))) -(defmethod close ((http-client-state http-client-state) &key abort) +(defmethod close-all-connections ((http-client-state http-client-state) &key abort) (with-slots (data) http-client-state (dolist (http-server-state data) @@ -118,7 +118,16 @@ (defun open-socket-stream (host port) #+lispworks (comm:open-tcp-stream host port) - #+openmcl (ccl:make-socket :remote-host host :remote-port port)) + #+openmcl (ccl:make-socket :remote-host host :remote-port port) + #+clisp (socket:socket-connect port host) + #+cmu (sys:make-fd-stream (ext:connect-to-inet-socket host port) :input t :output t :buffering :none) + #+sbcl (let ((socket (make-instance 'sb-bsd-sockets:inet-socket :type :stream :protocol :tcp))) + (sb-bsd-sockets:socket-connect socket + (car + (sb-bsd-sockets:host-ent-addresses + (sb-bsd-sockets:get-host-by-name host))) + port) + (sb-bsd-sockets:socket-make-stream socket :element-type 'character :input t :output t :buffering :none))) (defun get-open-connection (host port state &key force-new) (if state

1 0

[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). <p> -<p>$Id: index.html,v 1.2 2005/09/05 08:03:12 scaekenberghe Exp $</p> +<p>$Id: index.html,v 1.3 2005/09/09 19:30:14 scaekenberghe Exp $</p> </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

[cl-soap-cvs] CVS update: cl-soap/src/http-client.lisp cl-soap/src/soap.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-serv21139/src Modified Files: http-client.lisp soap.lisp Log Message: some changed to allow more (optional) customization options to envelope/header/body attributes and some changes to the header itself Date: Fri Sep 9 13:21:17 2005 Author: scaekenberghe Index: cl-soap/src/http-client.lisp diff -u cl-soap/src/http-client.lisp:1.2 cl-soap/src/http-client.lisp:1.3 --- cl-soap/src/http-client.lisp:1.2 Thu Sep 8 17:39:42 2005 +++ cl-soap/src/http-client.lisp Fri Sep 9 13:21:16 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: http-client.lisp,v 1.2 2005/09/08 15:39:42 scaekenberghe Exp $ +;;;; $Id: http-client.lisp,v 1.3 2005/09/09 11:21:16 scaekenberghe Exp $ ;;;; ;;;; A basic HTTP client, somewhat API compatible with portableaserve's do-http-request ;;;; Copied from another project (basic authorization support removed) @@ -13,6 +13,8 @@ ;;;; (in-package :cl-soap) + +#+lispworks (require "comm") ;; data structures for state management Index: cl-soap/src/soap.lisp diff -u cl-soap/src/soap.lisp:1.2 cl-soap/src/soap.lisp:1.3 --- cl-soap/src/soap.lisp:1.2 Thu Sep 8 17:39:42 2005 +++ cl-soap/src/soap.lisp Fri Sep 9 13:21:16 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: soap.lisp,v 1.2 2005/09/08 15:39:42 scaekenberghe Exp $ +;;;; $Id: soap.lisp,v 1.3 2005/09/09 11:21:16 scaekenberghe Exp $ ;;;; ;;;; The basic SOAP protocol ;;;; @@ -57,33 +57,45 @@ ;;; SOAP content generation support -(defun soap-header (simple-header-alist) - (cons 'soapenv:|Header| simple-header-alist)) +(defun soap-header (header-lxml &optional header-attributes) + (when header-lxml + (if header-attributes + `(((soapenv:|Header| ,@header-attributes) ,@header-lxml)) + `((soapenv:|Header| ,@header-lxml))))) + +(defun soap-body (body-lxml &optional body-attributes) + (if body-attributes + `((soapenv:|Body| ,@body-attributes) ,body-lxml) + `(soapenv:|Body| ,body-lxml))) -(defun soap-envelope (header body) +(defun soap-envelope (header body &key envelope-attributes header-attributes body-attributes) `((soapenv:|Envelope| :|xmlns:soapenv| ,+soapenv-ns-uri+ :|xmlns:xsd| ,+xsd-ns-uri+ - :|xmlns:xsi| ,+xsi-ns-uri+) - ,@header - (soapenv:|Body| ,body))) + :|xmlns:xsi| ,+xsi-ns-uri+ + ,@envelope-attributes) + ,@(soap-header header header-attributes) + ,(soap-body body body-attributes))) ;;; Call Interface -(defun soap-call (server-end-point header body &key soap-action) +(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" - (let* ((call-soap-envelope (soap-envelope header body)) - (call-xml (s-xml:print-xml-string call-soap-envelope)) + (let* ((call-soap-envelope (soap-envelope header body + :envelope-attributes envelope-attributes + :header-attributes header-attributes + :body-attributes body-attributes)) + (call-xml (s-xml:print-xml-string call-soap-envelope :pretty t)) result-xml result-soap-envelope) (when *debug-stream* - (format *debug-stream* ";; SOAP CALL sending: ~s~%" call-xml)) + (format *debug-stream* ";; SOAP CALL sending: ~a~%" call-xml)) (setf result-xml (do-http-request (get-url server-end-point) :method :POST :headers `(("SOAPAction" . ,(or soap-action ""))) :content-type "text/xml" :content call-xml)) (when *debug-stream* - (format *debug-stream* ";; SOAP CALL receiving: ~s~%" result-xml)) + (format *debug-stream* ";; SOAP CALL receiving: ~a~%" result-xml)) (setf result-soap-envelope (s-xml:parse-xml-string result-xml)) (if (eql (lxml-get-tag result-soap-envelope) 'soapenv:|Envelope|) ;; we ignore returned headers for now

1 0

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

08 Sep '05

Update of /project/cl-soap/cvsroot/cl-soap/test In directory common-lisp.net:/tmp/cvs-serv3830/test Modified Files: test-basic.lisp Log Message: some bugfixes (thx to carlos.ungil(a)bluewin.ch) Date: Thu Sep 8 17:40:05 2005 Author: scaekenberghe Index: cl-soap/test/test-basic.lisp diff -u cl-soap/test/test-basic.lisp:1.1 cl-soap/test/test-basic.lisp:1.2 --- cl-soap/test/test-basic.lisp:1.1 Mon Sep 5 10:35:58 2005 +++ cl-soap/test/test-basic.lisp Thu Sep 8 17:39:46 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: test-basic.lisp,v 1.1 2005/09/05 08:35:58 scaekenberghe Exp $ +;;;; $Id: test-basic.lisp,v 1.2 2005/09/08 15:39:46 scaekenberghe Exp $ ;;;; ;;;; Some test for the basic SOAP protocol ;;;; @@ -91,7 +91,7 @@ :|xmlns:ns1| ,ns) ((:|arg2| xsi::|type| "xsd:string") ,string))))) - (if (eql (lxml-get-tag result) 'ns1:|serviceMethodResponse|) + (if (eql (lxml-get-tag result) 'ns1::|serviceMethodResponse|) (let ((contents (lxml-find-tag :|serviceMethodReturn| (rest result)))) (if contents (second contents)

1 0

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

08 Sep '05

Update of /project/cl-soap/cvsroot/cl-soap/src In directory common-lisp.net:/tmp/cvs-serv3830/src Modified Files: http-client.lisp namespaces.lisp soap.lisp Log Message: some bugfixes (thx to carlos.ungil(a)bluewin.ch) Date: Thu Sep 8 17:39:42 2005 Author: scaekenberghe Index: cl-soap/src/http-client.lisp diff -u cl-soap/src/http-client.lisp:1.1 cl-soap/src/http-client.lisp:1.2 --- cl-soap/src/http-client.lisp:1.1 Mon Sep 5 10:35:55 2005 +++ cl-soap/src/http-client.lisp Thu Sep 8 17:39:42 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: http-client.lisp,v 1.1 2005/09/05 08:35:55 scaekenberghe Exp $ +;;;; $Id: http-client.lisp,v 1.2 2005/09/08 15:39:42 scaekenberghe Exp $ ;;;; ;;;; A basic HTTP client, somewhat API compatible with portableaserve's do-http-request ;;;; Copied from another project (basic authorization support removed) @@ -115,7 +115,8 @@ (ignore-errors (close connection :abort abort))))))) (defun open-socket-stream (host port) - #+lispworks (comm:open-tcp-stream host port)) + #+lispworks (comm:open-tcp-stream host port) + #+openmcl (ccl:make-socket :remote-host host :remote-port port)) (defun get-open-connection (host port state &key force-new) (if state Index: cl-soap/src/namespaces.lisp diff -u cl-soap/src/namespaces.lisp:1.1 cl-soap/src/namespaces.lisp:1.2 --- cl-soap/src/namespaces.lisp:1.1 Mon Sep 5 10:35:55 2005 +++ cl-soap/src/namespaces.lisp Thu Sep 8 17:39:42 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: namespaces.lisp,v 1.1 2005/09/05 08:35:55 scaekenberghe Exp $ +;;;; $Id: namespaces.lisp,v 1.2 2005/09/08 15:39:42 scaekenberghe Exp $ ;;;; ;;;; Definition of some standard XML namespaces commonly needed for SOAP ;;;; @@ -22,7 +22,7 @@ (:export "Envelope" "Header" "Body" "Fault" "encodingStyle") (:documentation "Package for symbols in the SOAP Envelope XML Namespace")) -(defparameter *soapenv-ns* (s-xml:register-namespace +soapenv-ns-uri+ "soap-env" :soapenv)) +(defparameter *soapenv-ns* (s-xml:register-namespace +soapenv-ns-uri+ "soapenv" :soapenv)) ;;; XSD Index: cl-soap/src/soap.lisp diff -u cl-soap/src/soap.lisp:1.1 cl-soap/src/soap.lisp:1.2 --- cl-soap/src/soap.lisp:1.1 Mon Sep 5 10:35:55 2005 +++ cl-soap/src/soap.lisp Thu Sep 8 17:39:42 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: soap.lisp,v 1.1 2005/09/05 08:35:55 scaekenberghe Exp $ +;;;; $Id: soap.lisp,v 1.2 2005/09/08 15:39:42 scaekenberghe Exp $ ;;;; ;;;; The basic SOAP protocol ;;;; @@ -38,7 +38,7 @@ (let ((code (second (lxml-find-tag :|faultcode| (rest xml)))) (string (second (lxml-find-tag :|faultstring| (rest xml)))) (actor (second (lxml-find-tag :|faultactor| (rest xml)))) - (detail (second (lxml-find-tag :|faultactor| (rest xml))))) + (detail (second (lxml-find-tag :|detail| (rest xml))))) (make-condition 'standard-soap-fault :code code :string string

1 0

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

05 Sep '05

Update of /project/cl-soap/cvsroot/cl-soap/src In directory common-lisp.net:/tmp/cvs-serv14262/src Added Files: development.lisp http-client.lisp lxml.lisp namespaces.lisp package.lisp soap.lisp wsdl.lisp Log Message: Code copied from internal CVS repository Date: Mon Sep 5 10:35:55 2005 Author: scaekenberghe

1 0

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

05 Sep '05

Update of /project/cl-soap/cvsroot/cl-soap/test In directory common-lisp.net:/tmp/cvs-serv14262/test Added Files: test-basic.lisp Log Message: Code copied from internal CVS repository Date: Mon Sep 5 10:35:58 2005 Author: scaekenberghe

1 0

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

05 Sep '05

Update of /project/cl-soap/cvsroot/cl-soap In directory common-lisp.net:/tmp/cvs-serv14262 Added Files: cl-soap.asd Log Message: Code copied from internal CVS repository Date: Mon Sep 5 10:35:54 2005 Author: scaekenberghe

1 0

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

05 Sep '05

Update of /project/cl-soap/cvsroot/cl-soap/test In directory common-lisp.net:/tmp/cvs-serv14209/test Log Message: Directory /project/cl-soap/cvsroot/cl-soap/test added to the repository Date: Mon Sep 5 10:34:04 2005 Author: scaekenberghe New directory cl-soap/test added

1 0

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

05 Sep '05

Update of /project/cl-soap/cvsroot/cl-soap/src In directory common-lisp.net:/tmp/cvs-serv14209/src Log Message: Directory /project/cl-soap/cvsroot/cl-soap/src added to the repository Date: Mon Sep 5 10:34:04 2005 Author: scaekenberghe New directory cl-soap/src added

1 0

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

05 Sep '05

Update of /project/cl-soap/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv12122 Modified Files: index.html Log Message: added some progress report info Date: Mon Sep 5 10:03:12 2005 Author: scaekenberghe Index: public_html/index.html diff -u public_html/index.html:1.1 public_html/index.html:1.2 --- public_html/index.html:1.1 Mon Sep 5 09:07:08 2005 +++ public_html/index.html Mon Sep 5 10:03:12 2005 @@ -16,7 +16,18 @@ <h3>Phase 1 (First Delivery Target)</h3> <p> <ul> -<li>Setup of a public open source project (e.g. on <a href="http://common-lisp.net">common-lisp.net</a> ).</li> +<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 + <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>The following mailing list are available: + <a href="http://common-lisp.net/mailman/listinfo/cl-soap-devel">CL-SOAP-DEVEL</a> + as well as + <a href="http://common-lisp.net/mailman/listinfo/cl-soap-cvs">CL-SOAP-CVS</a></li> + </ul> +</li> <li>Implement as much of the general CL-SOAP framework to access the Google AdWords API ( <a href="http://www.google.com/apis/adwords/">http://www.google.com/apis/adwords/</a> ) from LispWorks ( <a href="http://www.lispworks.com">http://www.lispworks.com</a> ).</li> @@ -44,14 +55,18 @@ </p> <h3>Technical Notes</h3> <p> -This project will depend on an XML parser - either the S-XML parser -( <a href="http://common-lisp.net/project/s-xml">http://common-lisp.net/project/s-xml</a>) needs to be extended -to support some necessary features (namespaces, I8N encodings, CDATA support), or another -open-source XML parser has to be selected. +This project depends on an XML parser. The S-XML parser +( <a href="http://common-lisp.net/project/s-xml">http://common-lisp.net/project/s-xml</a>) +has been extended to support some necessary features (namespaces for now). +The code for these additions to S-XML has not yet been released, +and is only available in the CVS repository. +Some documentation of the XML Namespace feature in S-XML can be found in +<a href="http://common-lisp.net/pipermail/s-xml-devel/2005-August/000016.html">this mailing list message</a>. </p> <p> HTTP client and server code will be abstracted out and be made pluggable as to avoid unnecessary dependencies on other (larger) projects. +For now, a simple HTTP client has been added to the source code. </p> <h3>Organizational Notes</h3> <p> @@ -65,6 +80,6 @@ Initial developers and contributors will include Sven Van Caekenberghe (Beta Nine), Alain Picard (Memetrics), Ivan Melotte (Beta Nine) and Nicky Peeters (Beta Nine). <p> -<p>$Id: index.html,v 1.1 2005/09/05 07:07:08 scaekenberghe Exp $</p> +<p>$Id: index.html,v 1.2 2005/09/05 08:03:12 scaekenberghe Exp $</p> </body> </html>

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

cl-soap-cvs