From 556540ddb28a143bed2048e819ee13d2cb4b0c69 Mon Sep 17 00:00:00 2001 From: eleksir Date: Sun, 30 Oct 2022 17:23:57 +0300 Subject: [PATCH] Initial version --- .gitignore | 12 ++ .perlcriticrc | 62 ++++++ BUGS | 7 + DESIGN | 31 +++ LICENSE.txt | 20 ++ README.md | 38 ++++ bin/meow-irc-bot | 190 +++++++++++++++++++ bootstrap.sh | 5 + cpanfile | 28 +++ data/config-sample.json | 58 ++++++ lib/BotLib.pm | 170 +++++++++++++++++ lib/BotLib/Command.pm | 258 +++++++++++++++++++++++++ lib/BotLib/Conf.pm | 52 +++++ lib/BotLib/Periodic.pm | 165 ++++++++++++++++ lib/BotLib/Util.pm | 410 ++++++++++++++++++++++++++++++++++++++++ lib/IRCBot.pm | 375 ++++++++++++++++++++++++++++++++++++ 16 files changed, 1881 insertions(+) create mode 100644 .gitignore create mode 100644 .perlcriticrc create mode 100644 BUGS create mode 100644 DESIGN create mode 100644 LICENSE.txt create mode 100644 README.md create mode 100755 bin/meow-irc-bot create mode 100755 bootstrap.sh create mode 100644 cpanfile create mode 100644 data/config-sample.json create mode 100644 lib/BotLib.pm create mode 100644 lib/BotLib/Command.pm create mode 100644 lib/BotLib/Conf.pm create mode 100644 lib/BotLib/Periodic.pm create mode 100644 lib/BotLib/Util.pm create mode 100644 lib/IRCBot.pm diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..78d08c6 --- /dev/null +++ b/.gitignore @@ -0,0 +1,12 @@ +.idea/** +.fleet/** +.vscode/** +vendor_perl/** +data/db/** +data/config.json +TODO +.env +*.pid +*.log +_Deparsed_XSubs.pm +.vstags \ No newline at end of file diff --git a/.perlcriticrc b/.perlcriticrc new file mode 100644 index 0000000..d5f294f --- /dev/null +++ b/.perlcriticrc @@ -0,0 +1,62 @@ +#!/usr/bin/env perlcritic + +# Задействованные модули критика: +# +# Perl::Critic::More +# Perl::Critic::Pulp +# Perl::Critic::TooMuchCode +# Perl::Critic::Lax +# Perl::Critic::Policy::CompileTime +# Perl::Critic::Policy::ProhibitImplicitImport +# Perl::Critic::Policy::Dynamic::NoIndirect +# Perl::Critic::StricterSubs +# Perl::Critic::Policy::CodeLayout::RequireUseUTF8 + +severity = 1 +verbose = 9 + +[-CodeLayout::RequireTidyCode] +[-Editor::RequireEmacsFileVariables] +[-Modules::RequirePerlVersion] +[-Modules::RequirePerlVersionVar] +[-Modules::RequireVersionVar] +[-ValuesAndExpressions::ProhibitMagicNumbers] +[-TooMuchCode::ProhibitUnnecessaryUTF8Pragma] +[-NamingConventions::Capitalization] +[-ControlStructures::ProhibitUnlessBlocks] +[-InputOutput::RequireCheckedSyscalls] +[-InputOutput::RequireCheckedClose] +[-TooMuchCode::ProhibitDuplicateLiteral] +[-Subroutines::ProhibitExplicitReturnUndef] +[-ErrorHandling::RequireUseOfExceptions] +[-Subroutines::ProhibitExplicitReturnUndef] +[-Lax::RequireConstantOnLeftSideOfEquality::ExceptEq] +[-ValuesAndExpressions::RequireConstantOnLeftSideOfEquality] +[-ValuesAndExpressions::RestrictLongStrings] +[-Lax::ProhibitEmptyQuotes::ExceptAsFallback] +[-ValuesAndExpressions::ProhibitEmptyQuotes] +[-Variables::ProhibitReusedNames] +[-Subroutines::RequireArgUnpacking] +[-ControlStructures::ProhibitPostfixControls] +[-ValuesAndExpressions::ProhibitNoisyQuotes] +[-ControlStructures::ProhibitDeepNests] +[-ControlStructures::ProhibitCStyleForLoops] +[-Subroutines::ProhibitExcessComplexity] +[-Modules::ProhibitExcessMainComplexity] +[-RegularExpressions::RequireDotMatchAnything] +[-RegularExpressions::RequireExtendedFormatting] +[-RegularExpressions::RequireLineBoundaryMatching] +[-InputOutput::RequireBracedFileHandleWithPrint] +[-InputOutput::RequireBriefOpen] +#[-Modules::RequireExplicitInclusion] +[-ControlStructures::ProhibitNegativeExpressionsInUnlessAndUntilConditions] +[-ControlStructures::ProhibitCascadingIfElse] +[-InputOutput::ProhibitBacktickOperators] +[-CodeLayout::ProhibitParensWithBuiltins] +# We have to use vars from neighbor namespace :( +[-RegularExpressions::ProhibitComplexRegexes] +[-RegularExpressions::ProhibitSingleCharAlternation] +[-CodeLayout::RequireASCII] + +[-Miscellanea::ProhibitUnrestrictedNoCritic] +# to avoid critic cpanfile diff --git a/BUGS b/BUGS new file mode 100644 index 0000000..94af192 --- /dev/null +++ b/BUGS @@ -0,0 +1,7 @@ +Известные баги и недоработки. + +1. STDOUT и STDERR редиректятся и захватываются в Log::Any с помощью Log::Any::For::Std. В этой связи нет возможности + работать с stdio при запуске внешних команд. И именно поэтому не работают модули IPC::Run и IPC::Run3. Вместо этих + модулей используется классические backticks. + При этом STDERR автоматичеки улетает в лог. Понятное дело, что STDOUT можно либо оставить "как есть" (и он тоже + улетит в лог) или захватить в переменную. diff --git a/DESIGN b/DESIGN new file mode 100644 index 0000000..1d451ac --- /dev/null +++ b/DESIGN @@ -0,0 +1,31 @@ +Технический дизайн бота. + +Общее описание. +Бот не предполагает модульный дизайн. Это не отменяет тематическую разбивку/группировку функций на модули. +Конфиг в формате loose json, в котором возможны коментарии и некоторые вольности с одной стороны, а с другой - +некоторые параметры можно сразу же засунуть в массивы и хэши. + +Ratelimits. +Ограничений на количество сообщений в секунду со стороны бота нет. То есть при некоторых настройках сервера, бот может +быть либо залимитирован, либо кикнут, либо забанен. + +Нотификации. +Нотификации реализованы через модуль CHI. Это абстракция над базой данных. В качестве бд выбрана BerkeleyDB. +С одной стороны работает разгребальщик, который раз в секунду выгребает все непросроченные события из базы. А с другой - +в эту базу складывают события команды и прочие "продюсеры". Нотификации показываются с помощью desktop notification и с +помощью сообщений в канал notify. + +Отложенные нотификации. +Приватные сообщения от бота. Набор пропущенных ивентов, не полученных в канальчике notify. Хранится в течение +retention_days. Показывается в момент джоина в канальчик notify. + +И ещё про нотификации. +Нотификации, как правило, сопровождаются звуком, путь до mp3-шки с желаемым аудиоуведомлением можно задать в конфиге, +однако проигрываются нотификации в разных системах по-разному. В Windows например, вообщке не произрываются и desktop +notification не показываются вообще, потому что у меня такой системы нету. В MacOS звук воспроизводится через afplay, а +сами уведомления показываются средствами интерпретатора applescript - osascript. Под GNU/Linux звук воспроизводится +первым, что найдётся - mpg123, mpg321, madplay, mp3blaster, а уведомления показываются через notify-send. + +Календарик. +Команда cal работает только на Linux и MacOS, предполагается, что на FreeBSD она работает также как и на MacOS, что +касается других ос - не имплементировано. diff --git a/LICENSE.txt b/LICENSE.txt new file mode 100644 index 0000000..13255ce --- /dev/null +++ b/LICENSE.txt @@ -0,0 +1,20 @@ +Copyright (c) 2022 Sergei Fedosoff + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be +included in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 index 0000000..61e1a35 --- /dev/null +++ b/README.md @@ -0,0 +1,38 @@ +# Meow-IRC-bot - Простой ассистивный IRC бот + +## About + +Бот основан Perl модуле [AnyEvent::IRC][1]. + +Конфиг должен находиться в **data/config.json**, пример конфига расположен в **data/sample_config.json**. + +Бота можно запустить через команду **bin/meow-irc-bot**. + +Этого бота можно считать экспериментальным из-за отсутсвия всестороннего тестирования. Он сделан по принципу "works for +me". Он проверялся на работоспособность на MacOS "Big Sur" и Slackware Linux 15.0. + +## Installation + +Чтобы запустить бота, надо вначале его забутстрапить - загрузить и установить все нужные перловые модули. + +Для MacOS нам понадобится xcode console tools. (Их предлагают установить при установке VS Code, например). + +Для Linux нам понадобится "Development Tools" или похожий набор пакетов и дополнительно perl, perl-devel, +perl-local-lib, perl-app-cpanm, sqlite-devel, zlib-devel, openssl-devel, libdb4-devel (Berkeley DB devel), make. + +После установки указанных пакетов, можно смело запускать: + +```sh +bash bootstrap.sh +``` + +и всё необходимое будет скачано из интернетов, протестировано и установлено в локальный каталог vendor_perl. + +Для воспроизведения desktop notifications на MacOS используется afplay для звукового оповещения и osascript для +визуального, это стандартные средства MacOS. + +Для воспроизведения desktop notifications под Linux используется mpg123, mpg321, madplay, mp3blaster, что первое +найдётся по этому списку, чтобы воспроизвеcти звук уведомления и send-notify для отсылки команды в нотификатор для +отображения уведомления на рабочем столе. + +[1]: https://metacpan.org/pod/AnyEvent::IRC diff --git a/bin/meow-irc-bot b/bin/meow-irc-bot new file mode 100755 index 0000000..5aac70f --- /dev/null +++ b/bin/meow-irc-bot @@ -0,0 +1,190 @@ +#!/usr/bin/perl + +use 5.030; ## no critic (ProhibitImplicitImport) +use strict; +use warnings; +use utf8; +use open qw (:std :utf8); +use English qw ( -no_match_vars ); +use version; our $VERSION = qw (1.0); + +my $workdir; + +# before we run, change working dir +BEGIN { + use Cwd qw (chdir abs_path); + my @CWD = split /\//, abs_path ($PROGRAM_NAME); + + if ($#CWD > 1) { + $#CWD = $#CWD - 2; + } + + $workdir = join '/', @CWD; + chdir $workdir; +} + +use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5"); +no Cwd; +use Cwd::utf8 qw (chdir abs_path); +use POSIX qw (setgid setuid setsid); +use File::Basename qw (basename dirname); +use File::Path qw (make_path); +use File::Spec (); +use Log::Any qw ($log); +use Log::Any::Adapter (); +use Log::Any::For::Std (); +use BotLib qw (SigIntHandler SigTermHandler SigQuitHandler); +use BotLib::Conf qw (LoadConf); +use IRCBot qw (RunIRCBot); + +sub daemonize (); +sub __fork (); + +local $OUTPUT_AUTOFLUSH = 1; + +my $piddir = '/var/run/' . basename (abs_path $PROGRAM_NAME); +my $C = LoadConf (); +my $loglevel = $C->{'loglevel'}; +$C->{loglevel} = 'notice' unless defined $C->{loglevel}; +my $logfile; +# Global IRC Client state var/object $MAIN::IRC +my $IRC; ## no critic (Variables::ProhibitUnusedVariables) + +if (defined $C->{'log'}) { + $logfile = $C->{'log'}; +} elsif (defined $C->{'debug_log'}) { + $logfile = $C->{'debug_log'}; +} + +# if we run under root, create pid dir and set correct owner for it, same for debug log if it is defined +if ($UID == 0) { + my $user = $C->{user}; + die "Unable to run as root, please define unprivileged user in config.json\n" unless (defined $user); + my ($uid, $gid) = (getpwnam $user)[2,3]; + + unless (-d $piddir) { + make_path ( + $piddir, { + uid => $uid, + group => $gid, + }, + ) or die "Unable to create $piddir: $OS_ERROR\n"; + } + + if (defined $logfile) { + my $logdir = dirname $logfile; + + unless (-d $logdir) { + make_path ( + $logdir, { + uid => $uid, + group => $gid, + }, + ) or die "Unable to create $logdir: $OS_ERROR\n"; + } + } + +# drop privs + setgid ($gid) or die "Unable to switch to group of $user: $OS_ERROR\n"; + setuid ($uid) or die "Unable to switch to account $user: $OS_ERROR\n"; +} else { + $piddir = $workdir; +} + +if (defined $logfile) { + # loglevel warning suppresses logging from CHI. + Log::Any::Adapter->set ('File', $logfile, log_level => $loglevel); + + # Some annoying CHI logging events come with category set to CHI::Driver and log_level set to debug. + # Until we use start using Log::Any native features and set whole loglevel accordingly, lets lower + # verbosity paticulary for CHI. + Log::Any::Adapter->set ( + { + category => 'CHI::Driver', + }, + 'File', + $logfile, + log_level => 'warn', + ); +} else { + # no log defined so set loglevel to the least verbose + Log::Any::Adapter->set ('File', File::Spec->devnull, 'log_level'=>'emergency'); +} + +# double fork attach to /dev/null all stdio and go background +if (defined $C->{daemonize} && $C->{daemonize}) { + daemonize (); +} + +# write pidfile +my $apath = abs_path $PROGRAM_NAME; + +unless (defined $apath) { + $log->fatal ("[FATAL] Unable to get abs_path: $OS_ERROR"); + exit 1; +} + +my $pidfile = sprintf '%s/%s.pid', $piddir, basename $apath; +$log->info ("[INFO] Creating pidfile at $pidfile"); + +open (my $pid, '>', $pidfile) or do { + $log->fatal ("[FATAL] Error opening $pidfile: $OS_ERROR"); + exit 1; +}; + +print $pid $PID or do { + $log->fatal ("[FATAL] Error writing to $pidfile: $OS_ERROR"); + exit 1; +}; + +close $pid; + +local $SIG{INT} = \&SigIntHandler; +local $SIG{TERM} = \&SigTermHandler; +local $SIG{QUIT} = \&SigQuitHandler; + +# set correct proctitle +$PROGRAM_NAME = abs_path $PROGRAM_NAME; ## no critic (Variables::RequireLocalizedPunctuationVars) + +RunIRCBot (); + +if (-e $pidfile) { + unlink $pidfile; +} + +exit 0; + +# Демонизирует программу (double fork() && detach from terminal, etc) +# undef daemonize() +sub daemonize () { + __fork (); + setsid (); + open STDIN, '<', File::Spec->devnull; ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen) + # we handle STDOUT && STDERR via Log::Any::For::Std, so do not close them explicitly + #open (STDOUT, '>', '/dev/null'); ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen) + #open (STDERR, '>', '/dev/null'); ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen) + __fork (); + umask 0; + return; +} + +# Форкает программу и завершает родителя +# undef __fork() +sub __fork () { + my $pid = fork; + + unless (defined $pid) { + $log->fatal ("[FATAL] Can't fork: $OS_ERROR"); + exit 1; + } + + if ($pid != 0) { + exit 0; + } + + return; +} + +__END__ + +# vim: set ft=perl noet ai ts=4 sw=4 sts=4: diff --git a/bootstrap.sh b/bootstrap.sh new file mode 100755 index 0000000..fe78a4f --- /dev/null +++ b/bootstrap.sh @@ -0,0 +1,5 @@ +#!/bin/bash + +cpanm -l vendor_perl --self-contained --force --update --installdeps . + +# vim: set ft=sh noet ai ts=4 sw=4 sts=4: diff --git a/cpanfile b/cpanfile new file mode 100644 index 0000000..000b0b4 --- /dev/null +++ b/cpanfile @@ -0,0 +1,28 @@ +## no critic + +requires "AnyEvent::IRC", "==0.97"; +requires "Digest::CRC", "==0.24"; +requires "CHI", "==0.61"; +requires "CHI::Driver::BerkeleyDB", "==0.05"; +requires "Cwd", "==3.75"; +requires "Cwd::utf8", "==0.011"; +requires "Date::Format::ISO8601", "==0.010"; +requires "DateTime", "==1.58"; +requires "Digest::MD5", "==2.58"; +requires "Digest::MurmurHash", "==0.11"; +requires "Digest::HMAC_SHA1", "==1.04"; +requires "Digest::SHA", "==6.02"; +requires "Encode", "==3.17"; +requires "English", "0"; +requires "File::Basename", "==2.85"; +requires "File::Path", "==2.18"; +requires "IO::Socket::SSL", "==2.074"; +requires "JSON::XS", "==4.03"; +requires "JSON::PP", "==4.09"; +requires "Log::Any", "==1.710"; +requires "Log::Any::Adapter", "==1.710"; +requires "Log::Any::For::Std", "==0.05"; +requires "Math::Random::Secure", "==0.080001"; +requires "MIME::Base64", "==3.16"; +requires "POSIX", "0"; +requires "Time::HiRes", "1.9760"; diff --git a/data/config-sample.json b/data/config-sample.json new file mode 100644 index 0000000..cbef88d --- /dev/null +++ b/data/config-sample.json @@ -0,0 +1,58 @@ +{ + # Куда коннекаться + "server" : "127.0.0.1", + "port" : "6667", + "ssl" : 0, + + # IRC nick + "nick" : "meow", + + # Команды бота начинаются с этого символа + "csign": ".", + + # Список каналов, к которым необходимо заджойниться + "channels": { + "assist": "#a", + "notify": "#notify" + }, + + # datadir, куда складываются данные - databases, datafiles, etc + "datadir": "data", + + # Базы данных и их относительные пути (относительно datadir) + "db": { + "notifications": "db/notifications", + "delayed_notifications": "db/delayed_notifications", + "todo": "db/todo" + }, + + # Настройки уведомлений + "notifications": { + # 0 - ничего в канал notify не пишем + "enabled": 1, + # Забываем все нотификашки старее, чем retention_days дней + "retention_days": 2, + # 0 - не показывать Desktop Notification в MacOS/Linux + "desktop_notification": 0, + # Звук уведомлений, желательно абсолютный путь + #"sound": "data/bell.mp3" + }, + + # Отложенные уведомления происходят, джоинится на канал notify + "delayed_notifications": { + "enabled": 1, + "retention_days": 2 + }, + + # Настройки логов + "log" : "meow.log", + "loglevel" : "info", + + # pid-файл + #"pid" : "meow.pid", + + # Превращаемся ли в демона, как обычный unix-style сервис или висим на переднем плане, как systemd-сервис + "daemonize": 0 +} + +# vim: set ft=json noet ai ts=4 sw=4 sts=4: diff --git a/lib/BotLib.pm b/lib/BotLib.pm new file mode 100644 index 0000000..796dc00 --- /dev/null +++ b/lib/BotLib.pm @@ -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: diff --git a/lib/BotLib/Command.pm b/lib/BotLib/Command.pm new file mode 100644 index 0000000..5bdf08d --- /dev/null +++ b/lib/BotLib/Command.pm @@ -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: diff --git a/lib/BotLib/Conf.pm b/lib/BotLib/Conf.pm new file mode 100644 index 0000000..a4c78f4 --- /dev/null +++ b/lib/BotLib/Conf.pm @@ -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: diff --git a/lib/BotLib/Periodic.pm b/lib/BotLib/Periodic.pm new file mode 100644 index 0000000..9ca3981 --- /dev/null +++ b/lib/BotLib/Periodic.pm @@ -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: diff --git a/lib/BotLib/Util.pm b/lib/BotLib/Util.pm new file mode 100644 index 0000000..f09fc7b --- /dev/null +++ b/lib/BotLib/Util.pm @@ -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: diff --git a/lib/IRCBot.pm b/lib/IRCBot.pm new file mode 100644 index 0000000..c065124 --- /dev/null +++ b/lib/IRCBot.pm @@ -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: