[cl-soap-cvs] CVS update: cl-soap/src/http-client.lisp cl-soap/src/soap.lisp cl-soap/src/wsdl.lisp cl-soap/src/xsd.lisp
Sven Van Caekenberghe
scaekenberghe at common-lisp.net
Wed Oct 5 13:24:40 UTC 2005
Update of /project/cl-soap/cvsroot/cl-soap/src
In directory common-lisp.net:/tmp/cvs-serv1749/src
Modified Files:
http-client.lisp soap.lisp wsdl.lisp xsd.lisp
Log Message:
added some code to handle non 200 http responses
Date: Wed Oct 5 15:24:38 2005
Author: scaekenberghe
Index: cl-soap/src/http-client.lisp
diff -u cl-soap/src/http-client.lisp:1.6 cl-soap/src/http-client.lisp:1.7
--- cl-soap/src/http-client.lisp:1.6 Mon Sep 26 13:08:42 2005
+++ cl-soap/src/http-client.lisp Wed Oct 5 15:24:38 2005
@@ -1,6 +1,6 @@
;;;; -*- mode: lisp -*-
;;;;
-;;;; $Id: http-client.lisp,v 1.6 2005/09/26 11:08:42 scaekenberghe Exp $
+;;;; $Id: http-client.lisp,v 1.7 2005/10/05 13:24:38 scaekenberghe Exp $
;;;;
;;;; A basic HTTP client, somewhat API compatible with portableaserve's do-http-request
;;;; Copied from another project (basic authorization support removed)
@@ -228,7 +228,7 @@
headers
proxy
state)
- "Execute an HTTP request"
+ "Execute an HTTP request, returns (values body code headers uri kept-alive-p)"
(declare (ignore proxy))
(assert (member method '(:get :put :post :delete :head)))
(setf uri (puri:parse-uri uri))
Index: cl-soap/src/soap.lisp
diff -u cl-soap/src/soap.lisp:1.9 cl-soap/src/soap.lisp:1.10
--- cl-soap/src/soap.lisp:1.9 Mon Oct 3 11:40:35 2005
+++ cl-soap/src/soap.lisp Wed Oct 5 15:24:38 2005
@@ -1,6 +1,6 @@
;;;; -*- mode: lisp -*-
;;;;
-;;;; $Id: soap.lisp,v 1.9 2005/10/03 09:40:35 scaekenberghe Exp $
+;;;; $Id: soap.lisp,v 1.10 2005/10/05 13:24:38 scaekenberghe Exp $
;;;;
;;;; The basic SOAP protocol
;;;;
@@ -110,28 +110,30 @@
(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
- :headers `(("SOAPAction" . ,(or soap-action "")))
- :content-type "text/xml"
- :content call-xml))
- (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|)
- (let ((headers (lxml-find-tag 'soapenv:|Header| (rest result-soap-envelope)))
- (body (lxml-find-tag 'soapenv:|Body| (rest result-soap-envelope))))
- ;; simply return header key/value pairs as an alist
- (setf headers (mapcar #'(lambda (x) (list (lxml-get-tag x) (lxml-get-contents x))) (rest headers)))
- ;; only the first child of the body is returned, unless it is a fault
- (if body
- (let ((fault (lxml-find-tag 'soapenv:|Fault| (rest body))))
- (if fault
- (error (lxml->standard-soap-fault fault))
- (values (second body) headers)))
- (error "No body found in SOAP Envelope")))
- (error "No SOAP Envelope found"))))
+ (multiple-value-bind (result code)
+ (do-http-request (get-url server-end-point)
+ :method :POST
+ :headers `(("SOAPAction" . ,(or soap-action "")))
+ :content-type "text/xml"
+ :content call-xml)
+ (declare (ignore code))
+ (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|)
+ (let ((headers (lxml-find-tag 'soapenv:|Header| (rest result-soap-envelope)))
+ (body (lxml-find-tag 'soapenv:|Body| (rest result-soap-envelope))))
+ ;; simply return header key/value pairs as an alist
+ (setf headers (mapcar #'(lambda (x) (list (lxml-get-tag x) (lxml-get-contents x))) (rest headers)))
+ ;; only the first child of the body is returned, unless it is a fault
+ (if body
+ (let ((fault (lxml-find-tag 'soapenv:|Fault| (rest body))))
+ (if fault
+ (error (lxml->standard-soap-fault fault))
+ (values (second body) headers)))
+ (error "No body found in SOAP Envelope")))
+ (error "No SOAP Envelope found")))))
;;;; eof
Index: cl-soap/src/wsdl.lisp
diff -u cl-soap/src/wsdl.lisp:1.21 cl-soap/src/wsdl.lisp:1.22
--- cl-soap/src/wsdl.lisp:1.21 Mon Oct 3 11:40:35 2005
+++ cl-soap/src/wsdl.lisp Wed Oct 5 15:24:38 2005
@@ -1,6 +1,6 @@
;;;; -*- mode: lisp -*-
;;;;
-;;;; $Id: wsdl.lisp,v 1.21 2005/10/03 09:40:35 scaekenberghe Exp $
+;;;; $Id: wsdl.lisp,v 1.22 2005/10/05 13:24:38 scaekenberghe Exp $
;;;;
;;;; The basic WSDL protocol: we parse the generic and soap specific parts
;;;;
@@ -297,9 +297,12 @@
(parse-wsdl in)))
(defun parse-wsdl-url (url)
- (let ((buffer (do-http-request url)))
- (with-input-from-string (in buffer)
- (parse-wsdl in))))
+ (multiple-value-bind (buffer code)
+ (do-http-request url)
+ (if (eql code 200)
+ (with-input-from-string (in buffer)
+ (parse-wsdl in))
+ (error "Could not retrieve URL ~s, got a ~s code" url code))))
;; A simple caching mechanism for WSDL's by URL
Index: cl-soap/src/xsd.lisp
diff -u cl-soap/src/xsd.lisp:1.24 cl-soap/src/xsd.lisp:1.25
--- cl-soap/src/xsd.lisp:1.24 Mon Oct 3 14:24:10 2005
+++ cl-soap/src/xsd.lisp Wed Oct 5 15:24:38 2005
@@ -1,6 +1,6 @@
;;;; -*- mode: lisp -*-
;;;;
-;;;; $Id: xsd.lisp,v 1.24 2005/10/03 12:24:10 scaekenberghe Exp $
+;;;; $Id: xsd.lisp,v 1.25 2005/10/05 13:24:38 scaekenberghe Exp $
;;;;
;;;; A partial implementation of the XML Schema Definition standard
;;;;
@@ -149,9 +149,12 @@
(parse-xsd in)))
(defun parse-xsd-url (url)
- (let ((buffer (do-http-request url)))
- (with-input-from-string (in buffer)
- (parse-xsd in))))
+ (multiple-value-bind (buffer code)
+ (do-http-request url)
+ (if (eql code 200)
+ (with-input-from-string (in buffer)
+ (parse-xsd in))
+ (error "Could not retrieve URL ~s, got a ~s code" url code))))
;;; Interpreting the XSD model
More information about the Cl-soap-cvs
mailing list