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

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

16 Sep '05

Update of /project/cl-soap/cvsroot/cl-soap/src In directory common-lisp.net:/tmp/cvs-serv3468/src Modified Files: lxml.lisp wsdl.lisp xsd.lisp Log Message: basic integration of xsd primitive type handling in wsdl-soap-call Date: Fri Sep 16 09:51:15 2005 Author: scaekenberghe Index: cl-soap/src/lxml.lisp diff -u cl-soap/src/lxml.lisp:1.4 cl-soap/src/lxml.lisp:1.5 --- cl-soap/src/lxml.lisp:1.4 Thu Sep 15 15:32:32 2005 +++ cl-soap/src/lxml.lisp Fri Sep 16 09:51:15 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: lxml.lisp,v 1.4 2005/09/15 13:32:32 scaekenberghe Exp $ +;;;; $Id: lxml.lisp,v 1.5 2005/09/16 07:51:15 scaekenberghe Exp $ ;;;; ;;;; Some tools to manipulate lxml ;;;; @@ -13,6 +13,8 @@ (in-package :cl-soap) +;;; external + (defun lxml-get-tag (lxml) "Return the XML tag symbol of the lxml XML DOM" (cond ((symbolp lxml) lxml) @@ -28,5 +30,14 @@ (defun lxml-find-tag (tag lxml) "Find a specific tag in a lxml XML DOM list" (find tag lxml :key #'lxml-get-tag)) + +;;; internal + +(defun actual-name (qname) + "For now we ignore prefixes ;-)" + (multiple-value-bind (prefix identifier) + (s-xml:split-identifier qname) + (declare (ignore prefix)) + identifier)) ;;;; eof Index: cl-soap/src/wsdl.lisp diff -u cl-soap/src/wsdl.lisp:1.6 cl-soap/src/wsdl.lisp:1.7 --- cl-soap/src/wsdl.lisp:1.6 Thu Sep 15 15:37:34 2005 +++ cl-soap/src/wsdl.lisp Fri Sep 16 09:51:15 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: wsdl.lisp,v 1.6 2005/09/15 13:37:34 scaekenberghe Exp $ +;;;; $Id: wsdl.lisp,v 1.7 2005/09/16 07:51:15 scaekenberghe Exp $ ;;;; ;;;; The basic WSDL protocol: we parse the generic and soap specific parts ;;;; @@ -303,13 +303,6 @@ ;; 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)) @@ -436,12 +429,16 @@ (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)))) + (let* ((value (second (member (get-name part) input :test #'equal))) + (part-type (get-type part))) (if value (push `((,(intern (get-name part) :keyword) xsi::|type| ,(get-type part)) - ,(princ-to-string value)) - actual-input-parameters) + ;; basic type conversions ;-) + ,(if (xsd-primitive-type-name-p part-type) + (lisp->xsd-primitive value (intern-xsd-type-name part-type)) + (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 @@ -456,10 +453,17 @@ (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)) + (let* ((part-element (lxml-find-tag (intern (get-name part) :keyword) (rest result))) + (part-value (second part-element)) + (part-type (get-type part))) ;; part-element might have a type attribute as well + ;; basic type conversions ;-) + (if (xsd-primitive-type-name-p part-type) + (push (xsd-primitive->lisp part-value (intern-xsd-type-name part-type)) + result-values) + (push part-value result-values)))) + (if (= (length result-values) 1) + (first 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")))) Index: cl-soap/src/xsd.lisp diff -u cl-soap/src/xsd.lisp:1.1 cl-soap/src/xsd.lisp:1.2 --- cl-soap/src/xsd.lisp:1.1 Thu Sep 15 15:37:34 2005 +++ cl-soap/src/xsd.lisp Fri Sep 16 09:51:15 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: xsd.lisp,v 1.1 2005/09/15 13:37:34 scaekenberghe Exp $ +;;;; $Id: xsd.lisp,v 1.2 2005/09/16 07:51:15 scaekenberghe Exp $ ;;;; ;;;; A partial implementation of the XML Schema Definition standard ;;;; @@ -97,14 +97,79 @@ ;;; Interpreting the XSD model -;;; Primitive Types/Values +;;; Primitive Types/Values (types are keywords) + +(defconstant +known-primitive-type-names+ + '("string" + "normalizedString" "token" + "Name" "QName" "NCName" "anyURI" + "integer" + "positiveInteger" "negativeInteger" "nonPositiveInteger" "nonNegativeInteger" + "long" "unsignedLong" "int" "unsignedInt" "short" "unsignedShort" + "byte" "decimal" + "float" "double" + "boolean" + "duration" "date" "time" "dateTime" + "base64Binary" "hexBinary")) + +(defun xsd-primitive-type-name-p (name) + (member (actual-name name) +known-primitive-type-names+ :test #'string-equal)) + +(defun intern-xsd-type-name (name) + (intern (string-upcase (actual-name name)) :keyword)) (defun xsd-primitive->lisp (value type) - (declare (ignore type)) - value) + "Convert the XSD string value to a Common Lisp value, interpreting it as type" + ;; more work needed here ;-) + (ecase type + ((:string :normalizedString :token) + value) + ((:Name :QName :NCName :anyURI) + value) + ((:integer + :positiveInteger :negativeInteger :nonPositiveInteger :nonNegativeInteger + :long :unsignedLong :int :unsignedInt :short :unsignedShort + :byte :decimal) + (parse-integer value) 'integer) + (:float + (coerce (read-from-string value) 'float)) + (:double + (coerce (read-from-string value) 'double)) + (:boolean + (cond ((string-equal value "true") t) + ((string-equal value "false") nil) + (t (= (parse-integer value) 1)))) + (:duration value) + (:date value) + (:time value) + (:dateTime value) + ((:base64Binary :hexBinary) + (error "~a not yet supported as primitive type" type)))) (defun lisp->xsd-primitive (value type) - (declare (ignore type)) - value) + "Convert the Common Lisp value to a XSD string value, interpreting it as type" + ;; more work needed here ;-) + (ecase type + ((:string :normalizedString :token) + value) + ((:Name :QName :NCName :anyURI) + value) + ((:integer + :positiveInteger :negativeInteger :nonPositiveInteger :nonNegativeInteger + :long :unsignedLong :int :unsignedInt :short :unsignedShort + :byte :decimal) + (princ-to-string value)) + (:float + (princ-to-string value)) + (:double + (princ-to-string value)) + (:boolean + (if value "true" "false")) + (:duration value) + (:date value) + (:time value) + (:dateTime value) + ((:base64Binary :hexBinary) + (error "~a not yet supported as primitive type" type)))) ;;;; eof

1 0

[cl-soap-cvs] CVS update: cl-soap/src/xsd.lisp cl-soap/src/namespaces.lisp cl-soap/src/wsdl.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-serv23928/src Modified Files: namespaces.lisp wsdl.lisp Added Files: xsd.lisp Log Message: added first step towards partial XML Schema Definition implmentation to support WSDL types schema Date: Thu Sep 15 15:37:35 2005 Author: scaekenberghe Index: cl-soap/src/namespaces.lisp diff -u cl-soap/src/namespaces.lisp:1.5 cl-soap/src/namespaces.lisp:1.6 --- cl-soap/src/namespaces.lisp:1.5 Mon Sep 12 13:24:01 2005 +++ cl-soap/src/namespaces.lisp Thu Sep 15 15:37:34 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: namespaces.lisp,v 1.5 2005/09/12 11:24:01 scaekenberghe Exp $ +;;;; $Id: namespaces.lisp,v 1.6 2005/09/15 13:37:34 scaekenberghe Exp $ ;;;; ;;;; Definition of some standard XML namespaces commonly needed for SOAP ;;;; @@ -32,7 +32,9 @@ (defpackage :xsd (:nicknames "xsd") - (:export) + (:export "schema" "element" "simpleType" "complexType" + "sequence" "choice" "all" "attribute" + "restriction" "maxLength" "pattern" "list" "union" "enumeration") (:documentation "Package for symbols in the XML Schema Definition XML Namespace")) (defparameter *xsd-ns* (s-xml:register-namespace +xsd-ns-uri+ "xsd" :xsd)) Index: cl-soap/src/wsdl.lisp diff -u cl-soap/src/wsdl.lisp:1.5 cl-soap/src/wsdl.lisp:1.6 --- cl-soap/src/wsdl.lisp:1.5 Tue Sep 13 21:23:48 2005 +++ cl-soap/src/wsdl.lisp Thu Sep 15 15:37:34 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: wsdl.lisp,v 1.5 2005/09/13 19:23:48 scaekenberghe Exp $ +;;;; $Id: wsdl.lisp,v 1.6 2005/09/15 13:37:34 scaekenberghe Exp $ ;;;; ;;;; The basic WSDL protocol: we parse the generic and soap specific parts ;;;; @@ -79,10 +79,6 @@ (defclass wsdl-message (abstract-wsdl-definition) ((parts :accessor get-parts :initarg :parts :initform nil))) -(defclass wsdl-type (abstract-wsdl-definition) - ;; to be finished !!! - ((data-type-definitions))) - ;;; WSDL SOAP Model Extension Elements (defclass wsdl-soap-address () @@ -122,6 +118,13 @@ ;; one day we should handle <import> statements ;-) +(defun lxml->types (lxml) + (let (types) + (loop :for element :in (rest lxml) :do + (if (eql (lxml-get-tag element) 'xsd:|schema|) + (push (lxml->schema-definition element) types))) + types)) + (defun lxml->operation-element (lxml) (let* ((attributes (lxml-get-attributes lxml)) (message (getf attributes :|message|)) @@ -247,7 +250,8 @@ (rest element))) (wsdl-soap:|address| (setf (get-extension wsdl-port) (make-instance 'wsdl-soap-address - :location (getf (lxml-get-attributes element) :|location|)))))) + :location (getf (lxml-get-attributes element) + :|location|)))))) wsdl-port)) (defun lxml->service (lxml) @@ -275,7 +279,8 @@ :do (case (lxml-get-tag element) (wsdl:|documentation| (setf (get-documentation wsdl-document-definitions) (rest element))) - (wsdl:|types|) + (wsdl:|types| (setf (get-types wsdl-document-definitions) + (lxml->types element))) (wsdl:|message| (push (lxml->message element) (get-messages wsdl-document-definitions))) (wsdl:|portType| (push (lxml->port-type element)

1 0

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

15 Sep '05

Update of /project/cl-soap/cvsroot/cl-soap In directory common-lisp.net:/tmp/cvs-serv23928 Modified Files: cl-soap.asd Log Message: added first step towards partial XML Schema Definition implmentation to support WSDL types schema Date: Thu Sep 15 15:37:34 2005 Author: scaekenberghe Index: cl-soap/cl-soap.asd diff -u cl-soap/cl-soap.asd:1.1 cl-soap/cl-soap.asd:1.2 --- cl-soap/cl-soap.asd:1.1 Mon Sep 5 10:35:53 2005 +++ cl-soap/cl-soap.asd Thu Sep 15 15:37:33 2005 @@ -1,6 +1,6 @@ ;;;; -*- Mode: LISP -*- ;;;; -;;;; $Id: cl-soap.asd,v 1.1 2005/09/05 08:35:53 scaekenberghe Exp $ +;;;; $Id: cl-soap.asd,v 1.2 2005/09/15 13:37:33 scaekenberghe Exp $ ;;;; ;;;; The CL-SOAP ASDF system definition ;;;; @@ -28,7 +28,8 @@ (:file "http-client" :depends-on ("package")) (:file "lxml" :depends-on ("package")) (:file "namespaces" :depends-on ("package")) - (:file "soap" :depends-on ("package" "http-client" "namespaces" "lxml")) + (:file "xsd" :depends-on ("package" "namespaces" "lxml")) + (:file "soap" :depends-on ("package" "xsd" "http-client" "namespaces" "lxml")) (:file "wsdl" :depends-on ("package"))))) :depends-on (:s-xml :puri))

1 0

[cl-soap-cvs] CVS update: cl-soap/test/test-google-adwords.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-serv23904/test Added Files: test-google-adwords.lisp Log Message: newly created; google adwords specific tests testing parsing of all wsdl file Date: Thu Sep 15 15:34:45 2005 Author: scaekenberghe

1 0

[cl-soap-cvs] CVS update: cl-soap/src/lxml.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-serv23865/src Modified Files: lxml.lisp Log Message: added comments Date: Thu Sep 15 15:32:32 2005 Author: scaekenberghe Index: cl-soap/src/lxml.lisp diff -u cl-soap/src/lxml.lisp:1.3 cl-soap/src/lxml.lisp:1.4 --- cl-soap/src/lxml.lisp:1.3 Sat Sep 10 21:55:19 2005 +++ cl-soap/src/lxml.lisp Thu Sep 15 15:32:32 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: lxml.lisp,v 1.3 2005/09/10 19:55:19 scaekenberghe Exp $ +;;;; $Id: lxml.lisp,v 1.4 2005/09/15 13:32:32 scaekenberghe Exp $ ;;;; ;;;; Some tools to manipulate lxml ;;;; @@ -14,16 +14,19 @@ (in-package :cl-soap) (defun lxml-get-tag (lxml) + "Return the XML tag symbol of the lxml XML DOM" (cond ((symbolp lxml) lxml) ((stringp lxml) '()) ((symbolp (first lxml)) (first lxml)) (t (first (first lxml))))) (defun lxml-get-attributes (lxml) + "Return the XML attributes plist of the lxml XML DOM" (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)) + "Find a specific tag in a lxml XML DOM list" + (find tag lxml :key #'lxml-get-tag)) ;;;; eof

1 0

[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