mata_bot

some cheeky bot for #unix_surrealism
git clone https://git.pastanoggin.com/mata_bot.git
Log | Files | Refs | README | LICENSE

commit 283be9bcdbad1a84d7467f6db1713f09aae8ef84
parent f4d13731461ca8fb7e2f947c3b3ad725ae8ca8fd
Author: noodle <noodle@pastanoggin.com>
Date:   Wed, 25 Jun 2025 05:46:49 +0300

implement reconnection

bot now reconnects after a cooldown on socket creation error, falsy
return value of recv, or server not responding with PONG after a set
amount of time from a PING (sent after a set amount of time too).

thanks #perl for showing me the recv() -> 0/undef trick :3

Diffstat:
Mmata_bot.pl | 166++++++++++++++++++++++++++++++++++++++++++++++++++++++-------------------------
Mmatabot.8 | 5-----
2 files changed, 113 insertions(+), 58 deletions(-)

diff --git a/mata_bot.pl b/mata_bot.pl @@ -3,18 +3,23 @@ use v5.40; use Getopt::Std; use HTTP::Tiny; +use IO::Select; use IO::Socket qw(AF_INET SOCK_STREAM); use IO::Socket::SSL; use POSIX qw(strftime); -my $SHAREDIR = '/usr/local/share'; my $CHUNK_LENGTH = 1024; +my $CONNECT_TIMEOUT = 60; +my $RECONNECT_TIME = 60; +my $SOCK_TIMEOUT = 10; +my $PING_TIMEOUT = 120; +my $PONG_TIMEOUT = 60; my $DEFAULT_CHAN = '#testmatabot'; my $DEFAULT_HOST = 'localhost'; my $DEFAULT_LOGGING = 0; -my $DEFAULT_PATH_BALL = "$SHAREDIR/matabot/ball"; -my $DEFAULT_PATH_HELLOS = "$SHAREDIR/matabot/hellos"; -my $DEFAULT_PATH_QUOTES = "$SHAREDIR/matabot/quotes"; +my $DEFAULT_PATH_BALL = "/usr/local/share/matabot/ball"; +my $DEFAULT_PATH_HELLOS = "/usr/local/share/matabot/hellos"; +my $DEFAULT_PATH_QUOTES = "/usr/local/share/matabot/quotes"; my $DEFAULT_PORT = 6667; my $DEFAULT_TLS = 0; my $MATA_CUTE = '[>.<]'; @@ -219,59 +224,95 @@ sub logger { sub out { my ($sock, $logging, $message) = @_; - logger($message) if $logging; - print $sock "$message\r\n"; + my $s = IO::Select->new($sock); + $! = 0; + if ($s->can_write($SOCK_TIMEOUT)) { + print $sock "$message\r\n"; + logger('<- ' . $message) if $logging; + return 1; + } else { + if ($!) { logger("!! $!") if $logging; return; } + return 0; + } } sub evasdrop { my ($sock, $opts, $lists, $subbuffer) = @_; my $buffer = ''; + my $checkping = 1; my $chunk = ''; my $message = ''; + my $pingtime = time; + my $pongtime = time; + my $s = IO::Select->new($sock); my %subbuffer; while (1) { my $reply; - # buffer up - if ($opts->{'tls'}) { - $chunk = <$sock>; - } else { - $sock->recv($chunk, $CHUNK_LENGTH); - } - $chunk =~ /^([^\r\n]+)(\r\n)?([^\r\n]+)?$/; - # keep reading if chunk is empty - next if (not $1); - # if chunks isn't empty, check for framing point - if ($2) { - # if we found a framing point, flush buffer and text till framing point - $message = $buffer . $1; - if ($3) { - # if we have text after framing, make it the new content of buffer - $buffer = $3; + $! = 0; + if ($s->can_read($SOCK_TIMEOUT)) { + # buffer up + if ($opts->{'tls'}) { + $chunk = <$sock>; } else { - # if we have no text after framing, clear buffer - $buffer = ''; + $sock->recv($chunk, $CHUNK_LENGTH); } + if (not $chunk) { + logger("!! recv received an empty response"); + return; + } + return if not $chunk; + $chunk =~ /^([^\r\n]+)(\r\n)?([^\r\n]+)?$/; + # keep reading if chunk is empty + next if (not $1); + # if chunks isn't empty, check for framing point + if ($2) { + # if we found a framing point, flush buffer and text till framing point + $message = $buffer . $1; + if ($3) { + # if we have text after framing, make it the new content of buffer + $buffer = $3; + } else { + # if we have no text after framing, clear buffer + $buffer = ''; + } + } else { + # if there's no framing. append chunk to end of buffer and keep reading + $buffer .= $chunk; + next; + } + logger('-> ' . $message) if ($opts->{'logging'}); + + # respond to message + if ($message =~ /^PING :([^\000\r\n\ ]+)$/) { + # if we got a ping, pong back + $reply = "PONG :$1"; + } elsif ($message =~ /^:[^\000\r\n ]+ PONG/) { + # if server ponged us back, reset ping-pong and allow pinging again + $pingtime = time; + $pongtime = time; + $checkping = 1; + } elsif ($message =~ /^:([^\000\r\n\#\&\ ][^\000\r\n\ ]*)![^\000\r\n\ ]+@[^\000\r\n\ ]+ PRIVMSG $opts->{'chan'} :([^\000\r\n]*)$/) { + # if we got a message to our chan. read and act accordingly + my $sender_nick = $1; + my $sender_message = $2; + ($subbuffer->{$sender_nick}, $reply) = respond($lists, $subbuffer, $sender_nick, $sender_message); + $reply = "PRIVMSG $opts->{'chan'} :" . $reply if $reply; + } + out($sock, $opts->{'logging'}, $reply) if $reply; } else { - # if there's no framing. append chunk to end of buffer and keep reading - $buffer .= $chunk; - next; + if ($!) { logger("!! ${!}") if $opts->{'logging'}; return; } } - # log message - logger($message) if ($opts->{'logging'}); - - # respond to message - if ($message =~ /^PING :([^\000\r\n\ ]+)$/) { - # if we got a ping, pong back - $reply = "PONG :$1"; - } elsif ($message =~ /^:([^\000\r\n\#\&\ ][^\000\r\n\ ]*)![^\000\r\n\ ]+@[^\000\r\n\ ]+ PRIVMSG $opts->{'chan'} :([^\000\r\n]*)$/) { - # if we got a message to our chan. read and act accordingly - my $sender_nick = $1; - my $sender_message = $2; - ($subbuffer->{$sender_nick}, $reply) = respond($lists, $subbuffer, $sender_nick, $sender_message); - next if not $reply; - $reply = "PRIVMSG $opts->{'chan'} :" . $reply; + + # ping-pong + if ($checkping and time-$pingtime >= $PING_TIMEOUT) { + # ping server every once in a while and wait for pong + out($sock, $opts->{'logging'}, "PING $opts->{'host'}"); + $checkping = 0; + } elsif (not $checkping and time-$pongtime >= $PONG_TIMEOUT) { + # we leaving if we don't get ponged on time + logger("!! PONG response from server timed out") if $opts->{'logging'}; + return } - out($sock, $opts->{'logging'}, $reply); } } @@ -318,30 +359,49 @@ sub init { }; } +my ($opts, $lists) = init(); while (1) { # start the connection - my ($opts, $lists) = init(); my $sock; if ($opts->{'tls'}) { - $sock = IO::Socket::SSL->new( + if (not $sock = IO::Socket::SSL->new( Domain => AF_INET, + Timeout => $CONNECT_TIMEOUT, Type => SOCK_STREAM, PeerHost => $opts->{'host'}, PeerPort => $opts->{'port'}, - ) || die "Can't open socket: $IO::Socket::errstr"; + )) { + logger("!! can't open socket: $IO::Socket::errstr") if $opts->{'logging'}; + $sock = undef; + } } else { - $sock = IO::Socket->new( + if (not $sock = IO::Socket->new( Domain => AF_INET, + Timeout => $CONNECT_TIMEOUT, Type => SOCK_STREAM, proto => $opts->{'tcp'}, PeerHost => $opts->{'host'}, PeerPort => $opts->{'port'}, - ) || die "Can't open socket: $IO::Socket::errstr"; + )) { + logger("!! can't open socket: $IO::Socket::errstr") if $opts->{'logging'}; + $sock = undef; + } + } + if ($sock) { + # set user, real, and nick, then join + out($sock, $opts->{'logging'}, "USER $USER * * :$REAL"); + out($sock, $opts->{'logging'}, "NICK $NICK"); + out($sock, $opts->{'logging'}, "JOIN $opts->{'chan'}"); + # main loop + evasdrop($sock, $opts, $lists); + # end session and sleep a bit before reconnecting + out($sock, $opts->{'logging'}, "QUIT"); + if ($opts->{'tls'}) { + close($sock); + } else { + $sock->close(); + } } - # set user, real, and nick, then join - out($sock, $opts->{'logging'}, "USER $USER * * :$REAL"); - out($sock, $opts->{'logging'}, "NICK $NICK"); - out($sock, $opts->{'logging'}, "JOIN $opts->{'chan'}"); - # main loop - evasdrop($sock, $opts, $lists); + logger("!! reconnecting in ${RECONNECT_TIME} seconds...") if $opts->{'logging'}; + sleep $RECONNECT_TIME; } diff --git a/matabot.8 b/matabot.8 @@ -174,10 +174,5 @@ Noodle (noodle) is the only person in chat who can give direct commands to mata_ (It's hard-coded. Sorry). .Sh BUGS -The bot doesn't have the ability te re-connect on network loss yet. -You can -.Sq rcctl restart matabot -for now. -.Pp The bot cannot detach from terminal yet to become a daemon. daemon-izing is handled in the rc service script.