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

Better HTTPD logging, and fix a file-responder bug

slava 2006-02-04 01:00:23 +00:00
parent e9f73af344
commit 802681fa1e
2 changed files with 8 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -32,12 +32,12 @@ parser sequences strings ;
"method" get "head" = [ "method" get "head" = [
drop drop
] [ ] [
"request" get [ directory. ] simple-html-document "request" get [ dup log-message directory. ] simple-html-document
] if ; ] if ;
: serve-directory ( filename -- ) : serve-directory ( filename -- )
"/" ?tail [ "/" over tail? [
dup "/index.html" append dup exists? [ dup "index.html" append dup exists? [
nip serve-file nip serve-file
] [ ] [
drop list-directory drop list-directory

10
contrib/httpd/responder.factor
View File

@ -62,10 +62,10 @@ SYMBOL: responders
"Content-Length" swap hash dup "Content-Length" swap hash dup
[ string>number read query>hash ] when ; [ string>number read query>hash ] when ;
: log-user-agent ( hash -- ) : log-headers ( hash -- )
"User-Agent" swap hash [ [
[ "User Agent: " % ": " % % ] "" make log-message drop { "User-Agent" "X-Forwarded-For" "Host" } member?
] when* ; ] hash-subset [ ": " swap append3 log-message ] hash-each ;
: prepare-url ( url -- url ) : prepare-url ( url -- url )
#! This is executed in the with-request namespace. #! This is executed in the with-request namespace.
@ -75,7 +75,7 @@ SYMBOL: responders
: prepare-header ( -- ) : prepare-header ( -- )
read-header dup "header" set read-header dup "header" set
dup log-user-agent dup log-headers
read-post-request "response" set ; read-post-request "response" set ;
! Responders are called in a new namespace with these ! Responders are called in a new namespace with these