version 1.10, 2001/11/11 22:33:31
|
version 1.11, 2002/06/02 21:19:09
|
Line 22 warnings off
|
Line 22 warnings off
|
|
|
require string.fs |
require string.fs |
|
|
|
Variable DocumentRoot s" /usr/local/httpd/htdocs/" DocumentRoot $! |
|
Variable UserDir s" .html-data/" UserDir $! |
|
|
Variable url |
Variable url |
Variable posted |
Variable posted |
Variable url-args |
Variable url-args |
Line 83 value: Connection:
|
Line 86 value: Connection:
|
value: Referer: |
value: Referer: |
value: Content-Type: |
value: Content-Type: |
value: Content-Length: |
value: Content-Length: |
|
value: Keep-Alive: |
|
|
definitions |
definitions |
|
|
Line 91 Variable maxnum
|
Line 95 Variable maxnum
|
: ?cr ( -- ) |
: ?cr ( -- ) |
#tib @ 1 >= IF source 1- + c@ #cr = #tib +! THEN ; |
#tib @ 1 >= IF source 1- + c@ #cr = #tib +! THEN ; |
: refill-loop ( -- flag ) |
: refill-loop ( -- flag ) |
BEGIN refill ?cr WHILE interpret >in @ 0= UNTIL |
BEGIN refill ?cr WHILE ['] interpret catch drop >in @ 0= UNTIL |
true ELSE maxnum off false THEN ; |
true ELSE maxnum off false THEN ; |
: get-input ( -- flag ior ) |
: get-input ( -- flag ior ) |
s" /nosuchfile" url $! s" HTTP/1.0" protocol $! |
s" /nosuchfile" url $! s" HTTP/1.0" protocol $! |
s" close" connection $! |
s" close" connection $! |
infile-id push-file loadfile ! loadline off blk off |
infile-id push-file loadfile ! loadline off blk off |
commands 1 set-order command? on ['] refill-loop catch |
commands 1 set-order command? on ['] refill-loop catch |
|
Keep-Alive $@ snumber? dup 0> IF nip THEN IF maxnum ! THEN |
active @ IF s" " posted $! Content-Length $@ snumber? drop |
active @ IF s" " posted $! Content-Length $@ snumber? drop |
posted $!len posted $@ infile-id read-file throw drop |
posted $!len posted $@ infile-id read-file throw drop |
THEN only forth also pop-file ; |
THEN only forth also pop-file ; |
Line 107 Variable maxnum
|
Line 112 Variable maxnum
|
Variable htmldir |
Variable htmldir |
|
|
: rework-htmldir ( addr u -- addr' u' / ior ) |
: rework-htmldir ( addr u -- addr' u' / ior ) |
htmldir $! |
htmldir $! htmldir $@ compact.. htmldir $!len drop |
|
htmldir $@ 3 min s" ../" compare 0= |
|
IF -1 EXIT THEN \ can't access below current directory |
htmldir $@ 1 min s" ~" compare 0= |
htmldir $@ 1 min s" ~" compare 0= |
IF s" /.html-data" htmldir dup $@ 2dup '/ scan |
IF UserDir $@ htmldir dup $@ 2dup '/ scan '/ skip |
nip - nip $ins |
nip - nip $ins |
ELSE s" /usr/local/httpd/htdocs/" htmldir 0 $ins THEN |
ELSE DocumentRoot $@ htmldir 0 $ins THEN |
htmldir $@ 1- 0 max + c@ '/ = htmldir $@len 0= or |
htmldir $@ 1- 0 max + c@ '/ = htmldir $@len 0= or |
IF s" index.html" htmldir dup $@len $ins THEN |
IF s" index.html" htmldir dup $@len $ins THEN |
htmldir $@ file-status nip ?dup ?EXIT |
htmldir $@ file-status nip ?dup ?EXIT |
Line 152 Variable htmldir
|
Line 159 Variable htmldir
|
|
|
: mime-read ( addr u -- ) r/o open-file throw |
: mime-read ( addr u -- ) r/o open-file throw |
push-file loadfile ! 0 loadline ! blk off |
push-file loadfile ! 0 loadline ! blk off |
BEGIN refill WHILE name |
BEGIN refill WHILE |
BEGIN >in @ >r name nip WHILE |
char '# <> >in off name nip 0<> and IF |
r> >in ! 2dup transparent: REPEAT |
>in off name |
2drop rdrop |
BEGIN >in @ >r name nip WHILE |
|
r> >in ! 2dup transparent: REPEAT |
|
2drop rdrop |
|
THEN |
REPEAT loadfile @ close-file pop-file throw ; |
REPEAT loadfile @ close-file pop-file throw ; |
|
|
: lastrequest |
: lastrequest |
Line 217 Defer redirect ( addr u -- )
|
Line 227 Defer redirect ( addr u -- )
|
0= IF ['] txt THEN catch IF maxnum off THEN |
0= IF ['] txt THEN catch IF maxnum off THEN |
THEN THEN THEN THEN outfile-id flush-file throw ; |
THEN THEN THEN THEN outfile-id flush-file throw ; |
|
|
: httpd ( n -- ) maxnum ! |
: httpd ( n -- ) dup maxnum ! 0 <# #S #> Keep-Alive $! |
BEGIN ['] http catch maxnum @ 0= or UNTIL ; |
BEGIN ['] http catch maxnum @ 0= or UNTIL ; |
|
|
script? [IF] :noname &100 httpd bye ; is bootmessage [THEN] |
script? [IF] :noname &100 httpd bye ; is bootmessage [THEN] |