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

HTTPD fix

release
Slava Pestov 2007-09-21 22:32:32 -04:00
parent f653f3d39f
commit a00432b64e
1 changed files with 9 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
extra/http/server/responders/responders.factor
View File

@ -126,13 +126,7 @@ SYMBOL: max-post-request
#! Add a responder object to the list. #! Add a responder object to the list.
"responder" over at responders get set-at ; "responder" over at responders get set-at ;
: add-simple-responder ( name quot -- ) : make-responder ( quot -- )
[
[ drop ] swap append dup "get" set "post" set
"responder" set
] H{ } make-assoc add-responder ;
: make-responder ( quot -- responder )
#! quot has stack effect ( url -- ) #! quot has stack effect ( url -- )
[ [
[ [
@ -151,6 +145,12 @@ SYMBOL: max-post-request
call call
] H{ } make-assoc add-responder ; ] H{ } make-assoc add-responder ;
: add-simple-responder ( name quot -- )
[
[ drop ] swap append dup "get" set "post" set
"responder" set
] make-responder ;
: vhost ( name -- vhost ) : vhost ( name -- vhost )
vhosts get at [ "default" vhost ] unless* ; vhosts get at [ "default" vhost ] unless* ;
@ -175,7 +175,7 @@ SYMBOL: max-post-request
"/" ?head drop ; "/" ?head drop ;
: serve-explicit-responder ( method url -- ) : serve-explicit-responder ( method url -- )
"/" split1 "/" split1
"/responder/" pick "/" 3append "responder-url" set "/responder/" pick "/" 3append "responder-url" set
dup [ dup [
swap responder call-responder swap responder call-responder
@ -200,7 +200,7 @@ SYMBOL: max-post-request
"404 No such responder" httpd-error ; "404 No such responder" httpd-error ;
! create a responders hash if it doesn't already exist ! create a responders hash if it doesn't already exist
global [ global [
responders [ H{ } assoc-like ] change responders [ H{ } assoc-like ] change
! 404 error message pages are served by this guy ! 404 error message pages are served by this guy