GET-BROKEN-COOKIE-VALUES

Andrew Philpot <[email protected]> Tue, 12 Nov 2002 14:32:06 -0800
Newsgroups gmane.lisp.open-source.franz
Message-ID <[email protected]>
I think there is a problem with parsing "broken" cookies using
NET.ASERVE::GET-COOKIE-VALUES.

By broken I mean that HEADER-SLOT-VALUE sometimes returns a cookie
string such as

"p1; p2=v2; p3=v3"

I don't know whether this is kosher or not, but it does happen
sometimes to me (IE6).  In this situation,
NET.ASERVE::PARSE-HEADER-VALUE does the right thing on such a string,
but the MAPCAR loop of GCV takes CAR of an atom, and kaboom.

May I suggest the following patch, which assumes that such a broken
cookie has as intended value the empty string:

Feel free to IF* doctor it up before release -- I can't bring myself
to do that ;-).

Andrew

;;; -*- Mode:Lisp; Syntax:Common-lisp; Package:NET.ASERVE; Base:10 -*-

(in-package :net.aserve)

(defun get-cookie-values (req &key (external-format 
				    *default-aserve-external-format*))
  ;; return the set of cookie name value pairs from the current
  ;; request as conses  (name . value) 
  ;;
  (let ((cookie-string (header-slot-value req :cookie)))
    (if* (and cookie-string (not (equal "" cookie-string)))
       then ; form is  cookie: name=val; name2=val2; name2=val3
	    ; which is not exactly the format we want to see it in
	    ; to parse it.  we want   
	    ;     cookie: foo; name=val; name=val
	    ; we we'll dummy up something that we want to see. 
	    ; maybe later we'll have a parser for this form too
	    ;
	    (let ((res (parse-header-value
			(concatenate 'string "foo; " cookie-string))))
	      ; res should be: ((:param "foo" ("baz" . "bof")))
	      (if* (and (consp res)
			(consp (car res))
			(eq :param (caar res)))
		 then ; the correct format, must decode pieces
		      (mapcar #'(lambda (ent)
				  (unless (consp ent)
				    (setq ent (cons ent "")))
				  (cons 
				   (uridecode-string
				    (car ent) :external-format external-format)
				   (uridecode-string
				    (cdr ent)
				    :external-format external-format)))
			      (cddr (car res))))))))