version 1.11, 2002/06/02 21:19:09
|
version 1.18, 2004/12/31 13:23:57
|
Line 1
|
Line 1
|
#! /usr/local/bin/gforth |
#! /usr/local/bin/gforth |
|
|
\ Copyright (C) 2000 Free Software Foundation, Inc. |
\ Copyright (C) 2000,2002,2003,2004 Free Software Foundation, Inc. |
|
|
\ This file is part of Gforth. |
\ This file is part of Gforth. |
|
|
Line 94 Variable maxnum
|
Line 94 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 ) base @ >r base off |
BEGIN refill ?cr WHILE ['] interpret catch drop >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 r> base ! ; |
: 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 $! |
Line 112 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 $@ compact.. htmldir $!len drop |
htmldir $! htmldir $@ compact-filename htmldir $!len drop |
htmldir $@ 3 min s" ../" compare 0= |
htmldir $@ s" ../" string-prefix? |
IF -1 EXIT THEN \ can't access below current directory |
IF -1 EXIT THEN \ can't access below current directory |
htmldir $@ 1 min s" ~" compare 0= |
htmldir $@ s" ~" string-prefix? |
IF UserDir $@ htmldir dup $@ 2dup '/ scan '/ skip |
IF UserDir $@ htmldir dup $@ 2dup '/ scan '/ skip |
nip - nip $ins |
nip - nip $ins |
ELSE DocumentRoot $@ htmldir 0 $ins THEN |
ELSE DocumentRoot $@ htmldir 0 $ins THEN |
Line 144 Variable htmldir
|
Line 144 Variable htmldir
|
|
|
: .connection ( -- ) |
: .connection ( -- ) |
." Connection: " |
." Connection: " |
connection $@ s" Keep-Alive" compare 0= maxnum @ 0> and |
connection $@ s" Keep-Alive" str= maxnum @ 0> and |
IF connection $@ type cr |
IF connection $@ type cr |
." Keep-Alive: timeout=15, max=" maxnum @ 0 .r cr |
." Keep-Alive: timeout=15, max=" maxnum @ 0 .r cr |
-1 maxnum +! ELSE ." close" cr maxnum off THEN ; |
-1 maxnum +! ELSE ." close" cr maxnum off THEN ; |
Line 228 Defer redirect ( addr u -- )
|
Line 228 Defer redirect ( addr u -- )
|
THEN THEN THEN THEN outfile-id flush-file throw ; |
THEN THEN THEN THEN outfile-id flush-file throw ; |
|
|
: httpd ( n -- ) dup maxnum ! 0 <# #S #> Keep-Alive $! |
: httpd ( n -- ) dup maxnum ! 0 <# #S #> Keep-Alive $! |
BEGIN ['] http catch maxnum @ 0= or UNTIL ; |
maxnum @ 0 DO ['] http catch maxnum @ 0= or ?LEAVE LOOP ; |
|
|
script? [IF] :noname &100 httpd bye ; is bootmessage [THEN] |
script? [IF] :noname &100 httpd bye ; is bootmessage [THEN] |
|
|