retroforth/example/Casket-HTTP.retro

#!/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.