--- gforth/httpd.fs 2000/04/09 20:57:25 1.4 +++ gforth/httpd.fs 2000/04/12 20:53:46 1.5 @@ -35,10 +35,10 @@ wordlist constant commands r> 1+ +LOOP url $!len r> base ! ; -: rework-? ( addr -- ) { url } - url $@ tuck '? scan tuck dup 0<> - url-args $! - url $!len ; +: rework-? ( addr -- ) + dup >r $@ '? $split url-args $! nip r> $!len ; -: get-url url get protocol get-rest +: get-url ( -- ) url get protocol get-rest url rework-? url rework-% >values ; commands set-current @@ -84,23 +84,6 @@ Variable maxnum posted $!len posted $@ infile-id read-file throw drop THEN only forth also pop-file ; -\ Keep-Alive handling 26mar00py - -: .connection ( -- ) - ." Connection: " - connection $@ s" Keep-Alive" compare 0= maxnum @ 0> and - IF connection $@ type cr - ." Keep-Alive: timeout=15, max=" maxnum @ 0 .r cr - -1 maxnum +! ELSE ." close" cr maxnum off THEN ; - -\ Use Forth as server-side script language 26mar00py - -: $> ( -- ) - BEGIN source >in @ /string s" <$" search 0= WHILE - type cr refill 0= UNTIL EXIT THEN - nip source >in @ /string rot - dup 2 + >in +! type ; -: ( -- ) ." " $> ; - \ Rework HTML directory 26mar00py Variable htmldir @@ -132,6 +115,15 @@ Variable htmldir $4000 - $4000 +LOOP drop free fd close-file throw throw ; +\ Keep-Alive handling 26mar00py + +: .connection ( -- ) + ." Connection: " + connection $@ s" Keep-Alive" compare 0= maxnum @ 0> and + IF connection $@ type cr + ." Keep-Alive: timeout=15, max=" maxnum @ 0 .r cr + -1 maxnum +! ELSE ." close" cr maxnum off THEN ; + : transparent: ( addr u -- ) Create here over 1+ allot place DOES> >r >file .connection @@ -169,29 +161,33 @@ s" text/plain" transparent: txt \ http errors 26mar00py -: .server ." Server: Gforth httpd/0.1 (" +: .server ( -- ) ." Server: Gforth httpd/0.1 (" s" os-class" environment? IF type THEN ." )" cr ; -: .ok ." HTTP/1.1 200 OK" cr .server ; +: .ok ( -- ) ." HTTP/1.1 200 OK" cr .server ; : html-error ( n addr u -- ) ." HTTP/1.1 " 2 pick . 2dup type cr .server - 2 pick &405 = IF ." Allow: GET, HEAD, POST" cr THEN lastrequest - ."
Your browser sent a request that this server could not understand.
" cr - ."Invalid request in: Your browser sent a request that this server "
+ ." could not understand. Invalid request in: The requested URL " error-stack cell+ 2@ swap type
+ ."
"
+ error-stack cell+ 2@ swap type
."
" url $@ type
."
was not found on this server