June 2004 - s-xml-rpc-cvs@common-lisp.net

[s-xml-rpc-cvs] CVS update: s-xml-rpc/s-xml-rpc.asd s-xml-rpc/ChangeLog
by Rudi Schlatte 17 Jun '04

17 Jun '04

Update of /project/s-xml-rpc/cvsroot/s-xml-rpc In directory common-lisp.net:/tmp/cvs-serv10345 Modified Files: s-xml-rpc.asd ChangeLog Log Message: - Add extensions.lisp, for the various add-on specs floating around that cluttered xml-rpc.lisp - New file test-extensions.lisp, for testing them - Add support for symbols client-side (encode them as strings) - Extension system.getCapabilities: implemented, spec at http://groups.yahoo.com/group/xml-rpc/message/2897 - Add passing of symbols (encode them as strings)- Use standard error codes (spec at http://xmlrpc-epi.sourceforge.net/specs/rfc.fault_codes.php) wonder about semantics of "internal xml-rpc error" vs "application error", pick one arbitrarily Date: Thu Jun 17 12:43:11 2004 Author: rschlatte Index: s-xml-rpc/s-xml-rpc.asd diff -u s-xml-rpc/s-xml-rpc.asd:1.1.1.1 s-xml-rpc/s-xml-rpc.asd:1.2 --- s-xml-rpc/s-xml-rpc.asd:1.1.1.1 Wed Jun 9 02:02:39 2004 +++ s-xml-rpc/s-xml-rpc.asd Thu Jun 17 12:43:11 2004 @@ -1,6 +1,6 @@ ;;;; -*- Mode: LISP -*- ;;;; -;;;; $Id: s-xml-rpc.asd,v 1.1.1.1 2004/06/09 09:02:39 scaekenberghe Exp $ +;;;; $Id: s-xml-rpc.asd,v 1.2 2004/06/17 19:43:11 rschlatte Exp $ ;;;; ;;;; The S-XML-RPC ASDF system definition ;;;; @@ -27,7 +27,8 @@ :components ((:file "base64") (:file "package" :depends-on ("base64")) (:file "sysdeps" :depends-on ("package")) - (:file "xml-rpc" :depends-on ("package" "sysdeps" "base64"))))) + (:file "xml-rpc" :depends-on ("package" "sysdeps" "base64")) + (:file "extensions" :depends-on ("package" "xml-rpc"))))) :depends-on (:s-xml #+sbcl :sb-bsd-sockets)) ;;;; eof Index: s-xml-rpc/ChangeLog diff -u s-xml-rpc/ChangeLog:1.2 s-xml-rpc/ChangeLog:1.3 --- s-xml-rpc/ChangeLog:1.2 Sun Jun 13 09:12:04 2004 +++ s-xml-rpc/ChangeLog Thu Jun 17 12:43:11 2004 @@ -1,3 +1,17 @@ +2004-06-17 Rudi Schlatte <rudi(a)constantly.at> + + * src/package.lisp: Add system.getCapabilities. + + * src/extensions.lisp: Create, move server extensions from + xml-rpc.lisp here. + (do-one-multicall): Raise standard fault codes. + (|system.getCapabilities|): Implement. + + * src/xml-rpc.lisp: Remove server extensions. + (encode-xml-rpc-value): Encode symbols as strings + (execute-xml-rpc-call, handle-xml-rpc-call): Raise standard fault + codes. + 2004-06-13 Rudi Schlatte <rudi(a)constantly.at> * src/xml-rpc.lisp (xml-literal): new datatype for unescaped

1 0

[s-xml-rpc-cvs] CVS update: s-xml-rpc/src/extensions.lisp s-xml-rpc/src/xml-rpc.lisp s-xml-rpc/src/package.lisp
by Rudi Schlatte 17 Jun '04

17 Jun '04

Update of /project/s-xml-rpc/cvsroot/s-xml-rpc/src In directory common-lisp.net:/tmp/cvs-serv10345/src Modified Files: xml-rpc.lisp package.lisp Added Files: extensions.lisp Log Message: - Add extensions.lisp, for the various add-on specs floating around that cluttered xml-rpc.lisp - New file test-extensions.lisp, for testing them - Add support for symbols client-side (encode them as strings) - Extension system.getCapabilities: implemented, spec at http://groups.yahoo.com/group/xml-rpc/message/2897 - Add passing of symbols (encode them as strings)- Use standard error codes (spec at http://xmlrpc-epi.sourceforge.net/specs/rfc.fault_codes.php) wonder about semantics of "internal xml-rpc error" vs "application error", pick one arbitrarily Date: Thu Jun 17 12:43:11 2004 Author: rschlatte Index: s-xml-rpc/src/xml-rpc.lisp diff -u s-xml-rpc/src/xml-rpc.lisp:1.3 s-xml-rpc/src/xml-rpc.lisp:1.4 --- s-xml-rpc/src/xml-rpc.lisp:1.3 Sun Jun 13 09:12:03 2004 +++ s-xml-rpc/src/xml-rpc.lisp Thu Jun 17 12:43:11 2004 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: xml-rpc.lisp,v 1.3 2004/06/13 16:12:03 rschlatte Exp $ +;;;; $Id: xml-rpc.lisp,v 1.4 2004/06/17 19:43:11 rschlatte Exp $ ;;;; ;;;; This is a Common Lisp implementation of the XML-RPC protocol, ;;;; as documented on the website http://www.xmlrpc.com @@ -133,7 +133,7 @@ (defun print-xml-rpc-struct (xml-element stream depth) (declare (ignore depth)) - (format stream "#<XML-RPC-STRUCT~{ ~s~}>" (xml-rpc-struct-alist xml-element))) + (format stream "#<XML-RPC-STRUCT~{ ~S~}>" (xml-rpc-struct-alist xml-element))) (defun get-xml-rpc-struct-member (struct member) "Get the value of a specific member of an XML-RPC-STRUCT" @@ -188,9 +188,9 @@ (defun encode-xml-rpc-value (arg stream) (princ "<value>" stream) - (cond ((stringp arg) + (cond ((or (stringp arg) (symbolp arg)) (princ "<string>" stream) - (print-string-xml arg stream) + (print-string-xml (string arg) stream) (princ "</string>" stream)) ((integerp arg) (format stream "<int>~d</int>" arg)) ((floatp arg) (format stream "<double>~f</double>" arg)) @@ -455,70 +455,44 @@ (let ((sym (find-symbol method-name *xml-rpc-package*))) (if (fboundp sym) sym nil))) -;;; Introspection methods from http://xmlrpc.usefulinc.com/doc/reserved.html -;;; To be imported in *xml-rpc-package*. - -(defun |system.listMethods| () - "List the methods that are available on this server." - (let ((result nil)) - (do-symbols (sym *xml-rpc-package* (sort result #'string-lessp)) - (when (and (fboundp sym) (valid-xml-rpc-method-name-p (symbol-name sym))) - (push (symbol-name sym) result))))) - -(defun |system.methodSignature| (method-name) - "Dummy system.methodSignature implementation. There's no way - to get (and no concept of) required argument types in Lisp, so - this function always returns nil or errors." - (let ((method (find-xml-rpc-method method-name))) - (if method - ;; http://xmlrpc.usefulinc.com/doc/sysmethodsig.html says to - ;; return a non-array if the signature is not available - "n/a" - (error "Method ~A not found." method-name)))) - -(defun |system.methodHelp| (method-name) - "Returns the function documentation for the given method." - (let ((method (find-xml-rpc-method method-name))) - (if method - (or (documentation method 'function) "") - (error "Method ~A not found." method-name)))) - -(defun do-one-multicall (call-struct) - (let ((name (get-xml-rpc-struct-member call-struct :|methodName|)) - (params (get-xml-rpc-struct-member call-struct :|params|))) - (handler-bind - ((error #'(lambda (c) - (format-debug - (or *xml-rpc-debug-stream* t) - "A call in a system.multicall failed with ~a~%" c) - (return-from do-one-multicall - (xml-literal - (encode-xml-rpc-fault-value (format nil "~a" c))))))) - (format-debug (or *xml-rpc-debug-stream* t) - "system.multicall calling ~a with ~s~%" name params) - (let ((result (apply *xml-rpc-call-hook* name params))) - (list result))))) - -(defun |system.multicall| (calls) - "Implement system.multicall; see http://www.xmlrpc.com/discuss/msgReader$1208 - for the specification." - (mapcar #'do-one-multicall calls)) - (defun execute-xml-rpc-call (method-name &rest arguments) "Execute method METHOD-NAME on ARGUMENTS, or raise an error if no such method exists in *XML-RPC-PACKAGE*" (let ((method (find-xml-rpc-method method-name))) (if method (apply method arguments) - (error "Method ~A not found." method-name)))) + ;; http://xmlrpc-epi.sourceforge.net/specs/rfc.fault_codes.php + ;; -32601 ---> server error. requested method not found + (error 'xml-rpc-fault :code -32601 + :string (format nil "Method ~A not found." method-name))))) (defun handle-xml-rpc-call (in id) "Handle an actual call, reading XML from in and returning the XML-encoded result." - (handler-bind ((error #'(lambda (c) - (format-debug (or *xml-rpc-debug-stream* t) "~a call failed with ~a~%" id c) - (return-from handle-xml-rpc-call - (encode-xml-rpc-fault (format nil "~a" c)))))) + ;; Try to conform to + ;; http://xmlrpc-epi.sourceforge.net/specs/rfc.fault_codes.php + (handler-bind ((s-xml:xml-parser-error + #'(lambda (c) + (format-debug (or *xml-rpc-debug-stream* t) + "~a request parsing failed with ~a~%" + id c) + (return-from handle-xml-rpc-call + ;; -32700 ---> parse error. not well formed + (encode-xml-rpc-fault (format nil "~a" c) -32700)))) + (xml-rpc-fault + #'(lambda (c) + (format-debug (or *xml-rpc-debug-stream* t) + "~a call failed with ~a~%" id c) + (return-from handle-xml-rpc-call + (encode-xml-rpc-fault (xml-rpc-fault-string c) + (xml-rpc-fault-code c))))) + (error + #'(lambda (c) + (format-debug (or *xml-rpc-debug-stream* t) + "~a call failed with ~a~%" id c) + (return-from handle-xml-rpc-call + ;; -32603 ---> server error. internal xml-rpc error + (encode-xml-rpc-fault (format nil "~a" c) -32603))))) (let ((call (decode-xml-rpc (debug-stream in)))) (format-debug (or *xml-rpc-debug-stream* t) "~a received call ~s~%" id call) (let ((result (apply *xml-rpc-call-hook* @@ -530,7 +504,7 @@ (defun xml-rpc-implementation-version () "Identify ourselves" (concatenate 'string - "$Id: xml-rpc.lisp,v 1.3 2004/06/13 16:12:03 rschlatte Exp $" + "$Id: xml-rpc.lisp,v 1.4 2004/06/17 19:43:11 rschlatte Exp $" " " (lisp-implementation-type) " " Index: s-xml-rpc/src/package.lisp diff -u s-xml-rpc/src/package.lisp:1.3 s-xml-rpc/src/package.lisp:1.4 --- s-xml-rpc/src/package.lisp:1.3 Sun Jun 13 09:12:03 2004 +++ s-xml-rpc/src/package.lisp Thu Jun 17 12:43:11 2004 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: package.lisp,v 1.3 2004/06/13 16:12:03 rschlatte Exp $ +;;;; $Id: package.lisp,v 1.4 2004/06/17 19:43:11 rschlatte Exp $ ;;;; ;;;; S-XML-RPC package definition ;;;; @@ -36,13 +36,14 @@ #:*xml-rpc-package* #:*xml-rpc-call-hook* #:execute-xml-rpc-call #:stop-server #:|system.listMethods| #:|system.methodSignature| #:|system.methodHelp| - #:|system.multicall|) + #:|system.multicall| #:|system.getCapabilities|) (:documentation "An implementation of the standard XML-RPC protocol for both client and server")) (defpackage s-xml-rpc-exports (:use) (:import-from :s-xml-rpc #:|system.listMethods| #:|system.methodSignature| - #:|system.methodHelp| #:|system.multicall|) + #:|system.methodHelp| #:|system.multicall| + #:|system.getCapabilities|) (:documentation "This package contains the functions callable via xml-rpc.")) ;;;; eof

1 0

[s-xml-rpc-cvs] CVS update: s-xml-rpc/test/test-extensions.lisp s-xml-rpc/test/all-tests.lisp
by Rudi Schlatte 17 Jun '04

17 Jun '04

Update of /project/s-xml-rpc/cvsroot/s-xml-rpc/test In directory common-lisp.net:/tmp/cvs-serv10345/test Modified Files: all-tests.lisp Added Files: test-extensions.lisp Log Message: - Add extensions.lisp, for the various add-on specs floating around that cluttered xml-rpc.lisp - New file test-extensions.lisp, for testing them - Add support for symbols client-side (encode them as strings) - Extension system.getCapabilities: implemented, spec at http://groups.yahoo.com/group/xml-rpc/message/2897 - Add passing of symbols (encode them as strings)- Use standard error codes (spec at http://xmlrpc-epi.sourceforge.net/specs/rfc.fault_codes.php) wonder about semantics of "internal xml-rpc error" vs "application error", pick one arbitrarily Date: Thu Jun 17 12:43:11 2004 Author: rschlatte Index: s-xml-rpc/test/all-tests.lisp diff -u s-xml-rpc/test/all-tests.lisp:1.1.1.1 s-xml-rpc/test/all-tests.lisp:1.2 --- s-xml-rpc/test/all-tests.lisp:1.1.1.1 Wed Jun 9 02:02:40 2004 +++ s-xml-rpc/test/all-tests.lisp Thu Jun 17 12:43:11 2004 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: all-tests.lisp,v 1.1.1.1 2004/06/09 09:02:40 scaekenberghe Exp $ +;;;; $Id: all-tests.lisp,v 1.2 2004/06/17 19:43:11 rschlatte Exp $ ;;;; ;;;; Load and execute all unit and functional tests ;;;; @@ -12,5 +12,6 @@ (load (merge-pathnames "test-base64" *load-pathname*) :verbose t) (load (merge-pathnames "test-xml-rpc" *load-pathname*) :verbose t) +(load (merge-pathnames "test-extensions" *load-pathname*) :verbose t) ;;;; eof

1 0

[s-xml-rpc-cvs] CVS update: public_html/S-XML-RPC.html public_html/index.html
by Sven Van Caekenberghe 14 Jun '04

14 Jun '04

Update of /project/s-xml-rpc/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv26117 Modified Files: index.html Added Files: S-XML-RPC.html Log Message: updated docs with API reference, etc... Date: Mon Jun 14 13:25:18 2004 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 Sun Jun 13 10:02:14 2004 +++ public_html/index.html Mon Jun 14 13:25:18 2004 @@ -15,11 +15,6 @@ <p>S-XML-RPC is an implementation of <a href="http://www.xmlrpc.com">XML-RPC</a> in Common Lisp for both client and server.</p> - <p> - <em>This project is starting up</em> - and is currently available via <a href="http://common-lisp.net/cgi-bin/viewcvs.cgi/?cvsroot=s-xml-rpc">CVS</a>. - </p> - <p> XML-RPC is a de facto standard for making remote procedure calls between software running on disparate operating systems, running in different environments and implemented using different languages. XML-RPC is using HTTP as the transport and XML as the encoding. XML-RPC is designed to be as simple as possible, while allowing complex data structures to be transmitted, processed and returned. The protocol is described in detail on <a href="http://www.xmlrpc.com/">http://www.xmlrpc.com/</a>. Some key features (both positive and negative) of the XML-RPC protocol are: <ul> @@ -33,6 +28,20 @@ </ul> </p> +<h3>Download</h3> +<p> + You can download the LLGPL source code and documentation as <a href="s-xml-rpc.tgz">s-xml-rpc.tgz</a> + (signature: <a href="s-xml-rpc.tgz.asc">s-xml-rpc.tgz.asc</a>) + (build and/or install with ASDF). + There is also <a href="http://common-lisp.net/cgi-bin/viewcvs.cgi/?cvsroot=s-xml-rpc">CVS</a> access. +</p> + +<h3>API</h3> +<p> + The plain API exported by the package S-XML-RPC (automatically generated by LispDoc) + is available in <a href="S-XML-RPC.html">S-XML-RPC.html</a>. +</p> + <h2> Usage </h2> @@ -236,7 +245,29 @@ The code in the package "S-BASE64" is an implementation of Base64 encoding and decoding (part of RFC 1521). Encoding takes bytes (a binary stream or a byte array) and produces characters (a character stream or a string). Decoding goes the other way. </p> - <p>CVS version $Id: index.html,v 1.2 2004/06/13 17:02:14 rschlatte Exp $</p> +<h3>Release History</h3> + +<ul> + <li>today: project moved to common-lisp.net</li> + <li>release 8, May 9, 2004: added *xml-rpc-authorization* header option (contributed by Nik Gaffney)</li> + <li>release 7, March 10, 2004: reorganized code to facilitate porting (added package.lisp and sysdeps.lisp, removed run-xml-rpc-server), integrated contributions from Rudi Schlatte and Brian Mastenbrook; SBCL is now supported; fixed a bug where empty strings were turned into nil, added a test</li> + <li>release 6, Januari 21, 2004: ported to LispWorks, added *xml-rpc-package*, *xml-rpc-call-hook* and execute-xml-rpc-call</li> + <li>release 5, Januari 20, 2004: added ASDF support, included some contributed patches</li> + <li>release 4, June 10, 2003: tracking a minor, but incompatible change in the XML parser</li> + <li>release 3, May 25, 2003: the XML parser has been put in a separate package, we are using the more efficient SAX interface of the parser, improved documentation</li> + <li>release 2, Januari 6, 2003: we now pass the <a href="http://validator.xmlrpc.com">XML-RPC validator tests</a>, various important bug fixes, improved documentation</li> + <li>release 1, December 15, 2002: first public release of working code, not optimized, limited testing</li> +</ul> + +<h3>Mailing Lists</h3> + +<ul> + <li><a href="http://common-lisp.net/mailman/listinfo/s-xml-rpc-cvs">S-XML-RPC-CVS mailing list info</a></li> + <li><a href="http://common-lisp.net/mailman/listinfo/s-xml-rpc-devel">S-XML-RPC-DEVEL mailing list info</a></li> + <li><a href="http://common-lisp.net/mailman/listinfo/s-xml-rpc-announce">S-XML-RPC-ANNOUNCE mailing list info</a></li> +</ul> + + <p>CVS version $Id: index.html,v 1.3 2004/06/14 20:25:18 scaekenberghe Exp $</p> <div class="footer"> <p>Back to <a href="http://common-lisp.net/">Common-lisp.net</a>.</p>

1 0

[s-xml-rpc-cvs] CVS update: s-xml-rpc/Makefile
by Sven Van Caekenberghe 14 Jun '04

14 Jun '04

Update of /project/s-xml-rpc/cvsroot/s-xml-rpc In directory common-lisp.net:/tmp/cvs-serv25695 Modified Files: Makefile Log Message: added release target Date: Mon Jun 14 13:24:37 2004 Author: scaekenberghe Index: s-xml-rpc/Makefile diff -u s-xml-rpc/Makefile:1.1.1.1 s-xml-rpc/Makefile:1.2 --- s-xml-rpc/Makefile:1.1.1.1 Wed Jun 9 02:02:39 2004 +++ s-xml-rpc/Makefile Mon Jun 14 13:24:37 2004 @@ -16,3 +16,14 @@ clean: clean-openmcl clean-lw clean-emacs +# +# This can obviously only be done by a specific person in a very specific context ;-) +# + +release: + rm -rf /tmp/s-xml-rpc /tmp/public_html /tmp/s-xml-rpc.tgz /tmp/s-xml-rpc.tgz.asc + cd /tmp; cvs export -r HEAD s-xml-rpc; cvs export -r HEAD public_html + mv /tmp/public_html /tmp/s-xml-rpc/doc + cd /tmp; gnutar cvfz s-xml-rpc.tgz s-xml-rpc; gpg -a -b s-xml-rpc.tgz + scp /tmp/s-xml-rpc.tgz scaekenberghe@common-lisp.net:/project/s-xml-rpc/public_html + scp /tmp/s-xml-rpc.tgz.asc scaekenberghe@common-lisp.net:/project/s-xml-rpc/public_html

1 0

[s-xml-rpc-cvs] CVS update: s-xml-rpc/src/validator1-client.lisp s-xml-rpc/src/validator1-server.lisp s-xml-rpc/src/validator1.lisp
by Sven Van Caekenberghe 14 Jun '04

14 Jun '04

Update of /project/s-xml-rpc/cvsroot/s-xml-rpc/src In directory common-lisp.net:/tmp/cvs-serv10381/src Added Files: validator1-client.lisp validator1-server.lisp Removed Files: validator1.lisp Log Message: refactored validator1 into client and server part now using new s-xml-rpc-exports package Date: Mon Jun 14 13:11:55 2004 Author: scaekenberghe

1 0

[s-xml-rpc-cvs] CVS update: public_html/index.html
by Rudi Schlatte 13 Jun '04

13 Jun '04

Update of /project/s-xml-rpc/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv4833 Modified Files: index.html Log Message: Update documentation: by default, almost nothing is exported now. Show how to make common-lisp available, like before. Date: Sun Jun 13 10:02:14 2004 Author: rschlatte Index: public_html/index.html diff -u public_html/index.html:1.1.1.1 public_html/index.html:1.2 --- public_html/index.html:1.1.1.1 Wed Jun 9 02:02:08 2004 +++ public_html/index.html Sun Jun 13 10:02:14 2004 @@ -66,7 +66,7 @@ The function <tt>xml-rpc-aserve:xml-rpc-call-aserve</tt> does the same thing, but uses the (portable) aserve HTTP client API for the networking. </p> <p> - Unit tests throughout the source code (marked by <tt>#+unit-test</tt> and usually wrapped inside an <tt>assert</tt>) can serve as (executable) examples. A more complicated example is the server and client implementation of some tests in <tt>validator1.lisp</tt>. Remember that XML-RPC method (function) names are case-sensitive, as are the names of XML-RPC structure members. + The unit tests in the subdirectory <tt>test</tt> can serve as (executable) examples. A more complicated example is the server and client implementation of some tests in <tt>validator1.lisp</tt>. Remember that XML-RPC method (function) names are case-sensitive, as are the names of XML-RPC structure members. </p> <h3> @@ -74,26 +74,42 @@ </h3> <p> Only a single function call is needed to get the server up and running: - <pre>? (start-xml-rpc-server :port 8080)</pre> - From now on, your lisp image becomes an XML-RPC server, listening for HTTP requests on port 8080. - By default each function in your lisp image becomes available remotely, provided its signature is compatible. - The is not very secure, but it is easy and powerful. - You should customize this behavior for production usage. + <pre>? (start-xml-rpc-server :port 8080)</pre> From now on, your + lisp image becomes an XML-RPC server, listening for HTTP + requests on port 8080. By default the + functions <tt>system.listMethods</tt>, <tt>system.methodSignature</tt>, + <tt>system.methodHelp</tt> and <tt>system.multicall</tt> are + available. You can export additional functions from the server + by importing symbols in the package contained + in <tt>*xml-rpc-package*</tt> (by default, this is the package + S-XML-RPC-EXPORTS). <tt>(use-package :common-lisp + :s-xml-rpc-exports)</tt> makes all of Common Lisp available via + xml-rpc. + </p> + <p> In more detail, this is what happens: <ul> <li>The XML-RPC call arrives as XML encoded characters in the body of an HTTP POST request</li> <li>The characters received are parsed by the XML parser and decoded on the fly (using a SAX-like interface) following XML-RPC semantics into a a string method name and a possibly empty list of Lisp objects that are the arguments</li> <li>The value of <tt>*xml-rpc-call-hook*</tt> is applied on the string method name and optional argument list</li> - <li>The default value of <tt>*xml-rpc-call-hook*</tt> is <tt>execute-xml-rpc-call</tt> which interns the method name in the package <tt>*xml-rpc-package*</tt> (whose default value is the XML-RPC package itself) and applies the function bound to that name to the argument list (if any)</li> + <li>The default value of <tt>*xml-rpc-call-hook*</tt> + is <tt>execute-xml-rpc-call</tt> which looks for a function + with the given name in the package <tt>*xml-rpc-package*</tt> + (whose default value is the XML-RPC-EXPORTS package) and + applies the function bound to that name to the argument list + (if any)</li> <li>The result is encoded as an XML-RPC result and returned to the client</li> - <li>If anything goes wrong in any of these steps, a Lisp condition is thrown which is catched and then encoded as an XML-RPC fault and returned to the client</li> + <li>If anything goes wrong in any of these steps, a Lisp + condition is thrown which is caught and then encoded as an XML-RPC fault and returned to the client</li> </ul> - Customization points are <tt>*xml-rpc-package*</tt> or <tt>*xml-rpc-call-hook*</tt>. + Customization points are <tt>*xml-rpc-package*</tt> and <tt>*xml-rpc-call-hook*</tt>. Setting the variable <tt>xml-rpc::*xml-rpc-debug*</tt> to <tt>t</tt> makes the server more verbose. Note that XML-RPC method names are case sensitive: for example, clients have specify "LISP-IMPLEMENTATION-TYPE" for the corresponding Lisp function; a server has to define a function named <tt>|login|</tt> if his clients look for an implementation of "login". </p> <p> -AppleScript can make client-side XML-RPC calls. So provided you have your lisp XML-RPC server running, you can have lisp to the math like this: + AppleScript can make client-side XML-RPC calls. So provided you + have your lisp XML-RPC server running and have imported + in + XML-RPC-EXPORTS, you can have lisp do the math like this: <pre>tell application "http://localhost:8080/RPC2" set call_result to call xmlrpc {method name:"+", parameters:{10, 20, 30}} end tell @@ -220,7 +236,7 @@ The code in the package "S-BASE64" is an implementation of Base64 encoding and decoding (part of RFC 1521). Encoding takes bytes (a binary stream or a byte array) and produces characters (a character stream or a string). Decoding goes the other way. </p> - <p>CVS version $Id: index.html,v 1.1.1.1 2004/06/09 09:02:08 scaekenberghe Exp $</p> + <p>CVS version $Id: index.html,v 1.2 2004/06/13 17:02:14 rschlatte Exp $</p> <div class="footer"> <p>Back to <a href="http://common-lisp.net/">Common-lisp.net</a>.</p>

1 0

[s-xml-rpc-cvs] CVS update: s-xml-rpc/src/xml-rpc.lisp s-xml-rpc/src/package.lisp
by Rudi Schlatte 13 Jun '04

13 Jun '04

Update of /project/s-xml-rpc/cvsroot/s-xml-rpc/src In directory common-lisp.net:/tmp/cvs-serv8306/src Modified Files: xml-rpc.lisp package.lisp Log Message: Implement system.multicall Date: Sun Jun 13 09:12:04 2004 Author: rschlatte Index: s-xml-rpc/src/xml-rpc.lisp diff -u s-xml-rpc/src/xml-rpc.lisp:1.2 s-xml-rpc/src/xml-rpc.lisp:1.3 --- s-xml-rpc/src/xml-rpc.lisp:1.2 Sun Jun 13 07:14:47 2004 +++ s-xml-rpc/src/xml-rpc.lisp Sun Jun 13 09:12:03 2004 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: xml-rpc.lisp,v 1.2 2004/06/13 14:14:47 rschlatte Exp $ +;;;; $Id: xml-rpc.lisp,v 1.3 2004/06/13 16:12:03 rschlatte Exp $ ;;;; ;;;; This is a Common Lisp implementation of the XML-RPC protocol, ;;;; as documented on the website http://www.xmlrpc.com @@ -97,6 +97,29 @@ "Create a new XML-RPC-TIME struct with the universal time specified, defaulting to now" (make-xml-rpc-time :universal-time universal-time)) +;;; a wrapper for literal strings, where escaping #\< and #\& is not +;;; desired + +(defstruct (xml-literal (:print-function print-xml-literal)) + "A wrapper around a Common Lisp string that will be sent over + the wire unescaped" + content) + +(setf (documentation 'xml-literal-p 'function) + "Return T when the argument is an unescaped xml string" + (documentation 'xml-literal-content 'function) + "Return the content of a literal xml string") + +(defun print-xml-literal (xml-literal stream depth) + (declare (ignore depth)) + (format stream + "#<XML-LITERAL \"~a\" >" + (xml-literal-content xml-literal))) + +(defun xml-literal (content) + "Create a new XML-LITERAL struct with the specified content." + (make-xml-literal :content content)) + ;;; an extra datatype for xml-rpc structures (associative maps) (defstruct (xml-rpc-struct (:print-function print-xml-rpc-struct)) @@ -186,6 +209,8 @@ (princ "<dateTime.iso8601>" stream) (universal-time->iso8601 (xml-rpc-time-universal-time arg) stream) (princ "</dateTime.iso8601>" stream)) + ((xml-literal-p arg) + (princ (xml-literal-content arg) stream)) ((or (listp arg) (vectorp arg)) (encode-xml-rpc-array arg stream)) ((xml-rpc-struct-p arg) (encode-xml-rpc-struct arg stream)) ;; add generic method call @@ -218,14 +243,21 @@ (encode-xml-rpc-args (list value) stream) (princ "</methodResponse>" stream))) -(defun encode-xml-rpc-fault (fault-string &optional (fault-code 0)) +(defun encode-xml-rpc-fault-value (fault-string &optional (fault-code 0)) + ;; for system.multicall (with-output-to-string (stream) - (princ "<methodResponse><fault><value><struct>" stream) + (princ "<struct>" stream) (format stream "<member><name>faultCode</name><value><int>~d</int></value></member>" fault-code) (princ "<member><name>faultString</name><value><string>" stream) (print-string-xml fault-string stream) (princ "</string></value></member>" stream) - (princ "</struct></value></fault></methodResponse>" stream))) + (princ "</struct>" stream))) + +(defun encode-xml-rpc-fault (fault-string &optional (fault-code 0)) + (with-output-to-string (stream) + (princ "<methodResponse><fault><value>" stream) + (princ (encode-xml-rpc-fault-value fault-string fault-code) stream) + (princ "</value></fault></methodResponse>" stream))) ;;; decoding support @@ -290,10 +322,10 @@ (lisp-implementation-version)) "String specifying the default XML-RPC agent to include in server responses") -(defparameter *xml-rpc-debug* nil +(defvar *xml-rpc-debug* nil "When T the XML-RPC client and server part will be more verbose about their protocol") -(defparameter *xml-rpc-debug-stream* nil +(defvar *xml-rpc-debug-stream* nil "When not nil it specifies where debugging output should be written to") (defparameter *xml-rpc-proxy-host* nil @@ -407,6 +439,9 @@ ;;; server API +(defvar *xml-rpc-call-hook* 'execute-xml-rpc-call + "A function to execute the xml-rpc call and return the result, accepting a method-name string and a optional argument list") + (defparameter +xml-rpc-method-characters+ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_.:/") @@ -438,7 +473,7 @@ (if method ;; http://xmlrpc.usefulinc.com/doc/sysmethodsig.html says to ;; return a non-array if the signature is not available - nil + "n/a" (error "Method ~A not found." method-name)))) (defun |system.methodHelp| (method-name) @@ -448,6 +483,27 @@ (or (documentation method 'function) "") (error "Method ~A not found." method-name)))) +(defun do-one-multicall (call-struct) + (let ((name (get-xml-rpc-struct-member call-struct :|methodName|)) + (params (get-xml-rpc-struct-member call-struct :|params|))) + (handler-bind + ((error #'(lambda (c) + (format-debug + (or *xml-rpc-debug-stream* t) + "A call in a system.multicall failed with ~a~%" c) + (return-from do-one-multicall + (xml-literal + (encode-xml-rpc-fault-value (format nil "~a" c))))))) + (format-debug (or *xml-rpc-debug-stream* t) + "system.multicall calling ~a with ~s~%" name params) + (let ((result (apply *xml-rpc-call-hook* name params))) + (list result))))) + +(defun |system.multicall| (calls) + "Implement system.multicall; see http://www.xmlrpc.com/discuss/msgReader$1208 + for the specification." + (mapcar #'do-one-multicall calls)) + (defun execute-xml-rpc-call (method-name &rest arguments) "Execute method METHOD-NAME on ARGUMENTS, or raise an error if no such method exists in *XML-RPC-PACKAGE*" @@ -456,9 +512,6 @@ (apply method arguments) (error "Method ~A not found." method-name)))) -(defvar *xml-rpc-call-hook* 'execute-xml-rpc-call - "A function to execute the xml-rpc call and return the result, accepting a method-name string and a optional argument list") - (defun handle-xml-rpc-call (in id) "Handle an actual call, reading XML from in and returning the XML-encoded result." @@ -477,7 +530,7 @@ (defun xml-rpc-implementation-version () "Identify ourselves" (concatenate 'string - "$Id: xml-rpc.lisp,v 1.2 2004/06/13 14:14:47 rschlatte Exp $" + "$Id: xml-rpc.lisp,v 1.3 2004/06/13 16:12:03 rschlatte Exp $" " " (lisp-implementation-type) " " Index: s-xml-rpc/src/package.lisp diff -u s-xml-rpc/src/package.lisp:1.2 s-xml-rpc/src/package.lisp:1.3 --- s-xml-rpc/src/package.lisp:1.2 Sun Jun 13 07:14:47 2004 +++ s-xml-rpc/src/package.lisp Sun Jun 13 09:12:03 2004 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: package.lisp,v 1.2 2004/06/13 14:14:47 rschlatte Exp $ +;;;; $Id: package.lisp,v 1.3 2004/06/13 16:12:03 rschlatte Exp $ ;;;; ;;;; S-XML-RPC package definition ;;;; @@ -35,13 +35,14 @@ #:*xml-rpc-debug* #:*xml-rpc-debug-stream* #:*xml-rpc-package* #:*xml-rpc-call-hook* #:execute-xml-rpc-call #:stop-server - #:|system.listMethods| #:|system.methodSignature| #:|system.methodHelp|) + #:|system.listMethods| #:|system.methodSignature| #:|system.methodHelp| + #:|system.multicall|) (:documentation "An implementation of the standard XML-RPC protocol for both client and server")) (defpackage s-xml-rpc-exports (:use) (:import-from :s-xml-rpc #:|system.listMethods| #:|system.methodSignature| - #:|system.methodHelp|) + #:|system.methodHelp| #:|system.multicall|) (:documentation "This package contains the functions callable via xml-rpc.")) ;;;; eof

1 0

[s-xml-rpc-cvs] CVS update: s-xml-rpc/ChangeLog
by Rudi Schlatte 13 Jun '04

13 Jun '04

Update of /project/s-xml-rpc/cvsroot/s-xml-rpc In directory common-lisp.net:/tmp/cvs-serv8306 Modified Files: ChangeLog Log Message: Implement system.multicall Date: Sun Jun 13 09:12:04 2004 Author: rschlatte Index: s-xml-rpc/ChangeLog diff -u s-xml-rpc/ChangeLog:1.1 s-xml-rpc/ChangeLog:1.2 --- s-xml-rpc/ChangeLog:1.1 Sun Jun 13 07:14:47 2004 +++ s-xml-rpc/ChangeLog Sun Jun 13 09:12:04 2004 @@ -1,5 +1,12 @@ 2004-06-13 Rudi Schlatte <rudi(a)constantly.at> + * src/xml-rpc.lisp (xml-literal): new datatype for unescaped + strings (used by system.multicall to pass back encoded fault structs) + (encode-xml-rpc-value): handle it. + (encode-xml-rpc-fault-value, encode-xml-rpc-fault): separate + encoding of fault and methodResponse for system.multicall + (do-one-multicall, |system.multicall|): Implement system.multicall. + * src/package.lisp (s-xml-rpc-exports): New package -- don't export the whole common-lisp package by default ;) @@ -9,7 +16,8 @@ (|system.methodSignature|, |system.methodHelp|): Added introspection methods, to be imported in *xml-rpc-package*. - * src/package.lisp (s-xml-rpc): ... export them. + * src/package.lisp (s-xml-rpc): ... export them, and also + |system.multicall| * src/xml-rpc.lisp: Some indentation frobs.

1 0

[s-xml-rpc-cvs] CVS update: s-xml-rpc/ChangeLog
by Rudi Schlatte 13 Jun '04

13 Jun '04

Update of /project/s-xml-rpc/cvsroot/s-xml-rpc In directory common-lisp.net:/tmp/cvs-serv21201 Added Files: ChangeLog Log Message: * src/package.lisp (s-xml-rpc-exports): New package -- don't export the whole common-lisp package by default ;) * src/xml-rpc.lisp (*xml-rpc-package*): ... use it. * src/xml-rpc.lisp (|system.listMethods|) (|system.methodSignature|, |system.methodHelp|): Added introspection methods, to be imported in *xml-rpc-package*. * src/package.lisp (s-xml-rpc): ... export them. * src/xml-rpc.lisp: Some indentation frobs. Date: Sun Jun 13 07:14:47 2004 Author: rschlatte

1 0