retroforth/example/Atua-WWW.retro

#!/usr/bin/env retro

# Atua-WWW: Serving Gopher to Web Browsers

Atua is a Gopher server written in Retro. I've used it for a few
years, but most people don't use Gopher clients these days. This
is a variation of Atua that translates the Gopher directories to
HTML and speaks enough HTTP to serve files to the bloated
browsers in use today.

This will get run as an inetd service, which keeps things simple
as it prevents needing to handle socket I/O directly.

Atua-WWW uses Retro's *retro-unix* interface layer. Designed to
run a single program then exit, this makes using Retro very
useful on Unix (or Linux, Haiku, or other POSIX-ish systems).

# Configuration

Atua needs to know:

- the path to the files to serve
- the name of the index file
- The maximum length of a selector

~~~
'/home/crc/atua 'PATH          s:const
'/gophermap     'DEFAULT-INDEX s:const
#1024           'MAX-SELECTOR-LENGTH const
~~~

# I/O Words

Retro only supports basic output by default. The RRE interface
that Atua uses adds support for files and stdin, so we map these
to words and provide some other helpers.

## Console Output

The Gopher protocol uses tabs and cr/lf for signficant things.
To aid in this, I define output words for tabs and end of line.

~~~
:eol  (-)  ASCII:CR c:put ASCII:LF c:put ;
~~~

## Console Input

Input lines end with a cr, lf, or tab. The `eol?` checks for
this. The `s:get` word could easily be made more generic in
terms of what it checks for. This suffices for a Gopher server
though.

~~~
:eol? (c-f)
  [ [ ASCII:CR eq? ]
    [ ASCII:LF eq? ]
    [ ASCII:SPACE eq? ] tri or or ]
  [ $? eq? ] bi or ;

:s:get (a-)
  buffer:set
  [ c:get dup buffer:add eol? not ] while ;
~~~

~~~
{{
~~~

First up are buffers for the selector string and the file buffer.
The variables and buffers are kept private.

~~~
'Selector d:create
  MAX-SELECTOR-LENGTH n:inc allot
:buffer here ;
~~~

Next up, variables to track information related to the requested
selector. Atua will construct filenames based on these.

~~~
'Requested-File var
'Requested-Index var
~~~

`FID`, the file id, tracks the open file handle that Atua uses
when reading in a file. The `Size` variable will hold the size of
the file (in bytes).

~~~
'FID var
'Size var
'Mode var
~~~

I use a `Server-Info` variable to decide whether or not to display
the index footer. This will become a configurable option in the
future.

~~~
'Server-Info var
~~~

These are just simple accessor words to aid in overall readability.

~~~
:requested-file  (-s)  @Requested-File  ;
:requested-index (-s)  @Requested-Index ;
~~~

~~~
:get-mime-type (s-s)
  [ $. s:index/char ] sip +
  (textual_files)
    '.md    [ 'text/markdown            ] s:case
    '.htm   [ 'text/html                ] s:case
    '.html  [ 'text/html                ] s:case
    '.retro.html [ 'text/html           ] s:case
    '.muri.html  [ 'text/html           ] s:case
    '.forth.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
  drop 'text/plain ;
~~~

~~~
:with-path (-s)
  PATH &Selector s:chop s:append ;

:construct-filenames (-)
  with-path s:keep !Requested-File
  with-path '/gophermap s:append s:keep !Requested-Index
;
~~~

A *gophermap* is a file that makes it easier to handle Gopher menus.
Atua's gophermap support covers:

- comment lines

  Comment lines are static text without any tabs. They will be
  reformatted according to protocol and sent.

- selector lines

  Any line with a tab is treated as a selector line and is transferred
  without changing.

~~~
'Tab var
:eol? [ ASCII:LF eq? ] [ ASCII:CR eq? ] bi or ;
:tab? @Tab ;
:check-tab
  dup ASCII:HT eq? [ &Tab v:on ] if ;
:gopher:s:get (a-)
  &Tab v:off
  buffer:set
  [ @FID file:read dup buffer:add check-tab eol? not ] while
  buffer:get drop
;
~~~

The internal helpers are now defined, so switch to the part of the
namespace that'll be left exposed to the world.

~~~
---reveal---
~~~

An information line s:get a format like:

  i...text...<tab><tab>null.host<tab>port<cr,lf>

The `gopher:i` displays a string in this format. It's used later for
the index footer.

~~~
:gopher:i (s-)
  s:put eol ;
~~~

The `gopher:icon` displays an indicator for menu items.

~~~
:gopher:icon
  $0 [ '_TXT__ s:put ] case
  $1 [ '[DIR]_ s:put ] case
  $2 [ '_CSO__ s:put ] case
  $3 [ '_ERR__ s:put ] case
  $4 [ '_BIN__ s:put ] case
  $5 [ '_BIN__ s:put ] case
  $6 [ '_UUE__ s:put ] case
  $7 [ '[FND]_ s:put ] case
  $8 [ '_TEL__ s:put ] case
  $9 [ '_BIN__ s:put ] case
  $I [ '_IMG__ s:put ] case
  $S [ '_AUD__ s:put ] case
  $g [ '_GIF__ s:put ] case
  $h [ '_HTM__ s:put ] case
  drop '_???__ s:put
;
~~~

~~~
:gopher:get-selector (-)
  &Selector s:get &Selector s:get ;

(Rewrite_This:_It's_too_big)
:gopher:file-for-request (-s)
  &Mode v:off
  construct-filenames
  &Selector s:chop s:length n:-zero?
  [ requested-file file:exists?
    [ requested-file file:R file:open file:size n:strictly-positive? ] [ FALSE ] choose
    [ requested-file ]
    [ requested-index file:exists?
      [ requested-index &Server-Info v:on  ]
      [ PATH '/empty.index.html s:append ] choose
    ] choose
  ]
  [ PATH DEFAULT-INDEX s:append &Server-Info v:on ] choose
;

:gopher:read-file (f-)
  file:R file:open !FID
  @FID file:size !Size
  @Size [ @FID file:read c:put ] times
  @FID file:close
;
~~~

~~~
:link
  dup fetch $h eq? push
  dup fetch gopher:icon n:inc
  [ ASCII:HT [ #0 ] case ] s:map
  dup s:length over + n:inc
  pop [ #4 + ] if
  '<a_href="%s">%s</a> s:format s:put ;

:gopher:generate-index (f-)
  'Content-type:_text/html s:put eol eol
  '<!DOCTYPE_HTML_PUBLIC_"-//W3C//DTD_HTML_4.01//EN" s:put sp
  '"http://www.w3.org/TR/html4/strict.dtd"> s:put eol
  { '<html><head>
    '<meta_http-equiv="Content-Type"_content="text/html;_charset=utf-8">
    '<link_href=data:,_rel=icon>
    '<style_type="text/css">p_{_font-family:_monospace;_white-space:_pre;_}
    '_*_{_color:_#bbb;_background:_#090909;_font-size:_large;_}
    'a_{_color:_#FF6600;_}
    '</style><title>forthworks.com</title></head>
  } [ s:put eol ] a:for-each
  '<body><p> s:put
  file:R file:open !FID
  @FID file:size !Size
  [ buffer gopher:s:get
    buffer tab? [ link eol ] [ gopher:i ] choose
    @FID file:tell @Size lt? ] while
  @FID file:close
  '</p></body></html> s:put
;
~~~

In a prior version of this I used `s:put` to send the content. That
stopped at the first zero value, which kept it from working with
binary data. I added `gopher:send` to send the `Size` number of
bytes to stdout, fixing this issue.

~~~
:gopher:send (p-)
  requested-file get-mime-type 'Content-type:_ s:put s:put eol eol ;
~~~

The only thing left is the top level server.

~~~
:gopher:server
  gopher:get-selector
  'HTTP/1.0_200_OK s:put eol
  gopher:file-for-request
  @Server-Info
  [ gopher:generate-index ]
  [ gopher:send gopher:read-file ] choose
;
~~~

Close off the helper portion of the namespace.

~~~
}}
~~~

And run the `gopher:server`.

~~~
gopher:server
reset
~~~