[bknr-cvs] edi changed trunk/thirdparty/drakma/

BKNR Commits bknr at bknr.net
Mon Feb 9 09:15:30 UTC 2009


Revision: 4191
Author: edi
URL: http://bknr.net/trac/changeset/4191

More conditions

U   trunk/thirdparty/drakma/conditions.lisp
U   trunk/thirdparty/drakma/read.lisp
U   trunk/thirdparty/drakma/request.lisp

Modified: trunk/thirdparty/drakma/conditions.lisp
===================================================================
--- trunk/thirdparty/drakma/conditions.lisp	2009-02-09 09:03:41 UTC (rev 4190)
+++ trunk/thirdparty/drakma/conditions.lisp	2009-02-09 09:15:30 UTC (rev 4191)
@@ -59,12 +59,24 @@
          :format-control format-control
          :format-arguments format-arguments))
 
+(define-condition syntax-error (drakma-simple-error)
+  ()
+  (:documentation "Signalled if Drakma encounters wrong or unknown
+syntax when reading the reply from the server."))
+
+(defun syntax-error (format-control &rest format-arguments)
+  "Signals an error of type SYNTAX-ERROR with the provided
+format control and arguments."
+  (error 'syntax-error
+         :format-control format-control
+         :format-arguments format-arguments))
+
 (define-condition cookie-error (drakma-simple-error)
   ((cookie :initarg :cookie
            :initform nil
            :reader cookie-error-cookie
            :documentation "The COOKIE object that provoked this error.
-Can be NIL in case such an object couldn't be initialited."))
+Can be NIL in case such an object couldn't be initialized."))
   (:documentation "Signalled if someone tries to create a COOKIE object that's not valid."))
 
 (defun cookie-error (cookie format-control &rest format-arguments)

Modified: trunk/thirdparty/drakma/read.lisp
===================================================================
--- trunk/thirdparty/drakma/read.lisp	2009-02-09 09:03:41 UTC (rev 4190)
+++ trunk/thirdparty/drakma/read.lisp	2009-02-09 09:15:30 UTC (rev 4191)
@@ -35,19 +35,20 @@
 three values - the protocol \(HTTP version) as a keyword, the
 status code as an integer, and optionally the reason phrase."
   (let* ((*current-error-message* "While reading status line:")
-         (line (read-line* stream log-stream))
+         (line (or (read-line* stream log-stream)
+                   (error "Could not read status line.")))
          (first-space-pos (or (position #\Space line :test #'char=)
-                              (error "No space in status line ~S." line)))
+                              (syntax-error "No space in status line ~S." line)))
          (second-space-pos (position #\Space line
                                      :test #'char=
                                      :start (1+ first-space-pos))))
     (list (cond ((string-equal line "HTTP/1.0" :end1 first-space-pos) :http/1.0)
                 ((string-equal line "HTTP/1.1" :end1 first-space-pos) :http/1.1)
-                (t (error "Unknown protocol in ~S." line)))
+                (t (syntax-error "Unknown protocol in ~S." line)))
           (or (ignore-errors (parse-integer line
                                             :start (1+ first-space-pos)
                                             :end second-space-pos))
-              (error "Status code in ~S is not an integer." line))
+              (syntax-error "Status code in ~S is not an integer." line))
           (and second-space-pos (subseq line (1+ second-space-pos))))))
 
 (defun get-content-type (headers)

Modified: trunk/thirdparty/drakma/request.lisp
===================================================================
--- trunk/thirdparty/drakma/request.lisp	2009-02-09 09:03:41 UTC (rev 4190)
+++ trunk/thirdparty/drakma/request.lisp	2009-02-09 09:15:30 UTC (rev 4191)
@@ -84,7 +84,7 @@
                (and (symbolp content)
                     (fboundp content)))
            (funcall content stream))
-          (t (error "Don't know how to send content ~S to server." content)))))
+          (t (parameter-error "Don't know how to send content ~S to server." content)))))
 
 (defun make-form-data-function (parameters boundary)
   "Creates and returns a closure which can be used as an argument for
@@ -124,8 +124,9 @@
                    (crlf) (crlf)
                    ;; use SEND-CONTENT to send file as binary data
                    (send-content file-source stream)))
-                (t (error "Don't know what to do with name/value pair (~S . ~S) in multipart/form-data body."
-                          name value)))
+                (t (parameter-error
+                    "Don't know what to do with name/value pair (~S . ~S) in multipart/form-data body."
+                    name value)))
           (crlf)))
       (format stream "--~A--" boundary)
       (crlf))))
@@ -147,7 +148,7 @@
                   (content-length
                    (when chunkedp
                      ;; see RFC 2616, section 4.4
-                     (error "Got Content-Length header although input chunking is on."))
+                     (syntax-error "Got Content-Length header although input chunking is on."))
                    (setf (flexi-stream-element-type stream) 'octet)
                    (let ((result (make-array content-length :element-type 'octet)))
                      #+:clisp
@@ -388,19 +389,19 @@
 that time, a COMMUNICATION-DEADLINE-EXPIRED condition is signalled.
 DEADLINE is available on CCL 1.2 and later."
   (unless (member protocol '(:http/1.0 :http/1.1) :test #'eq)
-    (error "Don't know how to handle protocol ~S." protocol))
+    (parameter-error "Don't know how to handle protocol ~S." protocol))
   (setq uri (cond ((uri-p uri) (copy-uri uri))
                   (t (parse-uri uri))))
   (unless (member method +known-methods+ :test #'eq)
-    (error "Don't know how to handle method ~S." method))
+    (parameter-error "Don't know how to handle method ~S." method))
   (unless (member (uri-scheme uri) '(:http :https) :test #'eq)
-    (error "Don't know how to handle scheme ~S." (uri-scheme uri)))
+    (parameter-error "Don't know how to handle scheme ~S." (uri-scheme uri)))
   (when (and close keep-alive)
-    (error "CLOSE and KEEP-ALIVE must not be both true."))
+    (parameter-error "CLOSE and KEEP-ALIVE must not be both true."))
   (when (and (eq content :continuation) content-length)
-    (error "CONTENT-LENGTH must be NIL if CONTENT is :CONTINUATION."))
+    (parameter-error "CONTENT-LENGTH must be NIL if CONTENT is :CONTINUATION."))
   (when (and form-data (not (eq method :post)))
-    (error "FORM-DATA makes only sense with POST requests."))
+    (parameter-error "FORM-DATA makes only sense with POST requests."))
   ;; convert PROXY argument to canonical form
   (when proxy
     (when (atom proxy)
@@ -410,8 +411,8 @@
         (file-parameters-p (find-if-not #'stringp parameters :key #'cdr))
         parameters-used-p)
     (when (and file-parameters-p (not (eq method :post)))
-      (error "Don't know how to handle parameters in ~S, as this is not a POST request."
-             parameters))
+      (parameter-error "Don't know how to handle parameters in ~S, as this is not a POST request."
+                       parameters))
     (when (eq method :post)
       ;; create content body for POST unless it was provided
       (unless content





More information about the Bknr-cvs mailing list