Revision: 4190 Author: edi URL: http://bknr.net/trac/changeset/4190
Start with conditions
A trunk/thirdparty/drakma/conditions.lisp U trunk/thirdparty/drakma/cookies.lisp U trunk/thirdparty/drakma/drakma.asd U trunk/thirdparty/drakma/packages.lisp
Added: trunk/thirdparty/drakma/conditions.lisp =================================================================== --- trunk/thirdparty/drakma/conditions.lisp (rev 0) +++ trunk/thirdparty/drakma/conditions.lisp 2009-02-09 09:03:41 UTC (rev 4190) @@ -0,0 +1,88 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: ODD-STREAMS; Base: 10 -*- +;;; $Header: /usr/local/cvsrep/odd-streams/conditions.lisp,v 1.5 2007/12/31 01:08:45 edi Exp $ + +;;; Copyright (c) 2008-2009, Dr. Edmund Weitz. All rights reserved. + +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: + +;;; * Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. + +;;; * Redistributions in binary form must reproduce the above +;;; copyright notice, this list of conditions and the following +;;; disclaimer in the documentation and/or other materials +;;; provided with the distribution. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE +;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +(in-package :drakma) + +(define-condition drakma-condition (condition) + () + (:documentation "Superclass for all conditions related to Drakma.")) + +(define-condition drakma-error (drakma-condition error) + () + (:documentation "Superclass for all errors related to Drakma.")) + +(define-condition drakma-simple-error (drakma-error simple-condition) + () + (:documentation "Like DRAKMA-ERROR but with formatting capabilities.")) + +(defun drakma-error (format-control &rest format-arguments) + "Signals an error of type DRAKMA-SIMPLE-ERROR with the provided +format control and arguments." + (error 'drakma-simple-error + :format-control format-control + :format-arguments format-arguments)) + +(define-condition parameter-error (drakma-simple-error) + () + (:documentation "Signalled if a function was called with incosistent or illegal parameters.")) + +(defun parameter-error (format-control &rest format-arguments) + "Signals an error of type PARAMETER-ERROR with the provided +format control and arguments." + (error 'parameter-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.")) + (:documentation "Signalled if someone tries to create a COOKIE object that's not valid.")) + +(defun cookie-error (cookie format-control &rest format-arguments) + "Signals an error of type COOKIE-ERROR with the provided cookie +(can be NIL), format control and arguments." + (error 'cookie-error + :cookie cookie + :format-control format-control + :format-arguments format-arguments)) + +(define-condition cookie-date-parse-error (cookie-error) + () + (:documentation "Signalled if Drakma tries to parse the date of an +incoming cookie header and can't interpret it.")) + +(defun cookie-date-parse-error (format-control &rest format-arguments) + "Signals an error of type COOKIE-DATE-PARSE-ERROR with the provided +format control and arguments." + (error 'cookie-date-parse-error + :format-control format-control + :format-arguments format-arguments))
Modified: trunk/thirdparty/drakma/cookies.lisp =================================================================== --- trunk/thirdparty/drakma/cookies.lisp 2009-02-09 07:52:58 UTC (rev 4189) +++ trunk/thirdparty/drakma/cookies.lisp 2009-02-09 09:03:41 UTC (rev 4190) @@ -31,7 +31,7 @@
(defclass cookie () ((name :initarg :name - :initform (error "A cookie must have a name.") + :initform (cookie-error nil "A cookie must have a name.") :accessor cookie-name :documentation "The name of the cookie.") (value :initarg :value @@ -39,7 +39,7 @@ :accessor cookie-value :documentation "The cookie's value.") (domain :initarg :domain - :initform (error "A cookie must have a domain.") + :initform (cookie-error nil "A cookie must have a domain.") :accessor cookie-domain :documentation "The domain the cookie is valid for.") (path :initarg :path @@ -122,22 +122,22 @@ (eq (uri-scheme uri) :https))))
(defun check-cookie (cookie) - "Checks if the slots of the COOKIE object COOKIE have valid -values and raises a corresponding error otherwise." + "Checks if the slots of the COOKIE object COOKIE have valid values +and raises a corresponding error of type COOKIE-ERROR otherwise." (with-slots (name value domain path expires) cookie (unless (and (stringp name) (plusp (length name))) - (error "Cookie name ~S must be a non-empty string." name)) + (cookie-error cookie "Cookie name ~S must be a non-empty string." name)) (unless (stringp value) - (error "Cookie value ~S must be a non-empty string." value)) + (cookie-error cookie "Cookie value ~S must be a non-empty string." value)) (unless (valid-cookie-domain-p domain) - (error "Invalid cookie domain ~S." domain)) + (cookie-error cookie "Invalid cookie domain ~S." domain)) (unless (and (stringp path) (plusp (length path))) - (error "Cookie path ~S must be a non-empty string." path)) + (cookie-error cookie "Cookie path ~S must be a non-empty string." path)) (unless (or (null expires) (and (integerp expires) (plusp expires))) - (error "Cookie expiry ~S should have been NIL or a universal time." expires)))) + (cookie-error cookie "Cookie expiry ~S should have been NIL or a universal time." expires))))
(defmethod initialize-instance :after ((cookie cookie) &rest initargs) "Check cookie validity after creation." @@ -208,8 +208,9 @@ ;; could try to employ CL-PPCRE, but that'd add a new dependency ;; without making this code much cleaner (handler-case - (let* ((last-space-pos (or (position #\Space string :test #'char= :from-end t) - (error "Can't parse cookie date ~S, no space found." string))) + (let* ((last-space-pos + (or (position #\Space string :test #'char= :from-end t) + (cookie-date-parse-error "Can't parse cookie date ~S, no space found." string))) (time-zone-string (subseq string (1+ last-space-pos))) (time-zone (interpret-as-time-zone time-zone-string)) second minute hour day month year) @@ -217,25 +218,27 @@ (when (and day month) (cond ((every #'digit-char-p part) (when year - (error "Can't parse cookie date ~S, confused by ~S part." string part)) + (cookie-date-parse-error "Can't parse cookie date ~S, confused by ~S part." + string part)) (setq year (parse-integer part))) ((= (count #: part :test #'char=) 2) (let ((h-m-s (mapcar #'safe-parse-integer (split-string part ":")))) (setq hour (first h-m-s) minute (second h-m-s) second (third h-m-s)))) - (t (error "Can't parse cookie date ~S, confused by ~S part." string part)))) + (t (cookie-date-parse-error "Can't parse cookie date ~S, confused by ~S part." + string part)))) (cond ((null day) (unless (setq day (safe-parse-integer part)) (setq month (interpret-as-month part)))) ((null month) (setq month (interpret-as-month part))))) (unless (and second minute hour day month year) - (error "Can't parse cookie date ~S, component missing." string)) + (cookie-date-parse-error "Can't parse cookie date ~S, component missing." string)) (when (< year 100) (setq year (+ year 2000))) (encode-universal-time second minute hour day month year time-zone)) - (error (condition) + (cookie-date-parse-error (condition) (cond (*ignore-unparseable-cookie-dates-p* (warn "~A" condition) nil)
Modified: trunk/thirdparty/drakma/drakma.asd =================================================================== --- trunk/thirdparty/drakma/drakma.asd 2009-02-09 07:52:58 UTC (rev 4189) +++ trunk/thirdparty/drakma/drakma.asd 2009-02-09 09:03:41 UTC (rev 4190) @@ -49,6 +49,7 @@ :version #.*drakma-version-string* :components ((:file "packages") (:file "specials") + (:file "conditions") (:file "util") (:file "read") (:file "cookies")
Modified: trunk/thirdparty/drakma/packages.lisp =================================================================== --- trunk/thirdparty/drakma/packages.lisp 2009-02-09 07:52:58 UTC (rev 4189) +++ trunk/thirdparty/drakma/packages.lisp 2009-02-09 09:03:41 UTC (rev 4190) @@ -40,6 +40,8 @@ :*ignore-unparseable-cookie-dates-p* :*text-content-types* :cookie + :cookie-error + :cookie-error-cookie :cookie-domain :cookie-expires :cookie-http-only-p @@ -51,9 +53,12 @@ :cookie-value :cookie= :delete-old-cookies + :drakma-condition + :drakma-error :get-content-type :header-value :http-request + :parameter-error :parameter-present-p :parameter-value :read-tokens-and-parameters