eleksir/meow-irc-bot
0
Fork 0
Code Activity

Initial version

Browse Source
This commit is contained in:
eleksir
2022-10-30 17:23:57 +03:00
commit 556540ddb2
16 changed files with 1881 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

170
lib/BotLib.pm Normal file
View File

@@ -0,0 +1,170 @@
package BotLib;
use 5.030; ## no critic (ProhibitImplicitImport)
use strict;
use warnings;
use utf8;
use open qw (:std :utf8);
use English qw ( -no_match_vars );
use JSON::XS ();
use Log::Any qw ($log);
use BotLib::Conf qw (LoadConf);
use BotLib::Command qw (Help Notify Todo Md5Str Sha1Str Sha224Str Sha256Str Sha384Str Sha512Str Crc32Str MurmurhashStr
B64Str UrlencodeStr IrandNum);
use BotLib::Util qw (runcmd);
use version; our $VERSION = qw (1.0);
use Exporter qw (import);
our @EXPORT_OK = qw (Command SigHandler SigIntHandler SigTermHandler SigQuitHandler);
local $OUTPUT_AUTOFLUSH = 1;
my $c = LoadConf ();
# Хэндлер, завершающий работу сервиса
# undef SigHandler($signal)
sub SigHandler {
my $signal = shift;
if (defined $MAIN::IRC) { ## no critic (Modules::RequireExplicitInclusion)
$log->info ('[INFO] Disconnect from server');
if (defined $signal) {
if ($signal eq 'exit') {
$MAIN::IRC->send_raw ('QUIT :Quit by user request'); ## no critic (Modules::RequireExplicitInclusion)
} else {
$MAIN::IRC->send_raw ("QUIT :Quit by signal $signal"); ## no critic (Modules::RequireExplicitInclusion)
}
} else {
$MAIN::IRC->send_raw ('QUIT :Quit with no reason'); ## no critic (Modules::RequireExplicitInclusion)
}
}
if (defined ($c->{pidfile}) && -e $c->{pidfile}) {
$log->info ("[INFO] Unlink $c->{pidfile}");
unlink $c->{pidfile};
}
if (defined $signal) {
if ($signal eq 'exit') {
$log->info ('[INFO] Exit by user command');
} else {
$log->info ("[INFO] Exit by signal $signal");
}
exit 0;
}
# We should never see this in logs
$log->info ('[INFO] Stay running because SigHandler called without signal name or reason');
return;
}
# Хэндлер SigINT
# undef SigIntHandler()
sub SigIntHandler { SigHandler ('INT'); return; }
# Хэндлер SigTERM
# undef SigTermHandler()
sub SigTermHandler { SigHandler ('TERM'); return; }
# Хэндлер SigQUIT
# undef SigQUITHandler()
sub SigQuitHandler { SigHandler ('QUIT'); return; }
# Парсер команд
# string Command($bot, $chatid, $chattername, $text)
sub Command {
my $bot = shift;
my $chatid = shift;
my $chattername = shift;
my $text = shift;
my $reply;
my $csign = $c->{csign};
return undef if (length ($text) <= length ($csign));
$log->debug ("[DEBUG] Got message from $chattername in $chatid: $text");
my $cmd = substr $text, length $csign;
if ($chatid eq $c->{channels}->{assist}) {
if ($cmd eq 'help' || $cmd eq 'помощь') {
$reply = Help ();
} elsif ($cmd eq 'version' || $cmd eq 'ver') {
$reply = 'Версия нуль.чего-то_там.чего-то_там';
} elsif ($text eq '=(' || $text eq ':(' || $text eq '):') {
$reply = ':)';
} elsif ($text eq '=)' || $text eq ':)' || $text eq '(:') {
$reply = ':D';
} elsif ($cmd eq 'ping') {
$reply = 'pong';
} elsif ($cmd eq 'cal') {
my @cmd;
if ($OSNAME eq 'darwin' || $OSNAME eq 'freebsd') {
@cmd = qw (cal -Nh3);
} elsif ($OSNAME eq 'linux') {
@cmd = qw (cal -m3);
}
if ($#cmd > 0) {
my $res = runcmd (@cmd);
if ($res->{success}) {
$reply = $res->{text};
} else {
$reply = $res->{err_msg};
}
}
} elsif ($cmd eq 'quit' || $cmd eq 'exit') {
SigHandler ('exit');
} elsif ($cmd =~ /^(notify|remind)\s+me\s+after\s+(\d+)\s*(s|seconds|m|minutes|h|hours)\s+(.*)$/) {
my $amount = $2;
my $units = $3;
my $message = $4;
$reply = Notify ($chatid, $amount, $units, $message);
} elsif ($cmd =~ /n\s+(\d+)(s|m|h)\s+(.*)$/) {
my $amount = $1;
my $units = $2;
my $message = $3;
$reply = Notify ($chatid, $amount, $units, $message);
} elsif ($cmd =~ /^(todo\s*|todo\s+.+)$/) {
$reply = Todo ($cmd);
} elsif ($cmd =~ /^b64\s(.*)/) {
$reply = B64Str ($1);
} elsif ($cmd =~ /^md5\s(.*)/) {
$reply = Md5Str ($1);
} elsif ($cmd =~ /^sha1\s(.*)/) {
$reply = Sha1Str ($1);
} elsif ($cmd =~ /^sha224\s(.*)/) {
$reply = Sha224Str ($1);
} elsif ($cmd =~ /^sha256\s(.*)/) {
$reply = Sha256Str ($1);
} elsif ($cmd =~ /^sha384\s(.*)/) {
$reply = Sha384Str ($1);
} elsif ($cmd =~ /^sha512\s(.*)/) {
$reply = Sha512Str ($1);
} elsif ($cmd =~ /^crc32\s(.*)/) {
$reply = Crc32Str ($1);
} elsif ($cmd =~ /^murmurhash\s(.*)/) {
$reply = MurmurhashStr ($1);
} elsif ($cmd =~ /^urlencode\s(.*)/) {
$reply = UrlencodeStr ($1);
} elsif ($cmd =~ /^rand\s+(.*)\s*/) {
$reply = IrandNum ($1);
} elsif ($cmd eq 'unixtime') {
$reply = time ();
}
}
return $reply;
}
1;
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

258
lib/BotLib/Command.pm Normal file
View File

@@ -0,0 +1,258 @@
package BotLib::Command;
# Парсит команды
use 5.030; ## no critic (ProhibitImplicitImport)
use strict;
use warnings;
use utf8;
use open qw (:std :utf8);
use English qw ( -no_match_vars );
use JSON::XS qw (encode_json);
use Log::Any qw ($log);
use BotLib::Conf qw (LoadConf);
use BotLib::Util qw (storedata rakedata deletedata timems utf2md5hex utf2sha1hex utf2sha224hex utf2sha256hex
utf2sha384hex utf2sha512hex utf2crc32hex utf2murmurhash utf2b64 urlencode irandom);
use version; our $VERSION = qw (1.0);
use Exporter qw (import);
our @EXPORT_OK = qw (Help Notify DelayedNotify PrintMsg Todo B64Str Md5Str Sha1Str Sha224Str Sha256Str Sha384Str
Sha512Str Crc32Str MurmurhashStr UrlencodeStr IrandNum);
local $OUTPUT_AUTOFLUSH = 1;
my $c = LoadConf();
# Возвращает список возможных команд
# $text Help()
sub Help {
my $text = '';
my $csign = $c->{csign};
$text .= "${csign}help - это сообщение\n";
$text .= "${csign}ping - попинговать бота\n";
$text .= "${csign}ver - написать что-то про версию ПО\n";
$text .= "${csign}cal - календарик\n";
$text .= "${csign}exit - завершить работу бота\n";
$text .= "${csign}quit - завершить работу бота\n";
$text .= "${csign}notify me after N [s|m|h] - одноразовая напоминалка через desktop notification\n";
$text .= "${csign}n N[s|m|h] message - одноразовая напоминалка через desktop notification\n";
$text .= "${csign}todo - выводит списк запланированных дел\n";
$text .= "${csign}todo -d N - удаляет из списка запланированных дел дело N\n";
$text .= "${csign}todo ДЕЛО - добавляет в списк запланированных дел ДЕЛО\n";
$text .= "${csign}sha1 STR - выводит sha1sum для STR\n";
$text .= "${csign}sha224 STR - выводит sha224sum для STR\n";
$text .= "${csign}sha256 STR - выводит sha256sum для STR\n";
$text .= "${csign}sha384 STR - выводит sha384sum для STR\n";
$text .= "${csign}sha512 STR - выводит sha512sum для STR\n";
$text .= "${csign}crc32 STR - выводит crc32 для STR\n";
$text .= "${csign}md5 STR - выводит md5sum для STR\n";
$text .= "${csign}murmurhash STR - выводит murmur hash для STR\n";
$text .= "${csign}b64 STR - выводит base64 для STR\n";
$text .= "${csign}urlencode STR - кодирует STR по urlencode\n";
$text .= "${csign}rand N - выдаёт рандомное целое число от 0 до указанного\n";
$text .= "${csign}unixtime - выдаёт текущее время в формате unix timestamp (секунды с 1 янв 1970)\n";
return $text;
}
# Одноразовая напоминалка. Сохраняет сообщение в базу notifications и отправляет его в delayed notifications.
# Возвращает либо строку-подтверждение, либо подсказку как пользоваться командой.
# $string Notify($chatid, $amount, $units, $message)
sub Notify {
my $chatid = shift;
my $amount = shift;
my $units = shift;
my $message = shift;
if (defined $units) {
if ($units eq 'm' || $units eq 'minute' || $units eq 'minutes') {
$amount = eval { $amount * 60 };
unless (defined $units) {
return sprintf ('Usage: %s NUM [s|seconds|m|minutes|h|hours]', $units);
}
} elsif ($units eq 'h' || $units eq 'hour' || $units eq 'hours') {
$amount = eval { $amount * 60 * 60 };
unless (defined $units) {
return sprintf ('Usage: %s NUM [s|seconds|m|minutes|h|hours]', $units);
}
} elsif ($units eq 's' || $units eq 'second' || $units eq 'seconds') {
$amount = eval { $amount + 0 };
unless (defined $units) {
return sprintf ('Usage: %s NUM [s|seconds|m|minutes|h|hours]', $units);
}
}
} else {
$amount = eval { $amount + 0 };
unless (defined $units) {
return sprintf ('Usage: %s NUM [s|seconds|m|minutes|h|hours]', $units);
}
}
my $timestamp = time () + $amount;
my $msg->{title} = 'Meow-bot notification';
my $json;
if (defined $message && $message ne '') {
$msg->{text} = $message;
} else {
$msg->{text} = 'Напоминалка!';
}
$json = encode_json $msg;
storedata ('notifications', $timestamp, $json, $c->{notifications}->{retention_days});
DelayedNotify ($c->{channels}->{notify}, $msg->{text});
return sprintf 'Notification will be sent after %d seconds', $amount;
}
# Пишет сообщение в чятик и складывает в БД, чтобы позже показать юзеру, когда он появится в чятике
# undef PrinfMsgForUser($userid, $chatid, $message)
sub DelayedNotify {
my $channel = shift;
my $message = shift;
my $timestamp = timems ();
my $data;
$data->{message} = $message;
$data->{channel} = $channel;
$data->{timestamp} = $timestamp;
$data->{expiration_time} = $c->{delayed_notifications}->{retention_days} * 24 * 60 * 60 * 1000 + $timestamp;
$data->{retention_days} = $c->{delayed_notifications}->{retention_days} ;
# Достанем список тех, кто есть в канальчике notify, им на джоине показывать сообщение не надо
my @users = keys %{$MAIN::IRC->channel_list->{$c->{channels}->{notify}}}; ## no critic (Modules::RequireExplicitInclusion)
$data->{users_shown} = \@users;
# TODO: Pretty jsonl
my $json = encode_json $data;
storedata ('delayed_notifications', timems (), $json, $c->{delayed_notifications}->{retention_days});
return;
}
# Пишет сообщение в чятик или юзеру
# undef PrintMsg($chatid, $text)
sub PrintMsg {
my $channel = shift;
my $message = shift;
$MAIN::IRC->send_long_message ('utf8', 0, 'PRIVMSG', $channel, $message); ## no critic (Modules::RequireExplicitInclusion)
$log->debug ("[DEBUG] message '$message' sent to $channel");
return;
}
# Выгребает список todo-шек из базы
# $msg = _todoPrint()
sub _todoPrint {
$log->debug ('[DEBUG] raking data from todo db');
my $todo = rakedata ('todo');
my $msg = '';
foreach (sort keys (%{$todo})) {
$msg .= sprintf "%d. %s\n", $_, $todo->{$_};
}
return $msg;
}
# Парсит запрос команды .todo
# $reply Todo($message)
sub Todo {
my $message = shift;
$log->debug ("$message");
my $reply;
if (($message eq 'todo') || ($message =~ /^todo\s+$/)) {
$log->debug ('[DEBUG] got todo command without arguments');
$reply = _todoPrint ();
} elsif ($message =~ /^todo\s+\-d\s+(\d+)\s*$/) {
$log->debug ('[DEBUG] got todo command with -d argument');
deletedata('todo', $1);
$reply = _todoPrint ();
} else {
if ($message =~ /^todo\s+(.*)/) {
my $data = $1;
$log->debug("[DEBUG] got todo command message: $message");
my $todo = rakedata ('todo');
my $num = int (keys %{$todo}) + 1;
storedata ('todo', $num, $data, 'never');
$reply = _todoPrint ();
} else {
$log->debug ('[DEBUG] got todo command with garbage');
}
}
return $reply;
}
sub B64Str {
my $str = shift;
return utf2b64 ($str);
}
sub Md5Str {
my $str = shift;
return utf2md5hex ($str);
}
sub Sha1Str {
my $str = shift;
return utf2sha1hex($str);
}
sub Sha224Str {
my $str = shift;
return utf2sha224hex($str);
}
sub Sha256Str {
my $str = shift;
return utf2sha256hex($str);
}
sub Sha384Str {
my $str = shift;
return utf2sha384hex($str);
}
sub Sha512Str {
my $str = shift;
return utf2sha512hex($str);
}
sub Crc32Str {
my $str = shift;
return utf2crc32hex($str);
}
sub MurmurhashStr {
my $str = shift;
return utf2murmurhash($str);
}
sub UrlencodeStr {
my $str = shift;
return urlencode ($str);
}
sub IrandNum {
my $num = shift;
$num = eval {$num + 0};
if (defined $num) {
return irandom($num);
} else {
return;
}
}
1;
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

52
lib/BotLib/Conf.pm Normal file
View File

@@ -0,0 +1,52 @@
package BotLib::Conf;
# loads config
use 5.030; ## no critic (ProhibitImplicitImport)
use strict;
use warnings;
use utf8;
use open qw (:std :utf8);
use English qw ( -no_match_vars );
use Encode qw (encode_utf8);
use JSON::XS ();
use Log::Any qw ($log);
use version; our $VERSION = qw (1.0);
use Exporter qw (import);
our @EXPORT_OK = qw (LoadConf);
local $OUTPUT_AUTOFLUSH = 1;
# Загружает конфиг в hashref
# $hashref LoadConf()
sub LoadConf {
my $c = 'data/config.json';
open my $CH, '<', $c or die "[FATA] No conf at $c: $OS_ERROR\n";
binmode $CH;
my $len = (stat $c) [7];
my $json;
my $readlen = read $CH, $json, $len;
unless ($readlen) {
close $CH;
$log->fatal ("[FATA] Unable to read $c: $OS_ERROR");
}
if ($readlen != $len) {
close $CH;
$log->fatal ("[FATA] File $c is $len bytes on disk, but we read only $readlen bytes");
}
$json = encode_utf8 ($json);
close $CH;
my $j = JSON::XS->new->utf8->relaxed;
# TODO: full validation of config
return $j->decode ($json);
}
1;
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

165
lib/BotLib/Periodic.pm Normal file
View File

@@ -0,0 +1,165 @@
package BotLib::Periodic;
use 5.030; ## no critic (ProhibitImplicitImport)
use strict;
use warnings;
use utf8;
use open qw (:std :utf8);
use English qw ( -no_match_vars );
use JSON::XS qw (decode_json);
use Log::Any qw ($log);
use BotLib::Command qw (PrintMsg);
use BotLib::Conf qw (LoadConf);
use BotLib::Util qw (runcmd cleanexpireddata rakedata deletedata);
use version; our $VERSION = qw (1.0);
use Exporter qw (import);
our @EXPORT_OK = qw (PollNotifications CleanExpiredEntries);
local $OUTPUT_AUTOFLUSH = 1;
my $c = LoadConf ();
# Регулярно выгребаем нотификашки из базы, запускаем нотификашки и пишем уведомления в канальчик с оповещениями
# undef PollNotifications()
sub PollNotifications {
# Достаём все нотифаи в формате ссылки на хэш
my $notification = rakedata ('notifications');
$log->debug ('[DEBUG] Raked notifications from ' . $c->{db}->{notifications} . ' db');
my $deadline = time ();
my @notifications = sort (keys %{$notification});
foreach my $timestamp (@notifications) {
if ($timestamp <= $deadline) {
$log->debug ("[Debug] Notification timestamp $timestamp <= $deadline, parsing");
my $alarm = eval { decode_json ($notification->{$timestamp}); };
deletedata ('notifications', $timestamp);
next unless ($c->{notifications}->{enabled});
# TODO: Показывать нотификации не только для mac os
if (defined $alarm) {
my $res;
my @cmd;
if (defined ($c->{notifications}->{sound}) && -e $c->{notifications}->{sound}) {
if ($OSNAME eq 'darwin') {
# Mac OS
$log->debug ("[DEBUG] use macos-specific methods of playing sounds");
@cmd = ('afplay', $c->{notifications}->{sound}, '--volume', '6');
} elsif ($OSNAME eq 'MSWin32') {
# Windows
# Хрен знает как проиграть штатными средствами, без всплывающих окон звук в windows
# TODO: Научиться проигрывать звук в windows :)
$log->debug ("[DEBUG] windows detected, i don't know how to play sounds there")
} elsif ($OSNAME eq 'linux' || $OSNAME eq 'freebsd') {
# Linux/FreeBSD
$log->debug ("[DEBUG] use linux/freebsd-specific methods of playing sounds");
if (-x '/usr/bin/mpg123' || -x '/bin/mpg123' || -x '/usr/local/bin/mpg123') {
@cmd = ('mpg123', '-q', $c->{notifications}->{sound});
} elsif (-x '/usr/bin/mpg321' || -x '/bin/mpg321' || -x '/usr/local/bin/mpg321') {
@cmd = ('mpg321', '-q', $c->{notifications}->{sound});
} elsif (-x '/usr/bin/madplay' || -x '/bin/madplay' || -x '/usr/local/bin/madplay') {
@cmd = ('madplay', '-q', '--no-tty-control', $c->{notifications}->{sound});
} elsif (-x '/usr/bin/mp3blaster' || -x '/bin/mp3blaster' || -x '/usr/local/bin/mp3blaster') {
@cmd = ('mp3blaster', $c->{notifications}->{sound});
}
} else {
$log->debug ("[DEBUG] don't know how to play sounds on $OSNAME");
}
if ($#cmd > 0) {
$res = runcmd (@cmd);
}
$#cmd = -1;
}
# Хрен знает, как показывать нотификашки стандартными средствами windows
# TODO: Научиться показывать нотификашки в windows :)
if ($OSNAME ne 'MSWin32') {
if (defined $alarm->{text} && $alarm->{text} ne '') {
if (defined $alarm->{title} && $alarm->{title} ne '') {
if ($OSNAME eq 'darwin') {
$log->debug ("[DEBUG] use macos-specific method of desktop notifications");
my $applescript = sprintf (
'display notification "%s" with title "%s"',
$alarm->{text}, $alarm->{title},
);
@cmd = ('osascript', '-e', "'$applescript'");
} else {
$log->debug ("[DEBUG] use linux/freebsd-specific method of desktop notifications");
@cmd = ('notify-send', '--expire-time=5000', $alarm->{title}, $alarm->{text});
}
} else {
if ($OSNAME eq 'darwin') {
$log->debug ("[DEBUG] use macos-specific method of desktop notifications");
my $applescript = sprintf (
'display notification "%s" with title "%s"',
$alarm->{text}, $alarm->{text},
);
@cmd = ('osascript', '-e', "'$applescript'");
} else {
$log->debug ("[DEBUG] use linux/freebsd-specific method of desktop notifications");
@cmd = ('notify-send', '--expire-time=5000', 'Напоминание от meow-бота', $alarm->{text});
}
}
PrintMsg($c->{channels}->{notify}, $alarm->{text});
} else {
if ($OSNAME eq 'darwin') {
$log->debug ("[DEBUG] use macos-specific method of desktop notifications");
my $applescript = 'display notification "Настало время придти времени." with title "Напоминание от meow-бота"';
@cmd = ('osascript', '-e', "'$applescript'");
} else {
$log->debug ("[DEBUG] use linux/freebsd-specific method of desktop notifications");
@cmd = ('notify-send', '--expire-time=5000', 'Напоминание от meow-бота', 'Настало время придти времени.');
}
PrintMsg ($c->{channels}->{notify}, 'Настало время придти времени.');
}
$res = runcmd (@cmd);
} else {
$log->debug ('[DEBUG] skip desktopn notification on windows');
}
} else {
$log->error (sprintf (
'[ERROR] Bad notification data in db %s: %s',
$c->{db}->{notifications}, $EVAL_ERROR,
));
}
} else {
$log->debug ("[Debug] Notification timestamp $timestamp > $deadline, skipping");
}
# Не выплёвываем все нотификации сразу, если их более одной штуки
if ($#notifications > -1) {
sleep 1;
}
}
return;
}
# Вычищает протухшие записи из всех баз
# undef CleanExpiredEntries()
sub CleanExpiredEntries {
foreach my $db (keys %{$c->{db}}) {
cleanexpireddata ($db);
}
return;
}
1;
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

410
lib/BotLib/Util.pm Normal file
View File

@@ -0,0 +1,410 @@
package BotLib::Util;
use 5.030; ## no critic (ProhibitImplicitImport)
use strict;
use warnings;
use utf8;
use open qw (:std :utf8);
use English qw ( -no_match_vars );
use Carp qw (cluck);
use CHI ();
use Digest::CRC qw (crc32_hex);
use Digest::SHA qw (sha1_base64 sha1_hex sha224_hex sha256_hex sha384_hex sha512_hex);
use Digest::MD5 qw (md5_base64 md5_hex);
use Digest::MurmurHash qw (murmur_hash);
use Encode qw (encode_utf8);
use Log::Any qw ($log);
use Math::Random::Secure qw (irand);
use MIME::Base64 qw (encode_base64);
use Time::HiRes qw (gettimeofday);
use URI::URL qw (url);
use BotLib::Conf qw (LoadConf);
use version; our $VERSION = qw (1.0);
use Exporter qw (import);
our @EXPORT_OK = qw (timems trim urlencode utf2b64 utf2sha1 utf2md5 utf2sha1hex utf2sha224hex utf2sha256hex
utf2sha384hex utf2sha512hex utf2md5hex utf2crc32hex utf2murmurhash irandom runcmd storedata
cleanexpireddata rakedata deletedata);
local $OUTPUT_AUTOFLUSH = 1;
my $c = LoadConf ();
# Возвращает текущее время с точностью до миллисекунды
# $string timems()
sub timems {
my @time = gettimeofday ();
return join '', @time;
}
# Убирает пробельные символы с обоих концов даденной строки
# $str trim($str)
sub trim {
my $str = shift;
unless (defined $str) {
cluck '[ERROR] Str is undefined';
return '';
}
if ($str eq '') {
return $str;
}
while (substr ($str, 0, 1) =~ /^\s$/xms) {
$str = substr $str, 1;
}
while (substr ($str, -1, 1) =~ /^\s$/xms) {
chop $str;
}
return $str;
}
# Кодирует даденную строку согласно стандарту кодирования URL-ов
# $str urlencode($url)
sub urlencode {
my $str = shift;
unless (defined $str) {
cluck '[ERROR] Str is undefined';
return '';
}
my $urlobj = url $str;
return $urlobj->as_string;
}
# Кодирует даденную строку "по base64"
# $str utf2b64($str)
sub utf2b64 {
my $string = shift;
unless (defined $string) {
cluck '[ERROR] String is undefined';
return encode_base64 '';
}
if ($string eq '') {
return encode_base64 '';
}
my $bytes = encode_utf8 $string;
return encode_base64 $bytes;
}
# Берёт от даденной строки sha1 и кодирует "по base64"
# Пример применения - имена файлов из каких-то unsafe(для файловой системы)-строк
# $str utf2sha1($str)
sub utf2sha1 {
my $string = shift;
unless (defined $string) {
cluck '[ERROR] String is undefined';
return sha1_base64 '';
}
if ($string eq '') {
return sha1_base64 '';
}
my $bytes = encode_utf8 $string;
return sha1_base64 $bytes;
}
# Берёт от даденной строки sha1 и кодирует "по base64"
# Пример использования - имена файлов из unsafe(для файловой системы)-параметров
# $str utf2md5($str)
sub utf2md5 {
my $string = shift;
unless (defined $string) {
cluck '[ERROR] String is undefined';
return sha1_base64 '';
}
if ($string eq '') {
return sha1_base64 '';
}
my $bytes = encode_utf8 $string;
return md5_base64 $bytes;
}
# Берёт от даденной строки sha224, как утилита sha224sum
# $str utf2sha224hex($str)
sub utf2sha1hex {
my $string = shift;
unless (defined $string) {
cluck '[ERROR] String is undefined';
return sha1_hex '';
}
if ($string eq '') {
return sha1_hex '';
}
my $bytes = encode_utf8 $string;
return sha1_hex $bytes;
}
# Берёт от даденной строки sha224, как утилита sha224sum
# $str utf2sha224hex($str)
sub utf2sha224hex {
my $string = shift;
unless (defined $string) {
cluck '[ERROR] String is undefined';
return sha224_hex '';
}
if ($string eq '') {
return sha224_hex '';
}
my $bytes = encode_utf8 $string;
return sha224_hex $bytes;
}
# Берёт от даденной строки sha256, как утилита sha1sum
# $str utf2sha256hex($str)
sub utf2sha256hex {
my $string = shift;
unless (defined $string) {
cluck '[ERROR] String is undefined';
return sha256_hex '';
}
if ($string eq '') {
return sha256_hex '';
}
my $bytes = encode_utf8 $string;
return sha256_hex $bytes;
}
# Берёт от даденной строки sha1, как утилита sha384sum
# $str utf2sha384hex($str)
sub utf2sha384hex {
my $string = shift;
unless (defined $string) {
cluck '[ERROR] String is undefined';
return sha384_hex '';
}
if ($string eq '') {
return sha384_hex '';
}
my $bytes = encode_utf8 $string;
return sha384_hex $bytes;
}
# Берёт от даденной строки sha1, как утилита sha512sum
# $str utf2sha512hex($str)
sub utf2sha512hex {
my $string = shift;
unless (defined $string) {
cluck '[ERROR] String is undefined';
return sha512_hex '';
}
if ($string eq '') {
return sha512_hex '';
}
my $bytes = encode_utf8 $string;
return sha512_hex $bytes;
}
# Берёт от даденной строки md5, как утилита md5sum
# $str utf2md5hex($str)
sub utf2md5hex {
my $string = shift;
unless (defined $string) {
cluck '[ERROR] String is undefined';
return md5_hex '';
}
if ($string eq '') {
return md5_hex '';
}
my $bytes = encode_utf8 $string;
return md5_hex $bytes;
}
# Берёт от даденной строки crc32
# $str utf2crc32hex($str)
sub utf2crc32hex {
my $string = shift;
unless (defined $string) {
cluck '[ERROR] String is undefined';
return crc32_hex '';
}
if ($string eq '') {
return crc32_hex '';
}
my $bytes = encode_utf8 $string;
return crc32_hex $bytes;
}
# Берёт от даденной строки murmur_hash
# $str utf2murmurhash($str)
sub utf2murmurhash {
my $string = shift;
unless (defined $string) {
cluck '[ERROR] String is undefined';
return murmur_hash '';
}
if ($string eq '') {
return murmur_hash '';
}
my $bytes = encode_utf8 $string;
return murmur_hash $bytes;
}
# Возвращает рандомное целое число от 0 до даденного числа
# $num irand($num)
sub irandom {
my $num = shift;
return irand ($num);
}
# Execs command via backticks and handles errors in generic way
# Returns hashref
# $ret runcmd($cmd, @args)
sub runcmd {
my @cmd = @_;
my $out = '';
my $ret->{error} = 0;
$ret->{success} = 1;
my $err_msg = '';
$out = `@cmd`;
if ($CHILD_ERROR != 0) {
$err_msg = sprintf 'Unable to run %s', join (' ', @cmd);
$log->err ("[ERROR] $err_msg");
$ret->{error} = 1;
$ret->{success} = 0;
$ret->{err_msg} = $err_msg;
} else {
$ret->{text} = $out;
}
return $ret;
}
# Сохраняет данные в указанной БД с указанным expiration time. Expiration time может быть never, unixtimestamp, relative.
# Где unixtimestmp в секундах (с 1970 года), relative - это например 2 days.
# undef storedata($dbname, $key, $value, $time)
sub storedata {
my $dbname = shift;
my $key = shift;
my $value = shift;
my $time = shift;
cluck "[ERROR] datadir undefined in config" unless (defined $c->{datadir});
cluck "[ERROR] database not defined in config" unless (defined $c->{db}->{$dbname});
my $db_path = sprintf '%s/%s', $c->{datadir}, $c->{db}->{$dbname};
my $cache = CHI->new (
driver => 'BerkeleyDB',
root_dir => $db_path,
);
$cache->set ($key, $value, $time);
$log->debug ("[DEBUG] key $key with value $value and exp $time stored to $dbname");
return;
}
# Удаляет протухшие ключи из указанной бд
# undef cleanexpireddata($dbname)
sub cleanexpireddata {
my $dbname = shift;
# TODO: check that db defined in config
my $db_path = sprintf '%s/%s', $c->{datadir}, $c->{db}->{$dbname};
my $cache = CHI->new (
driver => 'BerkeleyDB',
root_dir => $db_path,
);
foreach my $entry ($cache->get_keys ()) {
unless ($cache->is_valid ($entry)) {
$cache->remove ($entry);
$log->debug ("[DEBUG] Expired key $entry removed from $dbname");
}
}
return;
}
# Выгребает ключ-значение из указанной БД в формате ссылочной структуры. Ключ гарантированно не протухший
# dataref rakedata($dbname)
sub rakedata {
my $dbname = shift;
# TODO: check if db exist
my $db_path = sprintf '%s/%s', $c->{datadir}, $c->{db}->{$dbname};
cluck unless defined $c->{db}->{$dbname};
cluck unless defined $c->{datadir};
my $cache = CHI->new (
driver => 'BerkeleyDB',
root_dir => $db_path,
);
my $hashref;
foreach ($cache->get_keys()) {
my $cache_object = $cache->get_object ($_);
$hashref->{$cache_object->key ()} = $cache_object->value ();
}
return $hashref;
}
# Удаляет ключ и ассоциированные с ним данные из указанной бд
# undef deletedata($dbname, $key)
sub deletedata {
my $dbname = shift;
my $key = shift;
cluck unless defined $c->{db}->{$dbname};
cluck unless defined $c->{datadir};
my $db_path = sprintf '%s/%s', $c->{datadir}, $c->{db}->{$dbname};
my $cache = CHI->new (
driver => 'BerkeleyDB',
root_dir => $db_path,
);
$cache->remove ($key);
$log->debug ("[DEBUG] Key $key removed from $dbname");
return;
}
1;
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

375
lib/IRCBot.pm Normal file
View File

@@ -0,0 +1,375 @@
package IRCBot;
use 5.030; ## no critic (ProhibitImplicitImport)
use strict;
use warnings;
use utf8;
use open qw (:std :utf8);
use English qw ( -no_match_vars );
use AnyEvent ();
use AnyEvent::IRC ();
use AnyEvent::IRC::Client ();
use AnyEvent::IRC::Util qw (prefix_nick);
use Date::Format::ISO8601 qw (gmtime_to_iso8601_datetime);
use Encode qw (decode);
use JSON::XS qw (decode_json encode_json);
use Log::Any qw ($log);
use BotLib qw (Command SigIntHandler SigTermHandler SigQuitHandler);
use BotLib::Command qw (PrintMsg);
use BotLib::Conf qw (LoadConf);
use BotLib::Periodic qw (PollNotifications CleanExpiredEntries);
use BotLib::Util qw (rakedata storedata deletedata);
use version; our $VERSION = qw (1.0);
use Exporter qw (import);
our @EXPORT_OK = qw (RunIRCBot);
local $OUTPUT_AUTOFLUSH = 1;
# Основная функция
# undef RunIRCBot()
sub RunIRCBot {
my $c = LoadConf ();
my $cv = AnyEvent->condvar;
# Пытаемся ловить сигналы асинхронно
my $sigint = AnyEvent->signal (signal => 'INT', cb => \&SigIntHandler);
my $sigterm = AnyEvent->signal (signal => 'TERM', cb => \&SigTermHandler);
my $sigquit = AnyEvent->signal (signal => 'QUIT', cb => \&SigQuitHandler);
# Раз в секунду опрашиваем базу с нотификашками
my $pollnotifications = AnyEvent->timer (
after => 3, # seconds
interval => 1, # second
cb => \&PollNotifications,
);
# Раз в 15 минут чистим базы от просроченных записей
my $cleandatabeses = AnyEvent->timer (
after => 900, # seconds
interval => 900, # seconds
cb => \&CleanExpiredEntries,
);
# Looks butt-ugly, but we have to make global var calls... err calls to MAIN namespace var
$MAIN::IRC = AnyEvent::IRC::Client->new (send_initial_whois => 1); ## no critic (Modules::RequireExplicitInclusion)
$MAIN::IRC->reg_cb ( ## no critic (Modules::RequireExplicitInclusion)
irc_privmsg => sub {
my ($self, $msg) = @_;
my $botnick = $MAIN::IRC->nick (); ## no critic (Modules::RequireExplicitInclusion)
my $chatid = $msg->{params}->[0];
my $text = decode ('utf8', $msg->{params}->[-1]);
my $nick = prefix_nick ($msg->{prefix});
my $answer;
# Ивенты без текста нам не интересны
unless (defined $text) {return;}
# Команды, как правило, начинаются с csign, это обычно . (точка)
if (substr($text, 0, length $c->{csign}) eq $c->{csign}) {
$answer = Command ($self, $chatid, $nick, $text);
unless (defined $answer && $answer ne '') {
return;
}
} # То, что не команды мы игнорируем.
if (defined $answer) {
foreach my $string (split /\n/, $answer) {
if ($string ne '') {
if ($MAIN::IRC->is_my_nick ($chatid)) { ## no critic (Modules::RequireExplicitInclusion)
# private chat
PrintMsg ($nick, $string);
} else {
# chat in channel
PrintMsg ($chatid, $string);
}
}
}
}
return;
},
connect => sub {
my ($pc, $err) = @_;
if (defined $err) {
$log->err ("[ERROR] Couldn't connect to server: $err\n");
}
if (defined($c->{identify}) && $c->{identify} ne '') {
# freenode/libera.chat identification style
$MAIN::IRC->send_srv ( ## no critic (Modules::RequireExplicitInclusion)
PRIVMSG => 'NickServ',
sprintf ('identify %s %s', $c->{nick}, $c->{identify}),
);
}
# Джойнимся ко всем каналам, кроме assist-а
for my $chan (sort (keys %{$c->{channels}})) {
next if $chan eq 'assist';
if ($chan eq 'notify') {
next unless ($c->{notifications}->{enabled});
}
$MAIN::IRC->send_srv ('JOIN', $c->{channels}->{$chan}); ## no critic (Modules::RequireExplicitInclusion)
}
# К assist-у джойнимся в последнюю очередь, чтобы быть уже приджойненным ко всему остальному
$MAIN::IRC->send_srv ('JOIN', $c->{channels}->{assist});
return;
},
connfail => sub {
$log->err ('[ERROR] Connection failed, trying again');
sleep 5;
$MAIN::IRC->connect (
$c->{server},
$c->{port},
{
nick => $c->{nick},
user => $c->{nick},
real => $c->{nick},
},
);
},
registered => sub {
my ($self) = @_;
$log->info('[INFO] Registered on server');
$MAIN::IRC->enable_ping (60);
return;
},
disconnect => sub {
# TODO: Data::Dump here and debug $_[1], it's undef!
$log->err("[ERROR] Disconnected: $_[1]");
sleep 5;
$log->info ("[INFO] Re-connecting to $c->{server}:$c->{port}");
$MAIN::IRC->connect(
$c->{server},
$c->{port},
{
nick => $c->{nick},
user => $c->{nick},
real => $c->{nick},
},
);
return;
},
kick => sub {
my ($self, $kicked_nick, $channel, $is_myself, $msg, $kicker_nick) = @_;
if ($is_myself) {
if (defined $msg && $msg ne '') {
$log->warn (
sprintf '[WARN] %s kicked me from %s with reason: %s',
$kicker_nick, $channel, decode('utf8', $msg),
);
} else {
$log->warn (sprintf '[WARN] %s kicked me from %s with no reason', $kicker_nick, $channel);
}
sleep 3;
$log->info ("[INFO] Re-joining to $channel");
$MAIN::IRC->send_srv ('JOIN', $channel);
}
return;
},
nick_change => sub {
my ($self, $old_nick, $new_nick, $is_myself) = @_;
if ($is_myself) {
$log->warn(sprintf '[WARN] My nick have been changed from %s to %s', $old_nick, $new_nick);
}
return;
},
part => sub {
my ($self, $nick, $channel, $is_myself, $msg) = @_;
if ($is_myself) {
if (defined $msg && $msg ne '') {
$log->warn(sprintf '[WARN] I left %s channel: %s', $channel, $msg);
} else {
$log->warn(sprintf '[WARN] I left %s channel', $channel);
}
} else {
if (defined $msg && $msg ne '') {
$log->warn(sprintf '[INFO] %s left %s channel: %s', $nick, $channel, $msg);
} else {
$log->warn(sprintf '[INFO] %s left %s channel', $nick, $channel);
}
}
return;
},
join => sub {
my ($self, $nick, $channel, $is_myself) = @_;
if ($is_myself) {
$log->info (sprintf '[INFO] I joined to %s channel', $channel);
} else {
$log->info( sprintf '[INFO] %s joined to %s channel', $nick, $channel);
# Покажем отложенные уведомления пользователю в личку
if ($channel eq $c->{channels}->{notify}) {
# Юзер заджойнился в канал с нотификашками, надо ему в приват вывалить все нотификашки, которые
# были, пока его не было, либо то, что было за последние retention_days
my $notifications = rakedata ('delayed_notifications');
my $title_shown = 0;
foreach my $timestamp (sort keys (%{$notifications})) {
my $show = 1;
my $item = decode_json ($notifications->{$timestamp});
unless (defined $item) {
$log->error ("[ERROR] Unable to decode json from $c->{db}->{delayed_notifications} db: $EVAL_ERROR");
}
foreach my $user (@{$item->{users_shown}}) {
if ($user eq $nick) {
$show = 0;
last;
}
}
if ($show) {
push @{$item->{users_shown}}, $nick;
unless ($title_shown) {
PrintMsg ($nick, 'Missing notifications since your last visit or for 2 days:');
$title_shown = 1;
}
my $msg = sprintf (
'Channel %s: %s',
$item->{channel},
$item->{message},
);
if ($c->{delayed_notifications}->{enabled}) {
PrintMsg ($nick, $msg);
}
deletedata ('delayed_notifications', $item->{timestamp});
# TODO: pretty jsonl
my $json = encode_json $item;
storedata (
$c->{db}->{delayed_notifications},
$item->{timestamp},
$json,
$item->{expiration_time},
);
}
}
}
# Заинвайтим пользователя в канал notify
if ($channel eq $c->{channels}->{assist}) {
if ($c->{notifications}->{enabled}) {
$log->debug ("[DEBUG] Inviting $nick to $c->{channels}->{notify}");
$MAIN::IRC->send_srv ('INVITE', $nick, $c->{channels}->{notify});
}
}
}
return;
},
);
# these commands will queue until the connection
# is completly registered and has a valid nick etc.
$MAIN::IRC->ctcp_auto_reply ('ACTION', ## no critic (Modules::RequireExplicitInclusion)
sub {
my ($cl, $src, $target, $tag, $msg, $type) = @_;
return ['ACTION', $msg];
},
);
$MAIN::IRC->ctcp_auto_reply ('CLIENTINFO', ## no critic (Modules::RequireExplicitInclusion)
[
'CLIENTINFO',
'CLIENTINFO ACTION FINGER PING SOURCE TIME USERINFO VERSION',
],
);
$MAIN::IRC->ctcp_auto_reply ('FINGER', ## no critic (Modules::RequireExplicitInclusion)
[
'FINGER',
$c->{nick},
],
);
$MAIN::IRC->ctcp_auto_reply ('PING', ## no critic (Modules::RequireExplicitInclusion)
sub {
my ($cl, $src, $target, $tag, $msg, $type) = @_;
return ['PING', $msg];
},
);
$MAIN::IRC->ctcp_auto_reply ('SOURCE', ## no critic (Modules::RequireExplicitInclusion)
[
'SOURCE',
'https://github.com/elersir/meow-irc-bot',
],
);
$MAIN::IRC->ctcp_auto_reply ('TIME', ## no critic (Modules::RequireExplicitInclusion)
[
'TIME',
gmtime_to_iso8601_datetime (time ()),
],
);
$MAIN::IRC->ctcp_auto_reply ('USERINFO', ## no critic (Modules::RequireExplicitInclusion)
[
'USERINFO',
$c->{nick},
],
);
$MAIN::IRC->ctcp_auto_reply ('VERSION', ## no critic (Modules::RequireExplicitInclusion)
[
'VERSION',
'Meow IRC Bot/1.0',
],
);
if ($c->{ssl}) {
$MAIN::IRC->enable_ssl (); ## no critic (Modules::RequireExplicitInclusion)
}
$MAIN::IRC->connect ( ## no critic (Modules::RequireExplicitInclusion)
$c->{server},
$c->{port},
{
nick => $c->{nick},
user => $c->{nick},
real => $c->{nick},
},
);
$cv->wait;
$MAIN::IRC->disconnect; ## no critic (Modules::RequireExplicitInclusion)
return;
}
1;
# vim: set ft=perl noet ai ts=4 sw=4 sts=4: