steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

httpd -- added Date and Last-Modified header fields for file-responder, removed url-encode from print-header

release
erg 2006-08-29 00:36:54 +00:00
parent 766ef0175e
commit e77b249741
3 changed files with 7 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
contrib/httpd/file-responder.factor
View File

@ -1,20 +1,22 @@
! 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: embedded errors html httpd io kernel math namespaces parser USING: calendar embedded errors html httpd io kernel math namespaces parser
sequences strings ; sequences strings ;
: serving-path ( filename -- filename ) : serving-path ( filename -- filename )
[ "" ] unless* "doc-root" get swap append ; [ "" ] unless* "doc-root" get swap append ;
: file-response ( mime-type length -- ) : file-response ( filename mime-type length -- )
[ [
number>string "Content-Length" set number>string "Content-Length" set
"Content-Type" set "Content-Type" set
stat fourth unix>gmt timestamp>http-string "Last-Modified" set
now timestamp>http-string "Date" set
] make-hash "200 OK" response terpri ; ] make-hash "200 OK" response terpri ;
: serve-static ( filename mime-type -- ) : serve-static ( filename mime-type -- )
over file-length file-response "method" get "head" = [ dupd pick file-length file-response "method" get "head" = [
drop drop
] [ ] [
<file-reader> stdio get stream-copy <file-reader> stdio get stream-copy

2
contrib/httpd/load.factor
View File

@ -1,6 +1,6 @@
USING: io ; USING: io ;
REQUIRES: embedded ; REQUIRES: calendar embedded ;
PROVIDE: httpd { PROVIDE: httpd {
"mime.factor" "mime.factor"

2
contrib/httpd/responder.factor
View File

@ -9,7 +9,7 @@ SYMBOL: vhosts
SYMBOL: responders SYMBOL: responders
: print-header ( alist -- ) : print-header ( alist -- )
[ swap write ": " write url-encode print ] hash-each ; [ swap write ": " write print ] hash-each ;
: response ( header msg -- ) : response ( header msg -- )
"HTTP/1.0 " write print print-header ; "HTTP/1.0 " write print print-header ;