diff --git a/.perlcriticrc b/.perlcriticrc index 24a0c29..41f004d 100644 --- a/.perlcriticrc +++ b/.perlcriticrc @@ -89,3 +89,7 @@ lib_sections = NAME | VERSION | DESCRIPTION | AUTHOR | LICENSE AND COPYRIGHT [-InputOutput::RequireBriefOpen] # Yes, i do! + +[-ControlStructures::ProhibitDeepNests] +# Have to use it, so fuckoff + diff --git a/data/sample_config.json b/data/sample_config.json index 80202b9..97972dc 100644 --- a/data/sample_config.json +++ b/data/sample_config.json @@ -1,6 +1,9 @@ { "user" : "nobody", "debug_log" : "/var/log/aleesa-telegram-bot/debug.log", + "admin" : { + "dir" : "data/admin" + }, "friday" : { "dir" : "data/friday", "src" : "data/friday.txt" diff --git a/lib/admin.pm b/lib/admin.pm new file mode 100644 index 0000000..4d8274b --- /dev/null +++ b/lib/admin.pm @@ -0,0 +1,260 @@ +package admin; + +use 5.018; +use strict; +use warnings; +use utf8; +use open qw (:std :utf8); +use English qw ( -no_match_vars ); +use Carp qw (cluck croak); +use File::Path qw (make_path); +use SQLite_File; +use conf qw (loadConf); +use util qw (utf2sha1); + +use version; our $VERSION = qw (1.0); +use Exporter qw (import); +our @ISA = qw / Exporter /; ## no critic (ClassHierarchies::ProhibitExplicitISA) +our @EXPORT_OK = qw (@forbiddenMessageTypes getForbiddenTypes addForbiddenType delForbiddenType listForbidden fortune_toggle fortune_toggle_list fortune_status); + +my $c = loadConf (); +my $dir = $c->{admin}->{dir}; +my @forbiddenMessageTypes = qw (audio voice photo video video_note animation sticker dice game poll document); + +sub initCensorDB { + my $backingfile = shift; + + tie my %censor, 'SQLite_File', $backingfile || cluck "Unable to tie to $backingfile: $OS_ERROR"; + + foreach (@forbiddenMessageTypes) { + $censor($_) = 0; + } + + untie %censor; + + return; +} + +sub getForbiddenTypes { + my $chatid = shift; + + my $messageTypes; + my $backingfile = utf2sha1 $chatid; + $backingfile =~ s/\//-/xmsg; + $backingfile = sprintf '%s/censor_%s.db', $dir, $backingfile; + + unless (-f $backingfile) { + initCensorDB ($backingfile); + } + + unless (tie my %censor, 'SQLite_File', $backingfile) { + cluck "Unable to tie to $backingfile: $OS_ERROR"; + return $messageTypes; + } + + foreach (keys %censor) { + if ($censor{$_}) { + $messageTypes->{$_} = 1; + } else { + $messageTypes->{$_} = 0; + } + } + + untie %censor; + return $messageTypes; +} + +sub addForbiddenType { + my $chatid = shift; + my $type = shift; + + unless (-d $dir) { + unless (make_path $dir) { + cluck "Unable to create $dir: $OS_ERROR"; + return; + } + } + + my $backingfile = utf2sha1 $chatid; + $backingfile =~ s/\//-/xmsg; + $backingfile = sprintf '%s/censor_%s.db', $dir, $backingfile; + + unless (-f $backingfile) { + initCensorDB ($backingfile); + } + + unless (tie my %censor, 'SQLite_File', $backingfile) { + cluck "Unable to tie to $backingfile: $OS_ERROR"; + return; + } + + $censor{$type} = 1; + untie %censor; + + return; +} + +sub delForbiddenType { + my $chatid = shift; + my $type = shift; + + unless (-d $dir) { + unless (make_path $dir) { + cluck "Unable to create $dir: $OS_ERROR"; + return; + } + } + + my $backingfile = utf2sha1 $chatid; + $backingfile =~ s/\//-/xmsg; + $backingfile = sprintf '%s/censor_%s.db', $dir, $backingfile; + + unless (-f $backingfile) { + initCensorDB ($backingfile); + return; + } + + unless (tie my %censor, 'SQLite_File', $backingfile) { + cluck "Unable to tie to $backingfile: $OS_ERROR"; + return; + } + + $censor{$type} = 0; + untie %censor; + + return; +} + +sub listForbidden { + my $chatid = shift; + + my @list; + my $backingfile = utf2sha1 $chatid; + $backingfile =~ s/\//-/xmsg; + $backingfile = sprintf '%s/censor_%s.db', $dir, $backingfile; + + unless (-f $backingfile) { + initCensorDB ($backingfile); + } + + # FIXME: return list with all types alowed + unless (tie my %censor, 'SQLite_File', $backingfile) { + cluck "Unable to tie to $backingfile: $OS_ERROR"; + return ''; + } + + foreach (keys %censor) { + if ($censor{$_}) { + push @list, sprintf 'Тип сообщения %s удаляется', $_; + } else { + push @list, sprintf 'Тип сообщения %s не удаляется', $_; + } + } + + untie %censor; + + return join "\n", @list; +} + +sub fortune_toggle (@) { + my $chatid = shift; + my $action = shift // undef; + my $phrase = 'Фортунка с утра '; + + unless (-d $dir) { + make_path ($dir) || do { + cluck "[ERROR] Unable to create $dir: $OS_ERROR"; + return; + }; + } + + my $backingfile = sprintf '%s/chats.sqlite', $dir; + + tie my %toggle, 'SQLite_File', $backingfile || do { + cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR"; + return; + }; + + my $state = $toggle{$chatid}; + + if (defined $action) { + if ($action) { + $toggle{$chatid} = 1; + $phrase .= 'будет показываться.'; + } else { + if (defined $state) { + delete $toggle{$chatid}; + } + + $phrase .= 'не будет показываться.'; + } + } else { + if (defined $state && $state) { + delete $toggle{$chatid}; + $phrase .= 'не будет показываться.'; + } else { + $toggle{$chatid} = 1; + $phrase .= 'будет показываться.'; + } + } + + untie %toggle; + return $phrase; +} + +sub fortune_status ($) { + my $chatid = shift; + my $phrase = 'Фортунка с утра '; + + unless (-d $dir) { + make_path ($dir) || do { + cluck "[ERROR] Unable to create $dir: $OS_ERROR"; + return; + }; + } + + my $backingfile = sprintf '%s/chats.sqlite', $dir; + + tie my %toggle, 'SQLite_File', $backingfile || do { + cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR\n"; + return; + }; + + my $state = $toggle{$chatid}; + + if (defined $state && $state) { + $phrase .= 'показывается.'; + } else { + $phrase .= 'не показывается.'; + } + + untie %toggle; + return $phrase; +} + +sub fortune_toggle_list () { + unless (-d $dir) { + make_path ($dir) || do { + cluck "[ERROR] Unable to create $dir: $OS_ERROR"; + my @empty = (); + return @empty; + } + } + + my $backingfile = sprintf '%s/chats.sqlite', $dir; + + tie my %toggle, 'SQLite_File', $backingfile || do { + cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR"; + my @empty = (); + return @empty; + }; + + my @list = keys %toggle; + untie %toggle; + return @list; +} + + +1; + +# vim: set ft=perl noet ai ts=4 sw=4 sts=4: diff --git a/lib/botlib.pm b/lib/botlib.pm index 99a93b9..7296102 100644 --- a/lib/botlib.pm +++ b/lib/botlib.pm @@ -11,9 +11,10 @@ use Carp qw (carp); use Math::Random::Secure qw (irand); use conf qw (loadConf); +use admin qw (@forbiddenMessageTypes getForbiddenTypes addForbiddenType delForbiddenType listForbidden fortune_toggle fortune_status); use archeologist qw (dig); use fisher qw (fish); -use fortune qw (fortune fortune_toggle fortune_status); +use fortune qw (fortune); use friday qw (friday); use karma qw (karmaSet karmaGet); use kitty qw (kitty); @@ -23,7 +24,7 @@ use weather qw (weather); use version; our $VERSION = qw (1.0); use Exporter qw (import); -our @EXPORT_OK = qw (randomCommonPhrase command highlight botsleep); +our @EXPORT_OK = qw (randomCommonPhrase command highlight botsleep isCensored); my $c = loadConf (); my $csign = $c->{telegrambot}->{csign}; @@ -93,12 +94,6 @@ sub command { $reply = sprintf "```\n%s\n```\n", trim (fortune ()); $msg->replyMd ($reply); return; - } elsif (substr ($text, 1) eq 'f 1' || substr ($text, 1) eq 'fortune 1' || substr ($text, 1) eq 'фортунка 1' || substr ($text, 1) eq 'ф 1') { - $reply = fortune_toggle ($chatid, 1); - } elsif (substr ($text, 1) eq 'f 0' || substr ($text, 1) eq 'fortune 0' || substr ($text, 1) eq 'фортунка 0' || substr ($text, 1) eq 'ф 0') { - $reply = fortune_toggle ($chatid, 0); - } elsif (substr ($text, 1) eq 'f ?' || substr ($text, 1) eq 'fortune ?' || substr ($text, 1) eq 'фортунка ?' || substr ($text, 1) eq 'ф ?') { - $reply = fortune_status ($chatid); } elsif (substr ($text, 1) eq 'dig' || substr ($text, 1) eq 'копать') { $reply = dig $highlight; $msg->typing (); @@ -121,10 +116,6 @@ ${csign}fish | ${csign}рыба | ${csign}рыбка - порыбачить ${csign}fishing | ${csign}рыбалка - порыбачить ${csign}f | ${csign}ф - рандомная фраза из сборника цитат fortune_mod ${csign}fortune | ${csign}фортунка - рандомная фраза из сборника цитат fortune_mod -${csign}f # | ${csign}ф # - где 1 - вкл, 0 - выкл фортунку с утра -${csign}fortune # | ${csign}фортунка # - где 1 - вкл, 0 - выкл фортунку с утра -${csign}f ? | ${csign}ф ? - показываем ли с утра фортунку для чата -${csign}fortune ? | ${csign}фортунка ? - показываем ли с утра фортунку для чата ${csign}friday | ${csign}пятница - а не пятница ли сегодня? ${csign}lat | ${csign}лат - сгенерить фразу из крылатых латинских выражений ${csign}ping | ${csign}пинг - попинговать бота @@ -138,6 +129,71 @@ ${csign}karma фраза | ${csign}карма фраза - посмотреть MYHELP $msg->replyMd ($reply); return; + } elsif (substr ($text, 1) eq 'admin' || substr ($text, 1) eq 'админ') { + my $member = $self->getChatMember ($msg->from->id); + + # this msg should be shown only if admins of chat request it + if ($member->status eq 'administrator') || ($member->status eq 'creator') { + $reply = << "MYADMIN"; +``` +${csign}admin censor type # - где 1 - вкл, 0 - выкл цензуры для означенного типа сообщений +${csign}админ ценз тип # - где 1 - вкл, 0 - выкл цензуры для означенного типа сообщений +${csign}admin censor - показать список состояния типов сообщений +${csign}админ ценз - показать список состояния типов сообщений +${csign}admin fortune # - где 1 - вкл, 0 - выкл фортунку с утра +${csign}admin фортунка # - где 1 - вкл, 0 - выкл фортунку с утра +${csign}admin fortune - показываем ли с утра фортунку для чата +${csign}admin фортунка - показываем ли с утра фортунку для чата +``` +Типы сообщений: +audio voice photo video video_note animation sticker dice game poll document +MYADMIN + $msg->replyMd ($reply); + } + + return; + } elsif ((substr ($text, 1, 5) eq 'admin' || substr ($text, 1, 5) eq 'админ') and (length ($text >= 8))) { + my $member = $self->getChatMember ($msg->from->id); + + # this msg should be shown only if admins of chat request it + if ($member->status eq 'administrator') || ($member->status eq 'creator') { + my $command = trim (substr $text, 7); + my ($cmd, $args) = split /\s+/, $command, 2; + + if ($cmd eq '') { + return; + } elsif ($cmd eq 'censor' || $cmd eq 'ценз') { + if (defined $args && args ne '') { + my ($msgType, $toggle) = split /\s/, $args; + + if (defined $toggle) { + foreach (@forbiddenMessageTypes) { + if ($msgType eq $_) { + if ($toggle == 1) { + addForbiddenType ($chatid, $msgType); + $reply = "Теперь сообщения с $msgType будут автоматически удаляться"; + } elsif ($toggle == 0) { + delForbiddenType ($chatid, $msgType); + $reply = "Теперь сообщения с $msgType будут оставаться"; + } + } + } + } + } else { + $reply = listForbidden ($chatid); + } + } elsif ($cmd eq 'fortune' || $cmd eq 'фортунка') { + if (defined $args) { + if ($args == 1) { + $reply = fortune_toggle ($chatid, 1); + } elsif ($args == 0) { + $reply = fortune_toggle ($chatid, 0); + } + } else { + $reply = fortune_status ($chatid); + } + } + } } return $reply; @@ -201,6 +257,20 @@ sub botsleep { return; } +sub isCensored { + my $msg = shift; + + $forbidden = getForbiddenTypes ($msg->{chat}->{id}); + + foreach (keys %{%forbidden}) { + if ($forbidden->{$_} && $msg->can ($_) && (defined $msg->{$_})) { + return 1; + } + } + + return 0; +} + 1; # vim: set ft=perl noet ai ts=4 sw=4 sts=4: diff --git a/lib/fortune.pm b/lib/fortune.pm index f61d6fa..da667d2 100644 --- a/lib/fortune.pm +++ b/lib/fortune.pm @@ -15,7 +15,7 @@ use conf qw (loadConf); use version; our $VERSION = qw (1.0); use Exporter qw (import); -our @EXPORT_OK = qw (seed fortune fortune_toggle fortune_toggle_list fortune_status); +our @EXPORT_OK = qw (seed fortune); my $c = loadConf (); my $dir = $c->{fortune}->{dir}; @@ -80,104 +80,6 @@ sub fortune () { return $phrase; } -sub fortune_toggle (@) { - my $chatid = shift; - my $action = shift // undef; - my $phrase = 'Фортунка с утра '; - - unless (-d $dir) { - make_path ($dir) || do { - cluck "[ERROR] Unable to create $dir: $OS_ERROR"; - return; - }; - } - - my $backingfile = sprintf '%s/chats.sqlite', $dir; - - tie my %toggle, 'SQLite_File', $backingfile || do { - cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR"; - return; - }; - - my $state = $toggle{$chatid}; - - if (defined $action) { - if ($action) { - $toggle{$chatid} = 1; - $phrase .= 'будет показываться.'; - } else { - if (defined $state) { - delete $toggle{$chatid}; - } - - $phrase .= 'не будет показываться.'; - } - } else { - if (defined $state && $state) { - delete $toggle{$chatid}; - $phrase .= 'не будет показываться.'; - } else { - $toggle{$chatid} = 1; - $phrase .= 'будет показываться.'; - } - } - - untie %toggle; - return $phrase; -} - -sub fortune_status ($) { - my $chatid = shift; - my $phrase = 'Фортунка с утра '; - - unless (-d $dir) { - make_path ($dir) || do { - cluck "[ERROR] Unable to create $dir: $OS_ERROR"; - return; - }; - } - - my $backingfile = sprintf '%s/chats.sqlite', $dir; - - tie my %toggle, 'SQLite_File', $backingfile || do { - cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR\n"; - return; - }; - - my $state = $toggle{$chatid}; - - if (defined $state && $state) { - $phrase .= 'показывается.'; - } else { - $phrase .= 'не показывается.'; - } - - untie %toggle; - return $phrase; -} - -sub fortune_toggle_list () { - unless (-d $dir) { - make_path ($dir) || do { - cluck "[ERROR] Unable to create $dir: $OS_ERROR"; - my @empty = (); - return @empty; - } - } - - my $backingfile = sprintf '%s/chats.sqlite', $dir; - - tie my %toggle, 'SQLite_File', $backingfile || do { - cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR"; - my @empty = (); - return @empty; - }; - - my @list = keys %toggle; - untie %toggle; - return @list; -} - 1; # vim: ft=perl noet ai ts=4 sw=4 sts=4: diff --git a/lib/telegrambot.pm b/lib/telegrambot.pm index 62fe4c5..3c54051 100644 --- a/lib/telegrambot.pm +++ b/lib/telegrambot.pm @@ -13,9 +13,10 @@ use File::Path qw (make_path); use Hailo; use Math::Random::Secure qw (irand); use Mojo::Base 'Teapot::Bot::Brain'; -use botlib qw (randomCommonPhrase command highlight botsleep); +use admin qw (fortune_toggle_list); +use botlib qw (randomCommonPhrase command highlight botsleep isCensored); use conf qw (loadConf); -use fortune qw (fortune fortune_toggle_list); +use fortune qw (fortune); use karma qw (karmaSet); use util qw (trim fmatch); @@ -51,7 +52,7 @@ sub __cron { $send_args->{text} = sprintf "%s\n```\n%s\n```\n", $intro[irand ($#intro + 1)], trim (fortune ()); $send_args->{chat_id} = $enabledfortunechat; $send_args->{parse_mode} = 'Markdown'; - Teapot::Bot::Brain::sendMessage ($self, $send_args); + $self->sendMessage ($send_args); } } @@ -68,7 +69,7 @@ sub __on_msg { my $csign = $c->{telegrambot}->{csign}; unless ($myid) { - my $myObj = Teapot::Bot::Brain::getMe ($self); + my $myObj = $self->getMe (); unless ($myObj) { carp '[ERROR] Unable to get chatid, API Error?'; @@ -212,13 +213,18 @@ sub __on_msg { if (defined $reply) { $msg->typing (); sleep 1; - carp sprintf ("[DEBUG] Private chat bot reply to $vis_a_vi: %s", $reply) if $c->{debug}; + carp sprintf ('[DEBUG] Private chat bot reply to %s: %s', $vis_a_vi, $reply) if $c->{debug}; $msg->reply ($reply); } # group chat } elsif (($msg->chat->type eq 'supergroup') or ($msg->chat->type eq 'group')) { my $reply; + if (isCensored $msg) { + carp '[INFO] In public chat %s (%s) message from %s was censored', $chatname, $chatid, $vis_a_vi; + $self->deleteMessage ({chat_id => $chatid, message_id => $msg->{message_id}}); + } + # detect and log messages without text, noop here unless (defined $msg->text) { carp sprintf ('[INFO] No text in message from %s', $vis_a_vi);