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