#!/usr/bin/env retro
There are a number of Gopher via HTTP Proxies now. But none of
them are written in Forth, and I have a rather strong desire to
use tools I've written and understand fully, so I decided to
write my own.
7080 is my Gopher via HTTP Proxy. It's not done yet, but is
functional enough to be useful to me.
To use:
• replace all instances of HTTP-DOMAIN with the server URL.
• setup inetd to run this
• visit http://server.tld:port/gopher-url
E.g., for floodgap:
http://server.tld:port/gopher.floodgap.com/1/
~~~{ 'Server 'Port 'Selector 'Response 'Size } [ var ] a:for-each
'Requested d:create #1025 allot
'Host d:create #1025 allot
'Buffer d:create #500000 allot
~~~
A minimal HTTP/1.0 session will look like:
C: GET / HTTP/1.0
S: HTTP/1.0 200 OK
S: Content-Type: text/html
S: ... body ...
<disconnect>
There are a lot more things the client and server can send,
but this is all I need to care about for this proxy.
~~~{{
'Done var
:eot? (c-f)
{ ASCII:CR ASCII:LF ASCII:SPACE } a:contains? ;
:s:get (a-)
buffer:set [ c:get [ buffer:add ] [ eot? ] bi ] until
buffer:get drop ;
---reveal---
:read (-)
[ here s:get
here s:to-upper 'GET s:eq? [ &Requested s:get &Done v:inc ] if
@Done #1 eq? ] until ;
}}
~~~
The fetch is currently done with a pipe to curl. This is
reliable, but I'll probably redo this using raw sockets later
so I can remove the need for something other than RETRO.
~~~:net:fetch (san-n)
[ [ buffer:set
'curl_-s_%s s:format file:R unix:popen ] dip
[ dup file:read 0; buffer:add ] times unix:pclose
buffer:start s:length ] buffer:preserve ;
:http-prefix? (-f)
&Requested 'http:// s:begins-with? ;
:request (-)
http-prefix? [ &Requested #7 + ] [ &Requested n:inc ] choose
'gopher:// s:prepend
&Buffer FREE net:fetch &Buffer !Response !Size ;
~~~
Parsing the URL to the various internal variables is a matter
of splitting the string, saving the pieces, and storing the
pointers in the variables.
~~~:parse-url (s-)
$: s:split/char s:keep !Server
$/ s:split/char n:inc s:to-number !Port
s:keep !Selector ;
'Line var
:put
$< [ '< s:put ] case
$> [ '> s:put ] case
$& [ '& s:put ] case
c:put ;
:s:putm [ put ] s:for-each ;
:type
fetch-next ;
:port @Line #3 a:fetch ;
:server @Line #2 a:fetch ;
:selector @Line #1 a:fetch ;
:description @Line #0 a:fetch ;
~~~
The indicate word displays a short string of three characters
that provide a hint to the user about the content being linked.
~~~:indicate
$0 [ 'TXT_ s:put selector port server
'<a_href="HTTP-DOMAIN/%s:%s/0%s">%s</a> s:format s:put ] case
$1 [ 'DIR_ s:put selector port server
'<a_href="HTTP-DOMAIN/%s:%s/1%s">%s</a> s:format s:put ] case
$2 [ 'CSO_ s:put s:put ] case
$3 [ 'ERR_ s:put s:put ] case
$4 [ 'BHX_ s:put s:put ] case
$5 [ 'DOS_ s:put s:put ] case
$6 [ 'UUE_ s:put s:put ] case
$7 [ 'FND_ s:put s:put ] case
$8 [ 'TEL_ s:put s:put ] case
$9 [ 'BIN_ s:put s:put ] case
$h [ 'HTM_ s:put selector #4 +
'<a_href="%s">%s</a> s:format s:put ] case
$I [ 'IMG_ s:put s:put ] case
$g [ 'GIF_ s:put s:put ] case
$i [ '____ s:put s:put ] case
drop 'UNK_ s:put description s:put drop ;
~~~
~~~:tt
'<tt_style='white-space:_pre'> s:put
call
'</tt><br> s:put nl ;
:fields (s-a)
ASCII:HT s:tokenize dup !Line ;
:menu-entry
[ @Line #0 a:fetch type indicate ] tt ;
:plain-text
@Line [ '<tt> s:put s:put '</tt> s:put ] a:for-each nl ;
:line
dup ASCII:HT s:contains/char?
[ fields a:length #3 gteq? [ [ menu-entry ]
[ plain-text ] choose ] if;
[ s:putm ] tt ;
:css
'<style> s:put nl
'*_{_background:_black;_color:_silver;_} s:put nl
'a_{_color:_orange;_} s:put nl
'</style> s:put nl ;
:process:line
&Buffer ASCII:CR s:tokenize
[ s:trim line ] a:for-each ;
:process
&Buffer ASCII:HT s:contains/char? [ process:line ] if;
'<xmp> s:put &Buffer s:put '</xmp> s:put ;
:eol ASCII:CR c:put ASCII:LF c:put ;
:headers 'HTTP/1.1_200_OK s:put eol
'Content-Type:_text/html s:put eol eol ;
:7080 read request headers css process ;
7080
~~~
If you want to log the requests, this optional bit stores the
latest request in a file.
```&Requested '/home/crc/retro/proxy.log file:spew
```