version 1.3, 2000/04/02 21:48:54
|
version 1.4, 2000/04/09 20:57:25
|
Line 5 warnings off
|
Line 5 warnings off
|
include string.fs |
include string.fs |
|
|
Variable url |
Variable url |
|
Variable posted |
|
Variable url-args |
Variable protocol |
Variable protocol |
Variable data |
Variable data |
|
Variable active |
Variable command? |
Variable command? |
|
|
: get ( addr -- ) name rot $! ; |
: get ( addr -- ) name rot $! ; |
: get-rest ( addr -- ) source >in @ /string dup >in +! rot $! ; |
: get-rest ( addr -- ) source >in @ /string dup >in +! rot $! ; |
|
|
Table constant values |
wordlist constant values |
Table constant commands |
wordlist constant commands |
|
|
: value: ( -- ) name |
: value: ( -- ) name |
Forth definitions 2dup 1- nextname Variable |
Forth definitions 2dup 1- nextname Variable |
Line 23 Table constant commands
|
Line 26 Table constant commands
|
|
|
\ HTTP protocol commands 26mar00py |
\ HTTP protocol commands 26mar00py |
|
|
: rework-% ( -- ) base @ >r hex |
: rework-% ( add -- ) { url } base @ >r hex |
0 url $@len 0 ?DO |
0 url $@len 0 ?DO |
url $@ drop I + c@ dup '% = IF |
url $@ drop I + c@ dup '% = IF |
drop 0. url $@ I 1+ /string |
drop 0. url $@ I 1+ /string |
Line 32 Table constant commands
|
Line 35 Table constant commands
|
r> 1+ +LOOP url $!len |
r> 1+ +LOOP url $!len |
r> base ! ; |
r> base ! ; |
|
|
|
: rework-? ( addr -- ) { url } |
|
url $@ tuck '? scan tuck dup 0<> - url-args $! - url $!len ; |
|
|
|
: get-url url get protocol get-rest |
|
url rework-? url rework-% >values ; |
|
|
commands set-current |
commands set-current |
|
|
: GET url get rework-% protocol get-rest >values data on ; |
: GET get-url data on active off ; |
: HEAD url get rework-% protocol get-rest >values data off ; |
: POST get-url data on active on ; |
|
: HEAD get-url data off active off ; |
|
|
\ HTTP protocol values 26mar00py |
\ HTTP protocol values 26mar00py |
|
|
Line 53 value: X-Forwarded-For:
|
Line 63 value: X-Forwarded-For:
|
value: Cache-Control: |
value: Cache-Control: |
value: Connection: |
value: Connection: |
value: Referer: |
value: Referer: |
|
value: Content-Type: |
|
value: Content-Length: |
|
|
definitions |
definitions |
|
|
|
|
Variable maxnum |
Variable maxnum |
|
|
: ?cr ( -- ) |
: ?cr ( -- ) |
Line 69 Variable maxnum
|
Line 80 Variable maxnum
|
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 |
only forth also pop-file ; |
active @ IF s" " posted $! Content-Length $@ snumber? drop |
|
posted $!len posted $@ infile-id read-file throw drop |
|
THEN only forth also pop-file ; |
|
|
\ Keep-Alive handling 26mar00py |
\ Keep-Alive handling 26mar00py |
|
|
Line 113 Variable htmldir
|
Line 126 Variable htmldir
|
r@ file-size throw drop |
r@ file-size throw drop |
." Accept-Ranges: bytes" cr |
." Accept-Ranges: bytes" cr |
." Content-Length: " dup 0 .r cr r> ; |
." Content-Length: " dup 0 .r cr r> ; |
: transparent ( size fd -- ) >r |
: transparent ( size fd -- ) { fd } |
dup allocate throw swap |
$4000 allocate throw swap dup 0 ?DO |
over swap r@ read-file throw over swap type |
2dup over swap $4000 min fd read-file throw type |
free r> close-file throw throw ; |
$4000 - $4000 +LOOP drop |
|
free fd close-file throw throw ; |
|
|
: transparent: ( addr u -- ) Create here over 1+ allot place |
: transparent: ( addr u -- ) Create here over 1+ allot place |
DOES> >r >file |
DOES> >r >file |
Line 160 s" text/plain" transparent: txt
|
Line 174 s" text/plain" transparent: txt
|
: .ok ." HTTP/1.1 200 OK" cr .server ; |
: .ok ." HTTP/1.1 200 OK" cr .server ; |
: html-error ( n addr u -- ) |
: html-error ( n addr u -- ) |
." HTTP/1.1 " 2 pick . 2dup type cr .server |
." HTTP/1.1 " 2 pick . 2dup type cr .server |
2 pick &405 = IF ." Allow: GET, HEAD" cr THEN lastrequest |
2 pick &405 = IF ." Allow: GET, HEAD, POST" cr THEN lastrequest |
." <HTML><HEAD><TITLE>" 2 pick . 2dup type ." </TITLE></HEAD>" cr |
." <HTML><HEAD><TITLE>" 2 pick . 2dup type ." </TITLE></HEAD>" cr |
." <BODY><H1>" type drop ." </H1>" cr ; |
." <BODY><H1>" type drop ." </H1>" cr ; |
: .trailer ( -- ) |
: .trailer ( -- ) |
Line 187 s" text/plain" transparent: txt
|
Line 201 s" text/plain" transparent: txt
|
: httpd ( n -- ) maxnum ! |
: httpd ( n -- ) maxnum ! |
BEGIN ['] http catch maxnum @ 0= or UNTIL ; |
BEGIN ['] http catch maxnum @ 0= or UNTIL ; |
|
|
script? [IF] &100 httpd bye [THEN] |
script? [IF] :noname &100 httpd bye ; is bootmessage [THEN] |