set cookie header parsing

Rainer Joswig <[email protected]> Mon, 17 Jun 2013 19:10:36 +0200
Newsgroups gmane.lisp.cl-http
Message-ID <[email protected]>
Hi,

Madhu sent a problem report.

Parsing the set cookie header has several problems:

* we might want to strip white-space around keywords
* a header like 'httponly' (without value) should be parsed correctly

Here is an attempt to solve both above:

http:server;headers.lisp

(defun parse-set-cookie-header (string &optional (start 0) (end (length string)))
  (labels ((parse-cookie-value (string start end)
             (with-string-trim-bounds (+cookie-value-trimmed-characters+ string start end)
               (subseq string start end)))
           (parse-port-list (string start end)
             (loop with idx-e
                   for idx-s = (position-if* #'digit-char-p string :start start :end end)
                   then (position-if* #'digit-char-p string :start idx-e :end end)
                   while idx-s
                   do (setq idx-e (or (position-if-not* #'digit-char-p string :start idx-s  :end end) end))
                   collect (parse-integer string :start idx-s :end idx-e)))
           (parse-parameters (string start end)
             (when (< start end)
               (loop for s = start then (1+ e2)
                     while (< s end)
                     for s1 = (position-if-not* #'white-space-char-p string :start s :end end)
                     while s1
                     for e1 = (let ((p1 (char-position #\= string s1 end))
                                    (p2 (char-position #\; string s1 end)))
                                (if (or (and p1 (not p2))
                                        (and p1 p2 (< p1 p2)))
                                    p1
                                  nil))             
                     for e2 = (or (char-position #\; string (or e1 s1) end) end)
                     for s2 = (if e1 (1+ e1) s1)
                     for keyword = (let ((start s1) (end (or e1 e2)))
                                     (with-string-trim-bounds (+cookie-value-trimmed-characters+ string start end)
                                       (%intern-header-keyword-value string start end)))
                     for value = (with-string-trim-bounds (+cookie-value-trimmed-characters+ string s2 e2)
                                   (ecase keyword
                                     ((:domain :path :comment :commenturl) (subseq string s2 e2))
                                     (:portlist (parse-port-list string s2 e2))
                                     ;; errors parsing dates mean expire the cookie similar to what happens in HTTP,
                                     ;; but there is no guidance in RFC 2109
                                     ;; 8/10/2000 -- JCMa.
                                     (:expires (parse-expires-header string s2 e2))
                                     ((:max-age :version) (parse-integer string :start s2 :end e2))
                                     ((:secure :discard) t)
                                     (:httponly t))) ;microsoft extension to protect against XXS --JCMa 11/14/2010
                     collect keyword
                     collect value))))
    (declare (inline parse-cookie-value parse-parameters))
    (with-string-trim-bounds (*white-space-chars* string start end)
      (let* ((e1 (char-position #\= string start end))
	     (e2 (or (char-position #\; string e1 end) end)))
	`(,(with-string-trim-bounds (+cookie-value-trimmed-characters+ string start e1)
             (%intern-header-keyword-value string start e1))
	  ,(parse-cookie-value string (1+ e1) e2)
	  ,.(parse-parameters string (1+ e2) end))))))

Please report if you see any problems.

Regards,

Rainer




_______________________________________________
WWW-CL mailing list
[email protected]
https://lists.csail.mit.edu/mailman/listinfo/www-cl