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