file-responder fixes

contrib/httpd/file-responder.factor

@@ -1,42 +1,38 @@
 ! Copyright (C) 2004, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: file-responder
-USING: calendar embedded errors html httpd io kernel math namespaces parser
-sequences strings hashtables ;
+USING: calendar embedded errors html httpd io kernel math
+namespaces parser sequences strings hashtables ;
 
 : serving-path ( filename -- filename )
     [ "" ] unless* "doc-root" get swap path+ ;
 
 : file-http-date ( filename -- string )
-  #! Return the date in HTTP Date format (see RFC 2616).
-  #! Returns false if no time information available for the file.
-  stat [ fourth unix>gmt timestamp>http-string ] [ f ] if* ;
+    file-modified unix>gmt timestamp>http-string ;
 
-: file-response ( filename mime-type length -- )
+: file-response ( filename mime-type -- )
     [
-        number>string "Content-Length" set
         "Content-Type" set
-        file-http-date [ "Last-Modified" set ] when*
+        dup file-length number>string "Content-Length" set
+        file-http-date "Last-Modified" set
         now timestamp>http-string "Date" set
     ] make-hash "200 OK" response terpri ;
 
 : last-modified-matches? ( filename -- bool )
-  file-http-date [
+    file-http-date dup [
         "If-Modified-Since" "header" get hash = 
-  ] [
-    f
-  ] if* ;
+    ] when ;
 
 : not-modified-response ( -- )
-    [
-        now timestamp>http-string "Date" set
-    ] make-hash "304 Not Modified" response terpri ;  
+    now timestamp>http-string "Date" associate
+    "304 Not Modified" response terpri ;  
 
 : serve-static ( filename mime-type -- )
     over last-modified-matches? [
-      drop not-modified-response
+        2drop not-modified-response
     ] [
-      dupd pick file-length file-response "method" get "head" = [
+        dupd file-response
+        "method" get "head" = [
             drop
         ] [
             <file-reader> stdio get stream-copy

contrib/httpd/test/httpd.factor

@@ -7,11 +7,6 @@ USE: io
 USE: test
 USE: strings
 
-[ "HTTP/1.0 200 OK\nContent-Length: 12\nContent-Type: text/html\n\n" ]
-[
-    [ "text/html" 12 file-response ] string-out
-] unit-test
-
 [ ] [ "404 not found" httpd-error ] unit-test
 
 [ "inspect/global" ] [ "/inspect/global" trim-/ ] unit-test