File responder directory listing fixes
parent
e364bbaddc
commit
a40b1e12de
|
@ -10,22 +10,19 @@ global [
|
|||
H{ } clone responders set
|
||||
|
||||
! 404 error message pages are served by this guy
|
||||
[
|
||||
"404" "responder" set
|
||||
[ drop no-such-responder ] "get" set
|
||||
] make-responder
|
||||
"404" [ no-such-responder ] install-cont-responder
|
||||
|
||||
! Online help browsing
|
||||
"help" [ help-responder ] install-cont-responder
|
||||
|
||||
! Javascript source used by ajax libraries
|
||||
[
|
||||
"contrib/httpd/javascript/" resource-path "doc-root" set
|
||||
"javascript" "responder" set
|
||||
[ file-responder ] "get" set
|
||||
[ file-responder ] "post" set
|
||||
[ file-responder ] "head" set
|
||||
] make-responder
|
||||
"javascript" [
|
||||
[
|
||||
"contrib/httpd/javascript/" resource-path
|
||||
"doc-root" set
|
||||
file-responder
|
||||
] with-scope
|
||||
] install-cont-responder
|
||||
|
||||
! Global variables
|
||||
"inspector" [ inspect-responder ] install-cont-responder
|
||||
|
@ -36,13 +33,7 @@ global [
|
|||
! Serves files from a directory stored in the "doc-root"
|
||||
! variable. You can set the variable in the global namespace,
|
||||
! or inside the responder.
|
||||
[
|
||||
! "/var/www/" "doc-root" set
|
||||
"file" "responder" set
|
||||
[ file-responder ] "get" set
|
||||
[ file-responder ] "post" set
|
||||
[ file-responder ] "head" set
|
||||
] make-responder
|
||||
"file" [ file-responder ] install-cont-responder
|
||||
|
||||
! The root directory is served by...
|
||||
"file" set-default-responder
|
||||
|
|
|
@ -1,8 +1,8 @@
|
|||
! Copyright (C) 2004,2005 Slava Pestov.
|
||||
! See http://factor.sf.net/license.txt for BSD license.
|
||||
IN: file-responder
|
||||
USING: html httpd kernel lists math namespaces parser sequences
|
||||
io strings ;
|
||||
USING: cont-responder html httpd io kernel lists math namespaces
|
||||
parser sequences strings ;
|
||||
|
||||
: serving-path ( filename -- filename )
|
||||
[ "" ] unless* "doc-root" get swap append ;
|
||||
|
@ -49,13 +49,15 @@ io strings ;
|
|||
: serve-object ( filename -- )
|
||||
dup directory? [ serve-directory ] [ serve-file ] if ;
|
||||
|
||||
: file-responder ( filename -- )
|
||||
"doc-root" get [
|
||||
serving-path dup exists? [
|
||||
serve-object
|
||||
: file-responder ( -- )
|
||||
[
|
||||
"doc-root" get [
|
||||
"argument" get serving-path dup exists? [
|
||||
serve-object
|
||||
] [
|
||||
drop "404 not found" httpd-error
|
||||
] if
|
||||
] [
|
||||
drop "404 not found" httpd-error
|
||||
"404 doc-root not set" httpd-error
|
||||
] if
|
||||
] [
|
||||
drop "404 doc-root not set" httpd-error
|
||||
] if ;
|
||||
] (show-final) ;
|
||||
|
|
|
@ -126,11 +126,8 @@ SYMBOL: responders
|
|||
: set-default-responder ( name -- )
|
||||
responder "default" responders get set-hash ;
|
||||
|
||||
: responder-argument ( argument -- argument )
|
||||
dup empty? [ drop "default-argument" get ] when ;
|
||||
|
||||
: call-responder ( method argument responder -- )
|
||||
[ responder-argument swap get call ] bind ;
|
||||
over "argument" set [ swap get call ] bind ;
|
||||
|
||||
: serve-default-responder ( method url -- )
|
||||
"default" responder call-responder ;
|
||||
|
|
|
@ -15,13 +15,6 @@ USE: lists
|
|||
|
||||
[ ] [ "404 not found" httpd-error ] unit-test
|
||||
|
||||
[ "arg" ] [
|
||||
[
|
||||
"arg" "default-argument" set
|
||||
"" responder-argument
|
||||
] with-scope
|
||||
] unit-test
|
||||
|
||||
[ "inspect/global" ] [ "/inspect/global" trim-/ ] unit-test
|
||||
|
||||
[ ] [
|
||||
|
|
|
@ -32,7 +32,7 @@ DEFER: directory.
|
|||
|
||||
: (directory.) ( name path -- )
|
||||
dup [ directory. ] curry
|
||||
[ "/" append (file.) ] write-outliner ;
|
||||
[ "/" append (file.) ] write-outliner terpri ;
|
||||
|
||||
: file. ( dir name -- )
|
||||
tuck path+
|
||||
|
|
Loading…
Reference in New Issue