--- gforth/httpd.fs 2000/09/23 15:46:57 1.7 +++ gforth/httpd.fs 2004/04/10 00:16:55 1.15 @@ -1,6 +1,6 @@ #! /usr/local/bin/gforth -\ Copyright (C) 2000 Free Software Foundation, Inc. +\ Copyright (C) 2000,2002,2003 Free Software Foundation, Inc. \ This file is part of Gforth. @@ -20,7 +20,10 @@ warnings off -include string.fs +require string.fs + +Variable DocumentRoot s" /usr/local/httpd/htdocs/" DocumentRoot $! +Variable UserDir s" .html-data/" UserDir $! Variable url Variable posted @@ -83,6 +86,7 @@ value: Connection: value: Referer: value: Content-Type: value: Content-Length: +value: Keep-Alive: definitions @@ -91,13 +95,14 @@ Variable maxnum : ?cr ( -- ) #tib @ 1 >= IF source 1- + c@ #cr = #tib +! THEN ; : 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 ; : get-input ( -- flag ior ) s" /nosuchfile" url $! s" HTTP/1.0" protocol $! s" close" connection $! infile-id push-file loadfile ! loadline off blk off 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 posted $!len posted $@ infile-id read-file throw drop THEN only forth also pop-file ; @@ -107,11 +112,13 @@ Variable maxnum Variable htmldir : rework-htmldir ( addr u -- addr' u' / ior ) - htmldir $! - htmldir $@ 1 min s" ~" compare 0= - IF s" /.html-data" htmldir dup $@ 2dup '/ scan + htmldir $! htmldir $@ compact.. htmldir $!len drop + htmldir $@ s" ../" string-prefix? + IF -1 EXIT THEN \ can't access below current directory + htmldir $@ s" ~" string-prefix? + IF UserDir $@ htmldir dup $@ 2dup '/ scan '/ skip 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 IF s" index.html" htmldir dup $@len $ins THEN htmldir $@ file-status nip ?dup ?EXIT @@ -137,7 +144,7 @@ Variable htmldir : .connection ( -- ) ." Connection: " - connection $@ s" Keep-Alive" compare 0= maxnum @ 0> and + connection $@ s" Keep-Alive" str= maxnum @ 0> and IF connection $@ type cr ." Keep-Alive: timeout=15, max=" maxnum @ 0 .r cr -1 maxnum +! ELSE ." close" cr maxnum off THEN ; @@ -152,10 +159,13 @@ Variable htmldir : mime-read ( addr u -- ) r/o open-file throw push-file loadfile ! 0 loadline ! blk off - BEGIN refill WHILE name - BEGIN >in @ >r name nip WHILE - r> >in ! 2dup transparent: REPEAT - 2drop rdrop + BEGIN refill WHILE + char '# <> >in off name nip 0<> and IF + >in off name + BEGIN >in @ >r name nip WHILE + r> >in ! 2dup transparent: REPEAT + 2drop rdrop + THEN REPEAT loadfile @ close-file pop-file throw ; : lastrequest @@ -205,15 +215,20 @@ s" text/plain" transparent: txt \ http server 26mar00py +Defer redirect? ( addr u -- addr' u' t / f ) +Defer redirect ( addr u -- ) +:noname 2drop false ; IS redirect? + : http ( -- ) get-input IF .nok ELSE - IF url $@ 1 /string rework-htmldir + IF url $@ 1 /string 2dup redirect? IF redirect 2drop ELSE + rework-htmldir dup 0< IF drop .nofile ELSE .ok 2dup >mime mime search-wordlist 0= IF ['] txt THEN catch IF maxnum off THEN - THEN THEN THEN outfile-id flush-file throw ; + THEN THEN THEN THEN outfile-id flush-file throw ; -: httpd ( n -- ) maxnum ! - BEGIN ['] http catch maxnum @ 0= or UNTIL ; +: httpd ( n -- ) dup maxnum ! 0 <# #S #> Keep-Alive $! + maxnum @ 0 DO ['] http catch maxnum @ 0= or ?LEAVE LOOP ; script? [IF] :noname &100 httpd bye ; is bootmessage [THEN] @@ -224,3 +239,7 @@ script? [IF] :noname &100 httpd bye ; i type cr refill 0= UNTIL EXIT THEN nip source >in @ /string rot - dup 2 + >in +! type ; : ( -- ) ." " $> ; + +\ provide transparent proxying + +include ./proxy.fs