[hunchentoot-devel] header(s)-out

[Robert J. Macomber]

[oops, originally sent this to tbnl at ... hope that's not a different
list or person.  Hasn't bounced in any case.]

There seems to be some small bugs involving header-out.  The accessor
is documented to take both keywords and strings, but neither works
reliably because:
  The reader will use string-equal if given a string and eq if given a
  symbol, because of the assoc shadowing in the hunchentoot package.
  This will find what it's looking for if it's given a string or if
  it's given a keyword _and_ the header entry was originally created
  with a keyword.

  The writer will do the same, so it's possible to have two different
  entries for any given header in the headers-out list, one for a
  string entry and one for a symbol.  (The code _looks_ like it does
  the right thing, but if "name" is a symbol, it calls the
  symbol-specialized version of assoc which ignores its test
  argument).

Finally, if a header-out entry is created with a symbol, response
generation fails because it uses write-string (or write-line with
mod-lisp) to output the header name, and they don't take string
designators.

Here's a patch which normalizes things so the keys of this alist are
always strings and the lookup is always done with strings.  It uses
string-capitalize to convert keywords when storing in order to make
them have conventional HTTP header capitalization.

--- hunchentoot-0.4.8.orig/reply.lisp	2006-11-05 15:55:06.000000000 -0700
+++ hunchentoot-0.4.8/reply.lisp	2006-11-08 15:40:15.000000000 -0700
@@ -115,7 +115,7 @@
 (defun header-out (name &optional (reply *reply*))
   "Returns the current value of the outgoing http header named NAME.
 NAME should be a keyword or a string."
-  (cdr (assoc name (headers-out reply))))
+  (cdr (assoc (string name) (headers-out reply))))
 
 (defun cookie-out (name &optional (reply *reply*))
   "Returns the current value of the outgoing cookie named
@@ -129,7 +129,8 @@
 created."
   (with-rebinding (name reply)
     (with-unique-names (place)
-      `(let ((,place (assoc ,name (headers-out ,reply) :test #'string-equal)))
+      `(let* ((,name (if (stringp ,name) ,name (string-capitalize ,name)))
+              (,place (assoc ,name (headers-out ,reply))))
          (cond
            (,place
             (setf (cdr ,place) ,new-value))

-- 
Robert Macomber
tbnl at rojoma.com