file-responder fixes

slava 2006-11-14 23:10:43 +00:00
parent ed32bdf650
commit cd7a57dfb0
2 changed files with 18 additions and 27 deletions

View File

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

View File

@ -7,11 +7,6 @@ USE: io
USE: test USE: test
USE: strings 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 [ ] [ "404 not found" httpd-error ] unit-test
[ "inspect/global" ] [ "/inspect/global" trim-/ ] unit-test [ "inspect/global" ] [ "/inspect/global" trim-/ ] unit-test