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:
| M | mata_bot.pl | | | 166 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++------------------------- |
| M | matabot.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.
