This is a little IRC bot written in RETRO. Currently it's being
used for testing the socket: words. In the near future, it'll
also be used for logging and interactive tests. Longer term,
a future version will be used as part of my Para order and bid
management system, for interactive lookups and updates.
Consider this to be public domain, or use under the ISC license
if your country does not recognize the public domain.
Todo:
• support direct messages
In Process:
• logging of channel
- append to log working
- need to add timestamps
- need to only log things we care about:
- join part quit privmsg
- tools to generate more readable output from the
raw logs
Done:
• add a configuration section
• connect to IRC server
• join a channel
• handle PING
• process messages
• run retro code in a separate vm/image
- image persists across runs
- stacks reset each run
• support multiple channels
• wrappers over socket: words
• retro-describe: queries
Possible future additions:
• per-user images for the retro-via-pipe
Configuration
I'm connecting to one of the plaintext ports on Libera. I have
the server IP hard coded here, but the socket words do work with
domain names.
~~~'/home/crc/retro-irc.image 'IMAGE s:const
'retro-sandboxed 'VM s:const
'51.161.82.214:6665 'SERVER s:const
'retroforth-bot 'NICK s:const
{ '#retro '#forth '#retrotesting } 'CHANNELS const
~~~
These words allow me to capture output into a buffer, which
I can send out via the socket words. It's best if you use
these in a buffer:preserve block.
~~~'Output d:create
#32768 allot
:capture{ &Output buffer:set &buffer:add &c:put set-hook ;
:}output &c:put unhook ;
~~~
This is a higher level set of words for interacting with a
single socket.
~~~'Sock var
:connect (s-)
socket:create !Sock
$: s:split/char swap n:inc socket:configure
@Sock socket:connect drop ;
:s:transmit @Sock socket:send drop-pair ;
{{
:eol?
[ ASCII:CR eq? ] [ ASCII:LF eq? ] bi or ;
:terminate
buffer:get drop #0 buffer:add ;
---reveal---
:s:receive
[ here buffer:set
s:empty dup #256 @Sock socket:recv drop-pair
[ dup buffer:add eol? [ terminate ] if ] s:for-each ] buffer:preserve ;
}}
:disconnect
@Sock socket:close ;
~~~
Create a socket and connect to the IRC network. I'm using
Libera on a plain text port.
~~~SERVER connect
~~~
Next, some helpers. One to send a line of text to the server and
one to read a line from the server.
~~~:irc:send
'%s\r\n s:format s:transmit ;
~~~
Log into the desired channel. Adjust your user name, nick, and
the channel(s) here.
~~~:login 'USER_retrobot_crc@forth.works_forth.works_charles irc:send
NICK 'NICK_%s s:format irc:send
CHANNELS [ 'JOIN_%s s:format irc:send ] a:for-each ;
login
~~~
The server will send a PING periodically to see if we are still
active. Send the correct PONG message back in reply.
~~~:ping?
here 'PING s:begins-with? ;
:pong
'PONG here #4 + s:append irc:send ;
~~~
Messages in the channel contain PRIVMSG. Here is where I
process them. If the actual message starts with retro:,
I pass it to s:evaluate, capturing and relaying the output.
~~~'Channel d:create
#128 allot
:message?
here 'PRIVMSG s:contains/string? ;
:channel
here 'PRIVMSG s:split/string drop #8 + $: s:split/char nip s:chop &Channel s:copy ;
:transmit
'PRIVMSG_ s:transmit
&Channel s:transmit
'_: s:transmit
&Output s:transmit
'\r\n s:format s:transmit ;
:export (ss-
[ '~~~\n%s\n;\n~~~ s:format ] dip file:spew ;
:run (s-s)
[ dup IMAGE VM '%s_-u_%s_-f_%s_>%s.out s:format unix:system ] sip ;
:send-results
[ '.out s:append [ &Output s:copy transmit ] file:for-each-line ] sip ;
:cleanup
dup '.out s:append [ file:delete ] bi@ ;
:sandbox
#7 + n:random '/tmp/retro-%n s:format
[ export ] sip run send-results cleanup ;
:process (s-
channel sandbox ;
:run-code
dup 'retro:_ s:begins-with? [ process s:empty ] if ;
:pipe> (s-s) dup s:put nl file:R unix:popen [ file:read-line ] [ unix:pclose ] bi ;
:process
channel #16 + 'retro-describe_"%s"_|_curl_-F_'sprunge=<-'_http://sprunge.us
s:format pipe> &Output s:copy transmit ;
:document
dup 'retro-describe:_ s:begins-with? [ process s:empty ] if ;
:command
run-code document drop dump-stack nl ;
:process
here 'PRIVMSG s:split/string drop $: s:split/char drop n:inc dup s:put nl
command ;
~~~
~~~:log
here s:put nl
'irc.log file:A file:open here
[ over file:write ] s:for-each ASCII:LF over file:write file:close ;
~~~
Run the main loop to read and send messages.
~~~[ repeat
s:receive log
message? [ process ] if
ping? [ pong ] if
again ] call
~~~
Clean up before exiting. Normally we won't reach this point as the
above loop is endless.
~~~disconnect
~~~