make multi-assocs work for http headers

extra/http/client/client.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs http kernel math math.parser namespaces sequences
 io io.sockets io.streams.string io.files strings splitting
-continuations ;
+continuations assocs.lib ;
 IN: http.client
 
 : parse-host ( url -- host port )
@@ -44,7 +44,7 @@ DEFER: http-get-stream
     #! Should this support Location: headers that are
     #! relative URLs?
     pick 100 /i 3 = [
-        dispose "location" swap header-single nip http-get-stream
+        dispose "location" swap peek-at nip http-get-stream
     ] when ;
 
 : http-get-stream ( url -- code headers stream )

extra/http/http.factor

@@ -1,18 +1,19 @@
 ! Copyright (C) 2003, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: hashtables io kernel math namespaces math.parser assocs
-sequences strings splitting ascii io.utf8 assocs.lib ;
+sequences strings splitting ascii io.utf8 assocs.lib
+namespaces unicode.case ;
 IN: http
 
 : header-line ( line -- )
-    ": " split1 dup [ swap >lower set ] [ 2drop ] if ;
+    ": " split1 dup [ swap >lower insert ] [ 2drop ] if ;
 
 : (read-header) ( -- )
     readln dup
     empty? [ drop ] [ header-line (read-header) ] if ;
 
 : read-header ( -- hash )
-    [ (read-header) ] VH{ } make-assoc ;
+    [ (read-header) ] H{ } make-assoc ;
 
 : url-quotable? ( ch -- ? )
     #! In a URL, can this character be used without

extra/http/server/responders/responders.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays assocs hashtables html html.elements splitting
 http io kernel math math.parser namespaces parser sequences
-strings io.server ;
+strings io.server vectors vector-hash strings.lib ;
 
 IN: http.server.responders
 
@@ -10,8 +10,11 @@ IN: http.server.responders
 SYMBOL: vhosts
 SYMBOL: responders
 
+: >header ( value key -- vector-hash )
+    VH{ } clone [ set-at ] keep ;
+
 : print-header ( alist -- )
-    [ swap write ": " write print ] assoc-each nl ;
+    [ swap >Upper-dashes write ": " write print ] vector-hash-each nl ;
 
 : response ( msg -- ) "HTTP/1.0 " write print ;
 
@@ -20,7 +23,7 @@ SYMBOL: responders
 
 : error-head ( error -- )
     dup log-error response
-    H{ { "Content-Type" "text/html" } } print-header nl ;
+    VH{ { "Content-Type" "text/html" } } print-header nl ;
 
 : httpd-error ( error -- )
     #! This must be run from handle-request
@@ -36,7 +39,7 @@ SYMBOL: responders
 
 : serving-content ( mime -- )
     "200 Document follows" response
-    "Content-Type" associate print-header ;
+    "Content-Type" >header print-header ;
 
 : serving-html "text/html" serving-content ;
 
@@ -46,7 +49,7 @@ SYMBOL: responders
 : serving-text "text/plain" serving-content ;
 
 : redirect ( to response -- )
-    response "Location" associate print-header ;
+    response "Location" >header print-header ;
 
 : permanent-redirect ( to -- )
     "301 Moved Permanently" redirect ;
@@ -84,14 +87,14 @@ SYMBOL: max-post-request
 : log-headers ( hash -- )
     [
         drop {
-            "User-Agent"
-            "Referer"
-            "X-Forwarded-For"
-            "Host"
+            "user-agent"
+            "referer"
+            "x-forwarded-for"
+            "host"
         } member?
     ] assoc-subset [
         ": " swap 3append log-message
-    ] assoc-each ;
+    ] vector-hash-each ;
 
 : prepare-url ( url -- url )
     #! This is executed in the with-request namespace.
@@ -122,7 +125,8 @@ SYMBOL: max-post-request
 
 : query-param ( key -- value ) "query" get at ;
 
-: header-param ( key -- value ) "header" get at ;
+: header-param ( key -- value )
+    "header" get peek-at ;
 
 : host ( -- string )
     #! The host the current responder was called from.
@@ -130,7 +134,7 @@ SYMBOL: max-post-request
 
 : add-responder ( responder -- )
     #! Add a responder object to the list.
-    "responder" over at  responders get set-at ;
+    "responder" over at responders get set-at ;
 
 : make-responder ( quot -- )
     #! quot has stack effect ( url -- )