326 lines
9 KiB
Forth
Executable file
326 lines
9 KiB
Forth
Executable file
#!/usr/bin/env retro
|
|
|
|
================================================================
|
|
____ _ _ __
|
|
/ ___|__ _ ___| | _____| |_ __ __/ /_
|
|
| | / _` / __| |/ / _ \ __| \ \ / / '_ \
|
|
| |__| (_| \__ \ < __/ |_ \ V /| (_) |
|
|
\____\__,_|___/_|\_\___|\__| \_/ \___/
|
|
|
|
================================================================
|
|
|
|
Casket is a small HTTP/1.1 server written in RetroForth.
|
|
|
|
Some notes on this:
|
|
|
|
- runs under inetd
|
|
- use w/stunnel if you need HTTPS
|
|
- I recommend also using timelimit(1) with this
|
|
|
|
Changes from v5:
|
|
|
|
- removed support for running .fsp files
|
|
- now using `file:read/bytes` and `file:write/bytes`
|
|
- support for HEAD requests
|
|
- reject POST, PUT, DELETE requests
|
|
- various refactorings
|
|
|
|
================================================================
|
|
|
|
First, some configuration options. Since this will run under
|
|
inetd there's no need to specify the port. But the path to the
|
|
files to serve is needed, so define it here.
|
|
|
|
~~~
|
|
'/home/crc/wip-test 'WEBROOT s:const
|
|
~~~
|
|
|
|
The server supports virtual servers. For this, create a separate
|
|
directory for each under the `WEBROOT`. E.g., I use a setup like
|
|
|
|
/www/retroforth.org
|
|
/www/retroforth.org:443
|
|
/www/ilo.retroforth.org
|
|
|
|
Note the port number: if using a port other than 80 this is
|
|
needed. I recommend just using a symlink.
|
|
|
|
================================================================
|
|
|
|
Next, I need to handle the incoming requests. HTTP allows for a
|
|
large number of header fields, but I really only care about two:
|
|
GET and Host.
|
|
|
|
An incoming request will look like:
|
|
|
|
GET / HTTP/1.1
|
|
Host: retroforth.org
|
|
|
|
With the lines ending in a CR,LF sequence.
|
|
|
|
I need to allocate space for the data I care about. There are
|
|
three items:
|
|
|
|
- The `Requested` file
|
|
- The desired virtual `Host`
|
|
- The query string (if any)
|
|
|
|
~~~
|
|
'Requested d:create #8193 allot
|
|
'Host d:create #1025 allot
|
|
'Method var
|
|
'Query var
|
|
~~~
|
|
|
|
The header processor will read each item and store the `Host`
|
|
and `Requested` file. Everything else is ignored.
|
|
|
|
I implement `eot?` to decide if a line (or field) indicator
|
|
has been reached. This is used by `s:get` to decide when the
|
|
input should stop. `s:get` records the characters read into
|
|
the specified buffer. And finally, `read-request` reads the
|
|
input.
|
|
|
|
~~~
|
|
'Done var
|
|
|
|
:eot? (c-f)
|
|
[ ASCII:CR eq? ]
|
|
[ ASCII:LF eq? ]
|
|
[ ASCII:SPACE eq? ] tri or or ;
|
|
|
|
:s:get (a-)
|
|
buffer:set [ c:get &buffer:add &eot? bi ] until
|
|
buffer:get drop ;
|
|
|
|
:req? (s-f) here s:to-upper swap s:eq? ;
|
|
|
|
:read-request (-)
|
|
[ here s:get
|
|
'GET req? [ &Requested s:get &Done v:inc #1 !Method ] if
|
|
'HEAD req? [ &Requested s:get &Done v:inc #2 !Method ] if
|
|
|
|
(unsupported)
|
|
'PUT req? [ &Requested s:get &Done v:inc #0 !Method ] if
|
|
'POST req? [ &Requested s:get &Done v:inc #0 !Method ] if
|
|
'DELETE req? [ &Requested s:get &Done v:inc #0 !Method ] if
|
|
|
|
'HOST: req? [ &Host s:get &Done v:inc ] if
|
|
@Done #2 eq? ] until ;
|
|
~~~
|
|
|
|
================================================================
|
|
|
|
Next is reading in the desired file. An initial request may be
|
|
just a **/**. In this case, Casket will replace the `Requested`
|
|
filename with **/index.html**. In the odd case that a file is
|
|
requested without a leading **/**, I have a word to add this.
|
|
And then a word that constructs a filename.
|
|
|
|
This also has a word `check-for-params` that is used to separate
|
|
the requested file from any query string that may be present.
|
|
|
|
~~~
|
|
:map-/-to-index (-)
|
|
&Requested '/ s:eq?
|
|
[ '/index.html &Requested s:copy ] if ;
|
|
|
|
:ensure-leading-/ (-)
|
|
@Requested $/ -eq?
|
|
[ '/ &Requested s:append s:keep &Requested s:copy ] if ;
|
|
|
|
:s:terminate (s-) #0 swap store ;
|
|
|
|
:check-for-params (-)
|
|
&Requested $? s:contains/char?
|
|
[ &Requested $? s:split/char drop
|
|
[ n:inc !Query ] &s:terminate bi ] if ;
|
|
|
|
:prepare
|
|
check-for-params map-/-to-index ensure-leading-/ ;
|
|
|
|
:filename (-s)
|
|
prepare &Requested &Host WEBROOT '%s/%s%s s:format
|
|
dup '%s/index.html s:format
|
|
file:exists? [ '%s/index.html s:format ] if ;
|
|
~~~
|
|
|
|
Next, I need to determine the file type. I'll do this by taking
|
|
a look at the extension, and mapping this to a MIME type.
|
|
|
|
~~~
|
|
:filename-w/o-path
|
|
WEBROOT s:length &Host s:length + filename +
|
|
[ $/ s:index/char ] sip + ;
|
|
|
|
:get-mime-type (-s)
|
|
filename-w/o-path [ $. s:index/char ] sip +
|
|
(textual_files)
|
|
'.md [ 'text/markdown ] s:case
|
|
'.htm [ 'text/html ] s:case
|
|
'.html [ 'text/html ] s:case
|
|
'.css [ 'text/css ] s:case
|
|
(image_files)
|
|
'.png [ 'image/png ] s:case
|
|
'.jpg [ 'image/jpeg ] s:case
|
|
'.jpeg [ 'image/jpeg ] s:case
|
|
'.gif [ 'image/gif ] s:case
|
|
'.bmp [ 'image/bmp ] s:case
|
|
(application_files)
|
|
'.pdf [ 'application/pdf ] s:case
|
|
'.gz [ 'application/gzip ] s:case
|
|
'.zip [ 'application/zip ] s:case
|
|
'.json [ 'application/json ] s:case
|
|
'.js [ 'application/x-javascript ] s:case
|
|
'.xml [ 'application/xml ] s:case
|
|
'.tar.gz [ 'application/gzip ] s:case
|
|
'.retro.html [ 'text/html ] s:case
|
|
drop 'text/plain ;
|
|
~~~
|
|
|
|
================================================================
|
|
|
|
Using these, I can construct a word to read in the file and
|
|
send it to the client.
|
|
|
|
Reading files is now a bit more involved, since images and
|
|
other formats have binary data.
|
|
|
|
`transfer` performs the actual process of reading the requested
|
|
file and sending it to the client. This makes use of the
|
|
`file:read/bytes` and `file:write/bytes` to do the actual i/o.
|
|
These are used as they are faster than reading & writing on a
|
|
per-byte basis.
|
|
|
|
Adjust the `FileBuffer` size (and matching size constant) as
|
|
desired. The requsted file will be read in chunks of this size,
|
|
so matching the splits better for te files you are using can
|
|
aid in performance.
|
|
|
|
~~~
|
|
{{
|
|
'FID var 'FOUT var 'ChunkSize var
|
|
'FileBuffer d:create #16385 allot
|
|
|
|
:open-files (-)
|
|
filename file:R file:open !FID
|
|
'/dev/stdout file:W file:open !FOUT ;
|
|
|
|
:prepare (-nn)
|
|
#16384 !ChunkSize
|
|
@FID file:size @ChunkSize n:divmod ;
|
|
|
|
:read (-) &FileBuffer @ChunkSize @FID file:read/bytes drop ;
|
|
:write (-) &FileBuffer @ChunkSize @FOUT file:write/bytes drop ;
|
|
:chunk (-) read write ;
|
|
:cleanup (-) @FID file:close @FOUT file:close ;
|
|
---reveal---
|
|
:transfer (-)
|
|
open-files prepare &chunk times !ChunkSize chunk cleanup ;
|
|
}}
|
|
~~~
|
|
|
|
~~~
|
|
:eol (-) ASCII:CR c:put ASCII:LF c:put ;
|
|
|
|
:send-file (-)
|
|
get-mime-type
|
|
'Content-type:_%s s:format s:put eol eol
|
|
@Method #1 eq? &transfer if ;
|
|
~~~
|
|
|
|
In the above, `eol` will send an end of line sequence.
|
|
|
|
================================================================
|
|
|
|
The last support word is a handler for 404 errors. This
|
|
will send the 404 status code and a human readable error
|
|
message.
|
|
|
|
~~~
|
|
:404 'HTTP/1.1_404_OK s:put eol
|
|
'Content-type:_text/html s:put eol eol
|
|
'<h1>ERROR_404:_FILE_NOT_FOUND</h1> s:put eol
|
|
filename s:put nl ;
|
|
~~~
|
|
|
|
================================================================
|
|
|
|
I have a stub setup for unsupported (PUT/POST/DELETE) methods.
|
|
|
|
~~~
|
|
:unsupported (-)
|
|
'HTTP/1.1_204_No_Content s:put eol eol bye ;
|
|
~~~
|
|
================================================================
|
|
|
|
And now for the top level server.
|
|
|
|
Receive a request:
|
|
|
|
~~~
|
|
read-request
|
|
~~~
|
|
|
|
If invalid, reject:
|
|
|
|
~~~
|
|
@Method n:zero? &unsupported if
|
|
~~~
|
|
|
|
See if the file exists:
|
|
|
|
~~~
|
|
filename file:exists?
|
|
~~~
|
|
|
|
Send an "200 OK" response and the file (or a 404 if
|
|
the file wasn't found):
|
|
|
|
~~~
|
|
[ 'HTTP/1.1_200_OK s:put eol send-file ]
|
|
[ 404 ] choose
|
|
~~~
|
|
|
|
And the code for Casket is done.
|
|
|
|
================================================================
|
|
|
|
## Using Casket
|
|
|
|
Casket requires [Retro](http://forthworks.com/retro) and a Unix
|
|
system with inetd.
|
|
|
|
Install Retro and put the `casket.forth` somewhere. Then add a
|
|
configuration line to your `/etc/inetd.conf` to run it. Restart
|
|
inetd.
|
|
|
|
Edit the `WEBROOT` in `casket.forth` to point to your web
|
|
directory. Then go to the web directory and create a directory
|
|
for each domain. E.g.,
|
|
|
|
/home/crc/www/casket.forthworks.com
|
|
|
|
Put your `index.html` and other files here and try accessing
|
|
your website.
|
|
|
|
================================================================
|
|
|
|
## License and Copyright
|
|
|
|
Copyright (c) 2018 - 2023, Charles Childers
|
|
|
|
Permission to use, copy, modify, and/or distribute this software
|
|
for any purpose with or without fee is hereby granted, provided
|
|
that the copyright notice and this permission notice appear in
|
|
all copies.
|
|
|
|
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS
|
|
ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL
|
|
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO
|
|
EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT,
|
|
INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER
|
|
RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN
|
|
AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
|
|
ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE
|
|
OF THIS SOFTWARE.
|