]> gitweb.factorcode.org Git - factor.git/commitdiff
file-responder fixes
authorslava <slava@factorcode.org>
Tue, 14 Nov 2006 23:10:43 +0000 (23:10 +0000)
committerslava <slava@factorcode.org>
Tue, 14 Nov 2006 23:10:43 +0000 (23:10 +0000)
contrib/httpd/file-responder.factor
contrib/httpd/test/httpd.factor

index 28a57e8506de16bd1d3cb0104709389ebfdf2b63..0f03a0689f21c8133d7d363e30a087d993e2d811 100644 (file)
@@ -1,46 +1,42 @@
 ! 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 [
-    "If-Modified-Since" "header" get hash = 
-  ] [
-    f
-  ] if* ;
+    file-http-date dup [
+        "If-Modified-Since" "header" get hash = 
+    ] 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" = [
-          drop
-      ] [
-          <file-reader> stdio get stream-copy
-      ] if 
+        dupd file-response
+        "method" get "head" = [
+            drop
+        ] [
+            <file-reader> stdio get stream-copy
+        ] if 
     ] if ;
 
 SYMBOL: page
index 72c47bfc9708aa057ef59c047f65bbba4088a428..ff3ce5624c006a2b690d684e1b9c55974979018d 100644 (file)
@@ -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