From db9b177bcc4aabebebf604de7a0efc5b32981c5b Mon Sep 17 00:00:00 2001 From: Alex Harsanyi Date: Wed, 25 Apr 2012 12:28:29 +0200 Subject: [PATCH] Sync with soap-client repository. Support SOAP simpleType. (Bug#10331) * soap-client.el (soap-resolve-references-for-sequence-type) (soap-resolve-references-for-array-type): hack to prevent self references, see Bug#9. (soap-parse-envelope): report the contents of the 'detail' node when receiving a fault reply. (soap-parse-envelope): report the contents of the entire 'detail' node. * soap-inspect.el (soap-sample-value-for-simple-type) (soap-inspect-simple-type): new function * soap-client.el (soap-simple-type): new struct (soap-default-xsd-types, soap-default-soapenc-types) (soap-decode-basic-type, soap-encode-basic-type): support unsignedInt and double basic types (soap-resolve-references-for-simple-type) (soap-parse-simple-type, soap-encode-simple-type): new function (soap-parse-schema): parse xsd:simpleType declarations * soap-client.el (soap-default-xsd-types) (soap-default-soapenc-types): add integer, byte and anyURI types (soap-parse-complex-type-complex-content): use `soap-wk2l' to find the local name of "soapenc:Array" (soap-decode-basic-type, soap-encode-basic-type): support encoding decoding integer, byte and anyURI xsd types. --- lisp/ChangeLog | 30 +++++++++++ lisp/net/soap-client.el | 110 +++++++++++++++++++++++++++++++++------ lisp/net/soap-inspect.el | 25 +++++++++ 3 files changed, 149 insertions(+), 16 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 76b855e6bc9..533c1775ea9 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,33 @@ +2012-04-25 Alex Harsanyi + + Sync with soap-client repository. Support SOAP simpleType. (Bug#10331) + + * soap-client.el (soap-resolve-references-for-sequence-type) + (soap-resolve-references-for-array-type): hack to prevent self + references, see Bug#9. + (soap-parse-envelope): report the contents of the 'detail' node + when receiving a fault reply. + (soap-parse-envelope): report the contents of the entire 'detail' + node. + + * soap-inspect.el (soap-sample-value-for-simple-type) + (soap-inspect-simple-type): new function + + * soap-client.el (soap-simple-type): new struct + (soap-default-xsd-types, soap-default-soapenc-types) + (soap-decode-basic-type, soap-encode-basic-type): support + unsignedInt and double basic types + (soap-resolve-references-for-simple-type) + (soap-parse-simple-type, soap-encode-simple-type): new function + (soap-parse-schema): parse xsd:simpleType declarations + + * soap-client.el (soap-default-xsd-types) + (soap-default-soapenc-types): add integer, byte and anyURI types + (soap-parse-complex-type-complex-content): use `soap-wk2l' to find + the local name of "soapenc:Array" + (soap-decode-basic-type, soap-encode-basic-type): support encoding + decoding integer, byte and anyURI xsd types. + 2012-04-25 Chong Yidong * cus-edit.el (custom-buffer-create-internal): Update header text. diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el index e17b283c55f..39369111935 100644 --- a/lisp/net/soap-client.el +++ b/lisp/net/soap-client.el @@ -369,6 +369,9 @@ binding) but the same name." kind ; a symbol of: string, dateTime, long, int ) +(defstruct (soap-simple-type (:include soap-basic-type)) + enumeration) + (defstruct soap-sequence-element name type nillable? multiple?) @@ -415,8 +418,9 @@ binding) but the same name." (defun soap-default-xsd-types () "Return a namespace containing some of the XMLSchema types." (let ((ns (make-soap-namespace :name "http://www.w3.org/2001/XMLSchema"))) - (dolist (type '("string" "dateTime" "boolean" "long" "int" "float" - "base64Binary" "anyType" "Array" "byte[]")) + (dolist (type '("string" "dateTime" "boolean" + "long" "int" "integer" "unsignedInt" "byte" "float" "double" + "base64Binary" "anyType" "anyURI" "Array" "byte[]")) (soap-namespace-put (make-soap-basic-type :name type :kind (intern type)) ns)) @@ -425,9 +429,10 @@ binding) but the same name." (defun soap-default-soapenc-types () "Return a namespace containing some of the SOAPEnc types." (let ((ns (make-soap-namespace - :name "http://schemas.xmlsoap.org/soap/encoding/"))) - (dolist (type '("string" "dateTime" "boolean" "long" "int" "float" - "base64Binary" "anyType" "Array" "byte[]")) + :name "http://schemas.xmlsoap.org/soap/encoding/"))) + (dolist (type '("string" "dateTime" "boolean" + "long" "int" "integer" "unsignedInt" "byte" "float" "double" + "base64Binary" "anyType" "anyURI" "Array" "byte[]")) (soap-namespace-put (make-soap-basic-type :name type :kind (intern type)) ns)) @@ -555,6 +560,15 @@ updated." (when resolver (funcall resolver element wsdl)))) +(defun soap-resolve-references-for-simple-type (type wsdl) + "Resolve the base type for the simple TYPE using the WSDL + document." + (let ((kind (soap-basic-type-kind type))) + (unless (symbolp kind) + (let ((basic-type (soap-wsdl-get kind wsdl 'soap-basic-type-p))) + (setf (soap-basic-type-kind type) + (soap-basic-type-kind basic-type)))))) + (defun soap-resolve-references-for-sequence-type (type wsdl) "Resolve references for a sequence TYPE using WSDL document. See also `soap-resolve-references-for-element' and @@ -562,12 +576,18 @@ See also `soap-resolve-references-for-element' and (let ((parent (soap-sequence-type-parent type))) (when (or (consp parent) (stringp parent)) (setf (soap-sequence-type-parent type) - (soap-wsdl-get parent wsdl 'soap-type-p)))) + (soap-wsdl-get + parent wsdl + ;; Prevent self references, see Bug#9 + (lambda (e) (and (not (eq e type)) (soap-type-p e))))))) (dolist (element (soap-sequence-type-elements type)) (let ((element-type (soap-sequence-element-type element))) (cond ((or (consp element-type) (stringp element-type)) (setf (soap-sequence-element-type element) - (soap-wsdl-get element-type wsdl 'soap-type-p))) + (soap-wsdl-get + element-type wsdl + ;; Prevent self references, see Bug#9 + (lambda (e) (and (not (eq e type)) (soap-type-p e)))))) ((soap-element-p element-type) ;; since the element already has a child element, it ;; could be an inline structure. we must resolve @@ -582,7 +602,10 @@ See also `soap-resolve-references-for-element' and (let ((element-type (soap-array-type-element-type type))) (when (or (consp element-type) (stringp element-type)) (setf (soap-array-type-element-type type) - (soap-wsdl-get element-type wsdl 'soap-type-p))))) + (soap-wsdl-get + element-type wsdl + ;; Prevent self references, see Bug#9 + (lambda (e) (and (not (eq e type)) (soap-type-p e)))))))) (defun soap-resolve-references-for-message (message wsdl) "Resolve references for a MESSAGE type using the WSDL document. @@ -679,6 +702,8 @@ See also `soap-resolve-references-for-element' and ;; Install resolvers for our types (progn + (put (aref (make-soap-simple-type) 0) 'soap-resolve-references + 'soap-resolve-references-for-simple-type) (put (aref (make-soap-sequence-type) 0) 'soap-resolve-references 'soap-resolve-references-for-sequence-type) (put (aref (make-soap-array-type) 0) 'soap-resolve-references @@ -854,6 +879,9 @@ Return a SOAP-NAMESPACE containing the elements." (let ((ns (make-soap-namespace :name (soap-get-target-namespace node)))) ;; NOTE: we only extract the complexTypes from the schema, we wouldn't ;; know how to handle basic types beyond the built in ones anyway. + (dolist (node (soap-xml-get-children1 node 'xsd:simpleType)) + (soap-namespace-put (soap-parse-simple-type node) ns)) + (dolist (node (soap-xml-get-children1 node 'xsd:complexType)) (soap-namespace-put (soap-parse-complex-type node) ns)) @@ -862,6 +890,26 @@ Return a SOAP-NAMESPACE containing the elements." ns))) +(defun soap-parse-simple-type (node) + "Parse NODE and construct a simple type from it." + (assert (eq (soap-l2wk (xml-node-name node)) 'xsd:simpleType) + nil + "soap-parse-complex-type: expecting xsd:simpleType node, got %s" + (soap-l2wk (xml-node-name node))) + (let ((name (xml-get-attribute-or-nil node 'name)) + type + enumeration + (restriction (car-safe + (soap-xml-get-children1 node 'xsd:restriction)))) + (unless restriction + (error "simpleType %s has no base type" name)) + + (setq type (xml-get-attribute-or-nil restriction 'base)) + (dolist (e (soap-xml-get-children1 restriction 'xsd:enumeration)) + (push (xml-get-attribute e 'value) enumeration)) + + (make-soap-simple-type :name name :kind type :enumeration enumeration))) + (defun soap-parse-schema-element (node) "Parse NODE and construct a schema element from it." (assert (eq (soap-l2wk (xml-node-name node)) 'xsd:element) @@ -975,7 +1023,7 @@ contents." extension 'xsd:sequence))))) (restriction (let ((base (xml-get-attribute-or-nil restriction 'base))) - (assert (equal base "soapenc:Array") + (assert (equal base (soap-wk2l "soapenc:Array")) nil "restrictions supported only for soapenc:Array types, this is a %s" base)) @@ -1245,9 +1293,9 @@ type-info stored in TYPE." (if (null contents) nil (ecase type-kind - (string (car contents)) + ((string anyURI) (car contents)) (dateTime (car contents)) ; TODO: convert to a date time - ((long int float) (string-to-number (car contents))) + ((long int integer unsignedInt byte float double) (string-to-number (car contents))) (boolean (string= (downcase (car contents)) "true")) (base64Binary (base64-decode-string (car contents))) (anyType (soap-decode-any-type node)) @@ -1293,6 +1341,10 @@ This is because it is easier to work with list results in LISP." (progn (put (aref (make-soap-basic-type) 0) 'soap-decoder 'soap-decode-basic-type) + ;; just use the basic type decoder for the simple type -- we accept any + ;; value and don't do any validation on it. + (put (aref (make-soap-simple-type) 0) + 'soap-decoder 'soap-decode-basic-type) (put (aref (make-soap-sequence-type) 0) 'soap-decoder 'soap-decode-sequence-type) (put (aref (make-soap-array-type) 0) @@ -1322,10 +1374,11 @@ WSDL is used to decode the NODE" fault 'faultcode)))) (car-safe (xml-node-children n)))) (fault-string (let ((n (car (xml-get-children - fault 'faultstring)))) - (car-safe (xml-node-children n))))) + fault 'faultstring)))) + (car-safe (xml-node-children n)))) + (detail (xml-get-children fault 'detail))) (while t - (signal 'soap-error (list fault-code fault-string)))))) + (signal 'soap-error (list fault-code fault-string detail)))))) ;; First (non string) element of the body is the root node of he ;; response @@ -1457,7 +1510,7 @@ instead." (progn (insert ">") (case basic-type - (string + ((string anyURI) (unless (stringp value) (error "Soap-encode-basic-type(%s, %s, %s): not a string value" xml-tag value xsi-type)) @@ -1484,10 +1537,19 @@ instead." xml-tag value xsi-type)) (insert (if value "true" "false"))) - ((long int) + ((long int integer byte unsignedInt) (unless (integerp value) (error "Soap-encode-basic-type(%s, %s, %s): not an integer value" xml-tag value xsi-type)) + (when (and (eq basic-type 'unsignedInt) (< value 0)) + (error "Soap-encode-basic-type(%s, %s, %s): not a positive integer" + xml-tag value xsi-type)) + (insert (number-to-string value))) + + ((float double) + (unless (numberp value) + (error "Soap-encode-basic-type(%s, %s, %s): not a number" + xml-tag value xsi-type)) (insert (number-to-string value))) (base64Binary @@ -1504,6 +1566,20 @@ instead." (insert " xsi:nil=\"true\">")) (insert "\n"))) +(defun soap-encode-simple-type (xml-tag value type) + "Encode inside XML-TAG the LISP VALUE according to TYPE." + + ;; Validate VALUE agains the simple type's enumeration, than just encode it + ;; using `soap-encode-basic-type' + + (let ((enumeration (soap-simple-type-enumeration type))) + (unless (and (> (length enumeration) 1) + (member value enumeration)) + (error "soap-encode-simple-type(%s, %s, %s): bad value, should be one of %s" + xml-tag value (soap-element-fq-name type) enumeration))) + + (soap-encode-basic-type xml-tag value type)) + (defun soap-encode-sequence-type (xml-tag value type) "Encode inside XML-TAG the LISP VALUE according to TYPE. Do not call this function directly, use `soap-encode-value' @@ -1564,6 +1640,8 @@ instead." (progn (put (aref (make-soap-basic-type) 0) 'soap-encoder 'soap-encode-basic-type) + (put (aref (make-soap-simple-type) 0) + 'soap-encoder 'soap-encode-simple-type) (put (aref (make-soap-sequence-type) 0) 'soap-encoder 'soap-encode-sequence-type) (put (aref (make-soap-array-type) 0) diff --git a/lisp/net/soap-inspect.el b/lisp/net/soap-inspect.el index 823f815d58f..23937e21770 100644 --- a/lisp/net/soap-inspect.el +++ b/lisp/net/soap-inspect.el @@ -66,6 +66,15 @@ use `soap-sample-value' instead." ;; TODO: we need better sample values for more types. (t (format "%s" (soap-basic-type-kind type))))) +(defun soap-sample-value-for-simple-type (type) + "Provive a sample value for TYPE which is a simple type. +This is a specific function which should not be called directly, +use `soap-sample-value' instead." + (let ((enumeration (soap-simple-type-enumeration type))) + (if (> (length enumeration) 1) + (elt enumeration (random (length enumeration))) + (soap-sample-value-for-basic-type type)))) + (defun soap-sample-value-for-seqence-type (type) "Provide a sample value for TYPE which is a sequence type. Values for sequence types are ALISTS of (slot-name . VALUE) for @@ -115,6 +124,9 @@ use `soap-sample-value' instead." (put (aref (make-soap-basic-type) 0) 'soap-sample-value 'soap-sample-value-for-basic-type) + (put (aref (make-soap-simple-type) 0) 'soap-sample-value + 'soap-sample-value-for-simple-type) + (put (aref (make-soap-sequence-type) 0) 'soap-sample-value 'soap-sample-value-for-seqence-type) @@ -204,6 +216,16 @@ entire WSDL can be inspected." (insert "\nSample value\n") (pp (soap-sample-value basic-type) (current-buffer))) +(defun soap-inspect-simple-type (simple-type) + "Insert information about SIMPLE-TYPE into the current buffer" + (insert "Simple type: " (soap-element-fq-name simple-type) "\n") + (insert "Base: " (symbol-name (soap-basic-type-kind simple-type)) "\n") + (let ((enumeration (soap-simple-type-enumeration simple-type))) + (when (> (length enumeration) 1) + (insert "Valid values: ") + (dolist (e enumeration) + (insert "\"" e "\" "))))) + (defun soap-inspect-sequence-type (sequence) "Insert information about SEQUENCE into the current buffer." (insert "Sequence type: " (soap-element-fq-name sequence) "\n") @@ -331,6 +353,9 @@ entire WSDL can be inspected." (put (aref (make-soap-basic-type) 0) 'soap-inspect 'soap-inspect-basic-type) + (put (aref (make-soap-simple-type) 0) 'soap-inspect + 'soap-inspect-simple-type) + (put (aref (make-soap-sequence-type) 0) 'soap-inspect 'soap-inspect-sequence-type) -- 2.39.2