| #! /usr/local/bin/gforth |
#! /usr/local/bin/gforth |
| |
|
| \ Copyright (C) 2000,2002,2003,2004 Free Software Foundation, Inc. |
\ Copyright (C) 2000,2002,2003,2004,2006,2007,2008 Free Software Foundation, Inc. |
| |
|
| \ This file is part of Gforth. |
\ This file is part of Gforth. |
| |
|
| \ Gforth is free software; you can redistribute it and/or |
\ Gforth is free software; you can redistribute it and/or |
| \ modify it under the terms of the GNU General Public License |
\ modify it under the terms of the GNU General Public License |
| \ as published by the Free Software Foundation; either version 2 |
\ as published by the Free Software Foundation, either version 3 |
| \ of the License, or (at your option) any later version. |
\ of the License, or (at your option) any later version. |
| |
|
| \ This program is distributed in the hope that it will be useful, |
\ This program is distributed in the hope that it will be useful, |
| \ GNU General Public License for more details. |
\ GNU General Public License for more details. |
| |
|
| \ You should have received a copy of the GNU General Public License |
\ You should have received a copy of the GNU General Public License |
| \ along with this program; if not, write to the Free Software |
\ along with this program. If not, see http://www.gnu.org/licenses/. |
| \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA. |
|
| |
\ This relies on inetd or xinetd: |
| |
|
| |
\ To run the server on port 4444, do the following: |
| |
|
| |
\ Add the following line to /etc/services: |
| |
\ gforth 4444/tcp |
| |
|
| |
\ If you use inetd, add the following line to /etc/inetd.conf: |
| |
\ gforth stream tcp nowait.10000 wwwrun /usr/users/bernd/bin/httpd |
| |
|
| |
\ If you use xinetd, create the folliwing service in /etc/xinetd.d: |
| |
\ service gforth |
| |
\ { |
| |
\ socket_type = stream |
| |
\ protocol = tcp |
| |
\ wait = no |
| |
\ user = wwwrun |
| |
\ server = /home/bernd/bin/httpd |
| |
\ } |
| |
|
| |
\ If you want port 80, replace the service "gforth" with "http" |
| |
|
| warnings off |
warnings off |
| |
|
| require string.fs |
require string.fs |
| |
|
| Variable DocumentRoot s" /usr/local/httpd/htdocs/" DocumentRoot $! |
Variable DocumentRoot s" /srv/www/htdocs/" DocumentRoot $! |
| Variable UserDir s" public_html/" UserDir $! |
Variable UserDir s" public_html/" UserDir $! |
| |
|
| Variable url |
Variable url |
| mime set-current |
mime set-current |
| |
|
| : shtml ( addr u -- ) lastrequest |
: shtml ( addr u -- ) lastrequest |
| data @ IF included ELSE 2drop THEN ; |
data @ IF also forth included previous ELSE 2drop THEN ; |
| |
|
| s" application/pgp-signature" transparent: sig |
s" application/pgp-signature" transparent: sig |
| s" application/x-bzip2" transparent: bz2 |
s" application/x-bzip2" transparent: bz2 |
| s" application/x-gzip" transparent: gz |
s" application/x-gzip" transparent: gz |
| s" /etc/mime.types" ['] mime-read catch [IF] 2drop [THEN] |
s" /etc/mime.types" ' mime-read catch [IF] 2drop |
| |
\ no /etc/mime.types found on this machine, |
| |
\ generating the most important types: |
| |
s" text/html" transparent: html |
| |
s" image/gif" transparent: gif |
| |
s" image/png" transparent: png |
| |
s" image/jpg" transparent: jpg |
| |
[THEN] |
| |
|
| definitions |
definitions |
| |
|
| |
|
| \ http errors 26mar00py |
\ http errors 26mar00py |
| |
|
| : .server ( -- ) ." Server: Gforth httpd/0.1 (" |
: .server ( -- ) ." Server: Gforth httpd/1.0 (" |
| s" os-class" environment? IF type THEN ." )" cr ; |
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 -- ) |
: html-error ( n addr u -- ) |
| ." </TITLE></HEAD>" cr |
." </TITLE></HEAD>" cr |
| ." <BODY><H1>" type drop ." </H1>" cr ; |
." <BODY><H1>" type drop ." </H1>" cr ; |
| : .trailer ( -- ) |
: .trailer ( -- ) |
| ." <HR><ADDRESS>Gforth httpd 0.1</ADDRESS>" cr |
." <HR><ADDRESS>Gforth httpd 1.0</ADDRESS>" cr |
| ." </BODY></HTML>" cr ; |
." </BODY></HTML>" cr ; |
| : .nok ( -- ) command? @ IF &405 s" Method Not Allowed" |
: .nok ( -- ) command? @ IF &405 s" Method Not Allowed" |
| ELSE &400 s" Bad Request" THEN html-error |
ELSE &400 s" Bad Request" THEN html-error |
