mata_bot

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

commit 3d896652c9fe14bb83f6731110257ea690d9b733
parent 86570063ad83611f48faed399981abc0281313cc
Author: noodle <noodle@pastanoggin.com>
Date:   Wed, 25 Jun 2025 05:58:24 +0300

Merge branch 'fix_noreconnect'

Diffstat:
Mmata_bot.pl | 426+++++++++++++++++++++++++++++++++++++++++++++++--------------------------------
Mmatabot.8 | 5-----
2 files changed, 253 insertions(+), 178 deletions(-)

diff --git a/mata_bot.pl b/mata_bot.pl @@ -3,88 +3,47 @@ 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 = "/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 = '[>.<]'; +my $MATA_DEAD = '[x~x]'; +my $MATA_FLIPOFF = 't[-_-t]'; +my $MATA_HAPPY = '[^_^]'; +my $MATA_NORM = '[._.]'; +my $MATA_SING = '[^=^]'; +my $MOTHER = 'noodle'; my $NICK = 'mata_bot'; my $NICK_RE = qr/mata_?bo[ity]+/i; -my $USER = 'mata_bot_beta4'; my $REAL = 'death to technomage!!'; -my $MOTHER = 'noodle'; -my $MATA_NORM = '[._.]'; -my $MATA_HAPPY = '[^_^]'; -my $MATA_SING = '[^=^]'; -my $MATA_DEAD = '[x~x]'; -my $MATA_CUTE = '[>.<]'; -my $MATA_FLIPOFF = 't[-_-t]'; - -my $ball_path = "$SHAREDIR/matabot/ball"; -my $quotes_path = "$SHAREDIR/matabot/quotes"; -my $hellos_path = "$SHAREDIR/matabot/hellos"; -my $chan = '#testmatabot'; -my $host = 'localhost'; -my $logging = 0; -my $port = '6667'; -my $tls = 0; -my %subbuffer; - -# process args -getopts('tlH:b:h:j:p:q:', \my %opts); -$ball_path = $opts{'b'} if ($opts{'b'}); -$chan = "#$opts{'j'}" if ($opts{'j'}); -$hellos_path = $opts{'H'} if ($opts{'H'}); -$host = $opts{'h'} if ($opts{'h'}); -$logging = 1 if ($opts{'l'}); -$port = $opts{'p'} if ($opts{'p'}); -$quotes_path = $opts{'q'} if ($opts{'q'}); -$tls = 1 if ($opts{'t'}); - -# read in the quotes file; -open (my $quotes_file, "<", $quotes_path) or die "couldn't open ${quotes_path}: $!"; -chomp(my @quotes = <$quotes_file>); -my $quotes_num = $.; -close $quotes_file or die "$quotes_file: $!"; - -# read in the 8ball file -open (my $ball_file, "<", $ball_path) or die "couldn't open ${ball_path}: $!"; -chomp(my @ball = <$ball_file>); -my $ball_num = $.; -close $ball_file or die "$ball_file: $!"; - -# read in the hellos file -open (my $hellos_file, "<", $hellos_path) or die "couldn't open ${hellos_path}: $!"; -chomp(my @hellos = <$hellos_file>); -my $hellos_num = $.; -close $hellos_file or die "$hellos_file: $!"; +my $USER = 'mata_bot_beta4'; sub randint { my($min, $max) = @_; return $min if $min == $max; - ($min, $max) = ($max, $min) if $min > $max; + ($min, $max) = ($max, $min) if $min > $max; return $min + int rand(1 + $max - $min); } -sub logger { - my $logmessage = shift; - print strftime('%Y-%m-%dT%H:%M:%SZ ', gmtime()), $logmessage, "\n"; -} - -sub out { - my ($sock, $message) = @_; - logger($message) if ($logging); - print $sock "$message\r\n"; -} - -sub msg { - my ($sock, $message) = @_; - out($sock, "PRIVMSG $chan :$message"); -} - sub respond_command { - my ($sock, $sender_nick, $content) = @_; + my ($ball, $hellos, $sender_nick, $content) = @_; + my $reply; if ($content =~ /\b{wb}([1-9]\d*)?d([1-9]\d*)\b{wb}/) { # we got dice my $ndice = $1 // 1; @@ -94,37 +53,37 @@ sub respond_command { my $result = $min + int rand(1 + $max - $min); my $roll = "d${nface}"; $roll = $ndice . $roll if $ndice > 1; - msg($sock, "${sender_nick} rolled a ${roll} and got ${result}! ${MATA_HAPPY}"); + $reply = "${sender_nick} rolled a ${roll} and got ${result}! ${MATA_HAPPY}"; } elsif ($content =~ /\b{wb}pray+\b{wb}/) { - msg($sock, "Stay prayed up!! ${MATA_CUTE}"); + $reply = "Stay prayed up!! ${MATA_CUTE}"; } elsif ($content =~ /\b{wb}bru[hv]+\b{wb}/i) { - msg($sock, "Did i stutter? ${MATA_NORM}"); + $reply = "Did i stutter? ${MATA_NORM}"; } elsif ($content =~ /\b{wb}f+(u?ck+)? *(yo)?u+\b{wb}/i) { - msg($sock, "$MATA_FLIPOFF"); + $reply = "$MATA_FLIPOFF" } elsif ($content =~ /\b{wb}i+ *l+(ove+)? *(you+|y+|u+)\b{wb}/i) { - msg($sock, "<3 ${MATA_HAPPY}"); + $reply = "<3 ${MATA_HAPPY}" } elsif ($content =~ /(thanks+|thx+|thank +(yo)?u+)( *a+ *lot+)?/i) { - msg($sock, "You're welcome, ${sender_nick}! ${MATA_HAPPY}"); + $reply = "You're welcome, ${sender_nick}! ${MATA_HAPPY}" } elsif ($content =~ /who('| +i|)s+ +(a|the)+ +goo+d+ +(bo+[ity]+o*|gir(l+|lie+))/i) { - msg($sock, "Me! ${MATA_CUTE}"); + $reply = "Me! ${MATA_CUTE}" } elsif ($content =~ / h(ow+)?\s*(are+|r+)\s*(you+|yo+|u+)(\s+doing+)?(\s+today+)?| how('|\si|)s+\s+(it+\s+going+|life+|everything+) /ix) { - msg($sock, "I feel fantaaaastic... hey, hey, hey! ${MATA_SING}"); + $reply = "I feel fantaaaastic... hey, hey, hey! ${MATA_SING}" } elsif ($content =~ /\b{wb}( what('|\si|)s+\s*(up+|happening+|cracking+)| (was)?sup+ )\b{wb}/ix) { - msg($sock, "Looking for technomage, and you? ${MATA_NORM}"); + $reply = "Looking for technomage, and you? ${MATA_NORM}" } elsif ($content =~ /\b{wb}( goo+d+\s*(bo+[ity]+o*|gir(l+|lie+))| w(elcome+)?\s*(b+|back+) )\b{wb}/ix) { if ($sender_nick eq $MOTHER) { - msg($sock, "Thank you, mother! ${MATA_HAPPY}"); + $reply = "Thank you, mother! ${MATA_HAPPY}" } else { - msg($sock, "Thanks, ${sender_nick}! ${MATA_HAPPY}"); + $reply = "Thanks, ${sender_nick}! ${MATA_HAPPY}" } } elsif ($content =~ /\b{wb}( (al+-?)?sala+m+u*\s+alaikum+u*| @@ -139,34 +98,38 @@ sub respond_command { well+\s+met+| yo+ )\b{wb}/ix) { - msg($sock, "$hellos[int rand($hellos_num)], ${sender_nick}! ${MATA_HAPPY}"); + $reply = "$hellos->[rand @$hellos], ${sender_nick}! ${MATA_HAPPY}" } elsif ($content =~ /\?$/) { # we got a question - msg($sock, "$ball[int rand($ball_num)] ${MATA_CUTE}"); + $reply = "$ball->[rand @$ball] ${MATA_CUTE}" } elsif ($sender_nick eq $MOTHER) { - msg($sock, "Done, mother! ${MATA_HAPPY}"); + $reply = "Done, mother! ${MATA_HAPPY}" } else { - msg($sock, "\1ACTION leans over and places it's hand near it's antenna. \"HUUH?\" ${MATA_NORM}\1"); + $reply = " ${MATA_NORM}\1" } + return $reply; } sub respond_mention { - my ($sock, $sender_nick, $message) = @_; + my ($quotes, $sender_nick, $message) = @_; + my $reply; if ($sender_nick eq $MOTHER) { - msg($sock, "Yes, mother? ${MATA_HAPPY}"); + $reply = "Yes, mother? ${MATA_HAPPY}"; } elsif ($message =~ /^\b${NICK_RE}\b$/) { - msg($sock, "${MATA_NORM} ?"); + $reply = "${MATA_NORM} ?"; } else { - msg($sock, "$quotes[int rand($quotes_num)] ${MATA_NORM}"); + $reply = "$quotes->[rand @$quotes] ${MATA_NORM}"; } + return $reply; } # respond to channel -# returns 1 if bot shouldn't remember last message for s///, 0 otherwise sub respond { - my ($sock, $sender_nick, $message) = @_; - if ($subbuffer{$sender_nick} && $message =~ m,\b{wb}s/([^/]+)/([^/]*)(?:/([gi]*))?,) { + my ($lists, $subbuffer, $sender_nick, $message) = @_; + my $reply; + if ($subbuffer->{$sender_nick} && $message =~ m,\b{wb}s/([^/]+)/([^/]*)(?:/([gi]*))?,) { # chat s/// + my $prev_message = $subbuffer->{$sender_nick}; my $retext = $1; my $repl = $2; my $mods = $3 // ''; @@ -175,153 +138,270 @@ sub respond { eval { $regex = qr/(?$imod:$retext)/ }; - return 1 if $@; + return $prev_message, '' if $@; my $ismatch; if ($mods =~ /g/) { - $ismatch = $subbuffer{$sender_nick} =~ s/$regex/$repl/g; + $ismatch = $prev_message =~ s/$regex/$repl/g; } else { - $ismatch = $subbuffer{$sender_nick} =~ s/$regex/$repl/; + $ismatch = $prev_message =~ s/$regex/$repl/; } if ($ismatch) { - msg($sock, "${sender_nick} meant to say: $subbuffer{$sender_nick}"); + $reply = "${sender_nick} meant to say: ${prev_message}" } - return 1; + return $prev_message, $reply; } elsif ($message =~ m,watch\?v=([a-zA-Z0-9_-]+),) { # post youtube video titles from video ID my $video_id = $1; my $response = HTTP::Tiny->new->get("https://fuyt.lab8.cz/?s=${video_id}&o=relevance"); unless ($response->{success}) { - msg($sock, "failed to get title of video ${video_id} ${MATA_DEAD} ($response->{status} $response->{reason}!)"); - return 0; + $reply = "failed to get title of video ${video_id} ${MATA_DEAD} ($response->{status} $response->{reason}!)"; + return $message, $reply; } unless (length $response->{content}) { - msg($sock, "failed to get title of youtube video ${video_id} ${MATA_DEAD} (HTTP response empty!)"); - return 0; + $reply = "failed to get title of youtube video ${video_id} ${MATA_DEAD} (HTTP response empty!)"; + return $message, $reply; } my $content = $response->{content}; if ($content =~ m,<span class="title"><a href="https://www\.youtube\.com/watch\?v=$video_id" accesskey="0">([^<]+)</a>,i) { my $title = $1; $title =~ tr/[\000\r\n]//d; $title = trim($title); - msg($sock, "YouTube: $title"); + $reply = "YouTube: $title"; } else { - msg($sock, "failed to get title of video ${video_id} ${MATA_DEAD} (no videos matching ID $video_id!)"); + $reply = "failed to get title of video ${video_id} ${MATA_DEAD} (no videos matching ID $video_id!)"; } } elsif ($message =~ m,https?://[^ ]+,) { my $url = $&; # get in it's HEAD to check if it's text/html my $response = HTTP::Tiny->new->head($url); unless ($response->{success}) { - msg($sock, "$response->{status} $response->{reason} (HEAD ${url}) ${MATA_DEAD} "); - return 0; + $reply = "$response->{status} $response->{reason} (HEAD ${url}) ${MATA_DEAD}"; + return $message, $reply; } unless ($response->{headers}->{'content-type'}) { - msg($sock, "no content-type header in HTTP response (HEAD ${url}) ${MATA_DEAD}"); - return 0; + $reply = "no content-type header in HTTP response (HEAD ${url}) ${MATA_DEAD}"; + return $message, $reply; } unless ($response->{headers}->{'content-type'} =~ m,text/html,) { # we got a non text/html content type - msg($sock, "File: $response->{headers}->{'content-type'}"); - return 0; + $reply = "File: $response->{headers}->{'content-type'}"; + return $message, $reply; } # if it's text/html, GET it's title $response = HTTP::Tiny->new->get($url); unless ($response->{success}) { - msg($sock, "$response->{status} $response->{reason} (GET ${url}) ${MATA_DEAD}"); - return 0; + $reply = "$response->{status} $response->{reason} (GET ${url}) ${MATA_DEAD}"; + return $message, $reply; } unless (length $response->{content}) { - msg($sock, "Empty HTTP response (GET ${url}) ${MATA_DEAD}"); - return 0; + $reply = "Empty HTTP response (GET ${url}) ${MATA_DEAD}"; + return $message, $reply; } my $content = $response->{content}; if ($content =~ m,<title[^>]*>([^<]+)</title[^>]*>,i) { my $title = $1; $title =~ tr/[\000\r\n]//d; $title = trim($title); - msg($sock, "Title: $title"); + $reply = "Title: $title"; } else { - msg($sock, "No title found (GET ${url} ${MATA_DEAD}"); + $reply = "No title found (GET ${url} ${MATA_DEAD}"; } # TODO: this part should use [^ ] and .* instead but i'm scared of .* } elsif ($message =~ /^ *${NICK_RE}[:, ] *([^\000\r\n ][^\000\r\n]*)$/ or $message =~ /^ *([^\000\r\n ][^\000\r\n]*)[, ] *${NICK_RE}\W*$/) { - respond_command($sock, $sender_nick, $1); + $reply = respond_command($lists->{'ball'}, $lists->{'hellos'}, $sender_nick, $1); } elsif ($message =~ /\b${NICK_RE}\b/) { - respond_mention($sock, $sender_nick, $message); + $reply = respond_mention($lists->{'quotes'}, $sender_nick, $message); } - return 0; + return $message, $reply; } -# start the connection -my $sock; -if ($tls) { - $sock = IO::Socket::SSL->new( - Domain => AF_INET, - Type => SOCK_STREAM, - PeerHost => $host, - PeerPort => $port, - ) || die "Can't open socket: $IO::Socket::errstr"; -} else { - $sock = IO::Socket->new( - Domain => AF_INET, - Type => SOCK_STREAM, - proto => 'tcp', - PeerHost => $host, - PeerPort => $port, - ) || die "Can't open socket: $IO::Socket::errstr"; +sub logger { + my $logmessage = shift; + print strftime('%Y-%m-%dT%H:%M:%SZ ', gmtime()), $logmessage, "\n"; } -# set user, real, and nick, then join -out($sock, "USER $USER * * :$REAL"); -out($sock, "NICK $NICK"); -out($sock, "JOIN $chan"); - -# evasdrop -my $buffer = ''; -my $chunk = ''; -my $message = ''; -while (1) { - # buffer up - if ($tls) { - $chunk = <$sock>; +sub out { + my ($sock, $logging, $message) = @_; + 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 { - $sock->recv($chunk, $CHUNK_LENGTH); + if ($!) { logger("!! $!") if $logging; return; } + return 0; } - $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; +} + +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; + $! = 0; + if ($s->can_read($SOCK_TIMEOUT)) { + # buffer up + if ($opts->{'tls'}) { + $chunk = <$sock>; + } else { + $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 we have no text after framing, clear buffer - $buffer = ''; + if ($!) { logger("!! ${!}") if $opts->{'logging'}; return; } + } + + # 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 } - } else { - # if there's no framing. append chunk to end of buffer and keep reading - $buffer .= $chunk; - next; } +} - # log message - logger($message) if ($logging); +sub init { + my $ball_path = $DEFAULT_PATH_BALL; + my $chan = $DEFAULT_CHAN; + my $hellos_path = $DEFAULT_PATH_HELLOS; + my $host = $DEFAULT_HOST; + my $logging = $DEFAULT_LOGGING; + my $port = $DEFAULT_PORT; + my $quotes_path = $DEFAULT_PATH_QUOTES; + my $tls = $DEFAULT_TLS; + + getopts('tlH:b:h:j:p:q:', \my %flags); + $ball_path = $flags{'b'} if $flags{'b'}; + $chan = "#$flags{'j'}" if $flags{'j'}; + $hellos_path = $flags{'H'} if $flags{'H'}; + $host = $flags{'h'} if $flags{'h'}; + $logging = 1 if $flags{'l'}; + $port = $flags{'p'} if $flags{'p'}; + $quotes_path = $flags{'q'} if $flags{'q'}; + $tls = 1 if $flags{'t'}; + open (my $ball_file, "<", $ball_path) or die "couldn't open ${ball_path}: $!"; + chomp(my @ball = <$ball_file>); + close $ball_file or die "$ball_file: $!"; + open (my $hellos_file, "<", $hellos_path) or die "couldn't open ${hellos_path}: $!"; + chomp(my @hellos = <$hellos_file>); + close $hellos_file or die "$hellos_file: $!"; + open (my $quotes_file, "<", $quotes_path) or die "couldn't open ${quotes_path}: $!"; + chomp(my @quotes = <$quotes_file>); + close $quotes_file or die "$quotes_file: $!"; + + return { + 'chan' => $chan, + 'host' => $host, + 'logging' => $logging, + 'port' => $port, + 'tls' => $tls, + }, + { + 'ball' => \@ball, + 'hellos' => \@hellos, + 'quotes' => \@quotes, + }; +} - # respond to message - if ($message =~ /^PING :([^\000\r\n\ ]+)$/) { - # if we got a ping, pong back - out($sock, "PONG :$1"); - } elsif ($message =~ /^:([^\000\r\n\#\&\ ][^\000\r\n\ ]*)![^\000\r\n\ ]+@[^\000\r\n\ ]+ PRIVMSG ${chan} :([^\000\r\n]*)$/) { - # if we got a message to our chan. read and act accordingly - my $sender_nick = $1; - my $sender_message = $2; - unless (respond($sock, $sender_nick, $sender_message)) { - $subbuffer{$sender_nick} = $sender_message; +my ($opts, $lists) = init(); +while (1) { + # start the connection + my $sock; + if ($opts->{'tls'}) { + if (not $sock = IO::Socket::SSL->new( + Domain => AF_INET, + Timeout => $CONNECT_TIMEOUT, + Type => SOCK_STREAM, + PeerHost => $opts->{'host'}, + PeerPort => $opts->{'port'}, + )) { + logger("!! can't open socket: $IO::Socket::errstr") if $opts->{'logging'}; + $sock = undef; + } + } else { + if (not $sock = IO::Socket->new( + Domain => AF_INET, + Timeout => $CONNECT_TIMEOUT, + Type => SOCK_STREAM, + proto => $opts->{'tcp'}, + PeerHost => $opts->{'host'}, + PeerPort => $opts->{'port'}, + )) { + 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(); } } + 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.