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

12
.gitignore vendored Normal file
View File

@@ -0,0 +1,12 @@
.idea/**
.fleet/**
.vscode/**
vendor_perl/**
data/db/**
data/config.json
TODO
.env
*.pid
*.log
_Deparsed_XSubs.pm
.vstags

62
.perlcriticrc Normal file
View File

@@ -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

7
BUGS Normal file
View File

@@ -0,0 +1,7 @@
Известные баги и недоработки.
1. STDOUT и STDERR редиректятся и захватываются в Log::Any с помощью Log::Any::For::Std. В этой связи нет возможности
работать с stdio при запуске внешних команд. И именно поэтому не работают модули IPC::Run и IPC::Run3. Вместо этих
модулей используется классические backticks.
При этом STDERR автоматичеки улетает в лог. Понятное дело, что STDOUT можно либо оставить "как есть" (и он тоже
улетит в лог) или захватить в переменную.

31
DESIGN Normal file
View File

@@ -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, что
касается других ос - не имплементировано.

20
LICENSE.txt Normal file
View File

@@ -0,0 +1,20 @@
Copyright (c) 2022 Sergei Fedosoff <eleksir@gmail.com>
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.

38
README.md Normal file
View File

@@ -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

190
bin/meow-irc-bot Executable file
View File

@@ -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:

5
bootstrap.sh Executable file
View File

@@ -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:

28
cpanfile Normal file
View File

@@ -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";

58
data/config-sample.json Normal file
View File

@@ -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:

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: