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

Be more liberal when parsing cookies

U trunk/thirdparty/drakma/CHANGELOG.txt U trunk/thirdparty/drakma/cookies.lisp U trunk/thirdparty/drakma/util.lisp

Modified: trunk/thirdparty/drakma/CHANGELOG.txt =================================================================== --- trunk/thirdparty/drakma/CHANGELOG.txt 2009-12-01 21:58:01 UTC (rev 4478) +++ trunk/thirdparty/drakma/CHANGELOG.txt 2009-12-01 22:06:56 UTC (rev 4479) @@ -1,3 +1,4 @@ +Be more liberal when parsing cookies (thanks to Andrei Stebakov) Added HTTP method PATCH (thanks to Xiangjun Wu) Don't send GET parameters again when redirecting (reported by Eugene Ossintsev) Solidify feature expressions (thanks to Joshua Taylor)

Modified: trunk/thirdparty/drakma/cookies.lisp =================================================================== --- trunk/thirdparty/drakma/cookies.lisp 2009-12-01 21:58:01 UTC (rev 4478) +++ trunk/thirdparty/drakma/cookies.lisp 2009-12-01 22:06:56 UTC (rev 4479) @@ -249,20 +249,14 @@ of three-element lists where each one contains the name of the cookie, the value of the cookie, and an attribute/value list for the optional cookie parameters." - (with-sequence-from-string (stream string) - (loop with *current-error-message* = (format nil "While parsing cookie header ~S:" string) - for first = t then nil - for next = (and (skip-whitespace stream) - (or first (assert-char stream #,)) - (skip-whitespace stream) - (skip-more-commas stream)) - for name/value = (and next (read-name-value-pair stream - :cookie-syntax t)) - for parameters = (and name/value (read-name-value-pairs stream - :value-required-p nil - :cookie-syntax t)) - while name/value - collect (list (car name/value) (cdr name/value) parameters)))) + (let ((*current-error-message* (format nil "While parsing cookie header ~S:" string)) + result) + (dolist (substring (split-set-cookie-string string)) + (with-sequence-from-string (stream substring) + (let* ((name/value (read-name-value-pair stream :cookie-syntax t)) + (parameters (read-name-value-pairs stream :value-required-p nil :cookie-syntax t))) + (push (list (car name/value) (cdr name/value) parameters) result)))) + (nreverse result)))

(defun get-cookies (headers uri) "Returns a list of COOKIE objects corresponding to the

Modified: trunk/thirdparty/drakma/util.lisp =================================================================== --- trunk/thirdparty/drakma/util.lisp 2009-12-01 21:58:01 UTC (rev 4478) +++ trunk/thirdparty/drakma/util.lisp 2009-12-01 22:06:56 UTC (rev 4479) @@ -279,4 +279,49 @@ WITH-INPUT-FROM-STRING, but creates a sequence of octets that works with CHUNGA::PEEK-CHAR* and friends." `(flex:with-input-from-sequence (,stream (map 'list #'char-code ,string)) - ,@body)) \ No newline at end of file + ,@body)) + +(defun split-set-cookie-string (string) + "Splits the string STRING which is assumed to be the value of a +`Set-Cookie' into parts corresponding to individual cookies and +returns a list of these parts (substrings). + +The string /should/ be split at commas, but heuristical approach is +used instead which doesn't split at commas which are followed by what +cannot be recognized as the start of the next cookie. This is +necessary because servers send headers containing unquoted commas +which are not meant as separators." + ;; this would of course be a lot easier with CL-PPCRE's SPLIT + (let ((cookie-start 0) + (string-length (length string)) + search-start + result) + (tagbody + ;; at this point we know that COOKIE-START is the start of a new + ;; cookie (at the start of the string or behind a comma) + next-cookie + (setq search-start cookie-start) + ;; we reach this point if the last comma didn't separate two + ;; cookies or if there was no previous comma + skip-comma + (unless (< search-start string-length) + (return-from split-set-cookie-string (nreverse result))) + ;; look is there's a comma + (let* ((comma-pos (position #, string :start search-start)) + ;; and if so, look for a #= behind the comma + (equals-pos (and comma-pos (position #= string :start comma-pos))) + ;; check that (except for whitespace) there's only a token + ;; (the name of the next cookie) between #, and #= + (new-cookie-start-p (and equals-pos + (every 'token-char-p + (trim-whitespace string + :start (1+ comma-pos) + :end equals-pos))))) + (when (and comma-pos (not new-cookie-start-p)) + (setq search-start (1+ comma-pos)) + (go skip-comma)) + (let ((end-pos (or comma-pos string-length))) + (push (trim-whitespace (subseq string cookie-start end-pos)) result) + (setq cookie-start (1+ end-pos)) + (go next-cookie)))))) +