06ee9705a8
s:contains-char? to s:contains/char? s:contains-string? to s:contains/string? a:contains-string? to a:contains/string? old names are now deprecated and will be removed after 2021.7. FossilOrigin-Name: 5a19d7aac514c5ba87963c5f0645f3daa8a8e3dc04546c0627fa046479ecd8dd
184 lines
4.3 KiB
Forth
Executable file
184 lines
4.3 KiB
Forth
Executable file
#!/usr/bin/env retro
|
|
|
|
# 7080: Gopher via HTTP
|
|
|
|
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
|
|
```
|