#!/usr/bin/perl # Бот для абонентов # Ю. Жиловец, 29 мая 2024 года use Modern::Perl; use utf8; use EV; use Mojo::Base -strict, -signatures; use Mojolicious::Lite; use Mojo::UserAgent; use Data::Dumper; use Mojo::Promise; use Mojo::JSON qw/j/; use NetAddr::IP; use HTML::Restrict; use Redis; use Mojo::Promise; use Time::timegm qw/timegm/; use POSIX::strptime; use experimental qw/signatures/; use FindBin qw/$Bin/; use lib "$Bin/lib"; use lib "$Bin/modules"; use darsan_auth; use darsan_client; use rabbit_async_rec; use commands; use fsa; use abon_client; use localization; my $NAME = "abonbot"; my $confdir = app->home.'/config/'.app->mode; plugin yaml_config => { file => "$confdir/$NAME.cfg", stash_key => 'config', }; our $config = app->config; app->secrets(["Marsz, Marsz, Dabrowski"]); # https://core.telegram.org/bots/api#formatting-options my $html_strip = HTML::Restrict->new(rules => { b => [], strong => [], i => [], em => [], u => [], ins => [], s => [], strike => [], del => [], a => [qw/href/], code => [qw/class/], pre => [], }); my $auth = darsan_auth->as_server($config->{darsan}->{auth}, "system", "$confdir/system.private"); our $client = darsan_client->new($auth, $config->{darsan}->{servers}); $client->map($config->{darsan_map}) if $config->{darsan_map}; our $redis = Redis->new(server => $config->{redis}, name=>"abonbot"); our $abon_client = abon_client->new; my $term; my $int; my $hup; my $log = new Mojo::Log; Mojo::IOLoop->next_tick(sub { $term = AnyEvent->signal(signal => "TERM", cb => \&terminate); $int = AnyEvent->signal(signal => "INT", cb => \&terminate); $hup = AnyEvent->signal(signal => "HUP", cb => \&terminate); }); ########################## my $ua = new Mojo::UserAgent; $ua->max_redirects(5); our $fsa; our $commands; my $locale_dir = "$Bin/locale"; my $locales = localization::available_locales($locale_dir); my $locale_handles = localization->add_mo($locale_dir, $locales); our $kb_menu = [[ map { _($_->{name}) } grep {!$_->{hide_in_kb}} @$commands, ]]; ########################## =cut hook before_dispatch => sub { my $c = shift; say $c->req->to_string; }; hook after_dispatch => sub { my $c = shift; say $c->res->to_string; }; =cut ############################################### get "/health" => sub { shift->render(text => "Abonbot OK"); }; post "/:token" => sub { my $c = shift; unless ($c->param("token") eq $config->{token}) { return $c->render(status=>401, text=>"Request from unknown URL"); } $c->render(text=>"ok"); my $body = j($c->req->body); #say Dumper $body; my ($from, $chatid, $cmd); if (my $m = $body->{message} || $body->{edited_message}) { $from = $m->{from}; $chatid = $from->{id}; $cmd = $m->{text}; $from->{msgid} = $m->{message_id}; } elsif ($m = $body->{callback_query}) { $from = $m->{from}; $chatid = $from->{id}; $cmd = $m->{data}; $from->{msgid} = $m->{message}->{message_id}; } else { return $log->error("Unknown message type"); } say ">>> $cmd"; restore_fsa_state($chatid, $from); process_input($cmd, $chatid, $from); save_fsa_state($chatid); }; =cut $VAR1 = { 'callback_query' => { 'data' => '32320/set-credit', 'from' => { 'id' => 311683401, 'username' => 'AntonMetelkin2', 'first_name' => "\x{410}\x{43d}\x{442}\x{43e}\x{43d}", 'language_code' => 'ru', 'last_name' => "\x{41c}\x{435}\x{442}\x{451}\x{43b}\x{43a}\x{438}\x{43d}", 'is_bot' => bless( do{\(my $o = 0)}, 'JSON::PP::Boolean' ) }, 'chat_instance' => '4165635351277858977', 'id' => '1338670018114168009', 'message' => { 'reply_markup' => { 'inline_keyboard' => [ [ { 'callback_data' => '32320/set-credit', 'text' => "\x{42f} \x{441}\x{43e}\x{433}\x{43b}\x{430}\x{441}\x{435}\x{43d} \x{441} \x{443}\x{441}\x{43b}\x{43e}\x{432}\x{438}\x{44f}\x{43c}\x{438}" } ] ] }, 'text' => "\x{412}\x{44b} \x{43c}\x{43e}\x{436}\x{435}\x{442}\x{435} \x{441}\x{430}\x{43c}\x{43e}\x{441}\x{442}\x{43e}\x{44f}\x{442}\x{435}\x{43b}\x{44c}\x{43d}\x{43e} \x{443}\x{441}\x{442}\x{430}\x{43d}\x{43e}\x{432}\x{438}\x{442}\x{44c} \x{43a}\x{440}\x{435}\x{434}\x{438}\x{442} \x{43d}\x{430} \x{434}\x{432}\x{430} \x{434}\x{43d}\x{44f} \x{41e}\x{433}\x{440}\x{430}\x{43d}\x{438}\x{447}\x{435}\x{43d}\x{438}\x{44f}: \x{442}\x{43e}\x{43b}\x{44c}\x{43a}\x{43e} \x{434}\x{43b}\x{44f} \x{444}\x{438}\x{437}\x{438}\x{447}\x{435}\x{441}\x{43a}\x{438}\x{445} \x{43b}\x{438}\x{446}, \x{43f}\x{440}\x{43e}\x{434}\x{43b}\x{435}\x{432}\x{430}\x{442}\x{44c} \x{43a}\x{440}\x{435}\x{434}\x{438}\x{442} \x{43f}\x{43e}\x{432}\x{442}\x{43e}\x{440}\x{43d}\x{43e} \x{434}\x{43e} \x{43e}\x{43f}\x{43b}\x{430}\x{442}\x{44b} \x{43d}\x{435}\x{43b}\x{44c}\x{437}\x{44f}. \x{41f}\x{440}\x{438} \x{441}\x{43b}\x{435}\x{434}\x{443}\x{44e}\x{449}\x{435}\x{439} \x{43e}\x{43f}\x{43b}\x{430}\x{442}\x{435} \x{43a}\x{440}\x{435}\x{434}\x{438}\x{442} \x{431}\x{443}\x{434}\x{435}\x{442} \x{43f}\x{43e}\x{433}\x{430}\x{448}\x{435}\x{43d}", 'entities' => [ { 'type' => 'bold', 'offset' => 54, 'length' => 11 } ], 'message_id' => 995, 'chat' => { 'last_name' => "\x{41c}\x{435}\x{442}\x{451}\x{43b}\x{43a}\x{438}\x{43d}", 'id' => 311683401, 'type' => 'private', 'username' => 'AntonMetelkin2', 'first_name' => "\x{410}\x{43d}\x{442}\x{43e}\x{43d}" }, 'from' => { 'is_bot' => bless( do{\(my $o = 1)}, 'JSON::PP::Boolean' ), 'first_name' => "\x{41c}\x{430}\x{43a}\x{435}\x{435}\x{432}\x{43a}\x{430}-\x{41e}\x{43d}\x{43b}\x{430}\x{439}\x{43d}", 'id' => 7443432620, 'username' => 'MolAbonBot' }, 'date' => 1723730668 } }, 'update_id' => 292858034 }; =cut ################################## sub terminate { request("setWebhook", {url=>""})->then(sub { exit(0); })->catch(sub { $log->error(Dumper @_); }); } sub request { my $action = shift; my $params = shift; $ua->post_p("https://api.telegram.org/bot$config->{token}/$action" => json => $params) ->then(sub { my $tx = shift; my $resp = $tx->result; if ($resp->is_error) { my $err = {}; $err->{code} = $resp->code; $err->{url} = $tx->req->url->to_string; $err->{body} = $resp->body; $err->{body} = j($err->{body}) if $resp->headers->content_type eq "application/json"; $log->error(Dumper $err); } else { my $body = $resp->body; $body = j($body) if $resp->headers->content_type eq "application/json"; $body; } }) ->catch(sub { my $tx = shift; my $resp = $tx->result; my $err = {}; $err->{code} = $resp->code; $err->{url} = $tx->req->url->to_string; $err->{body} = $resp->body; $err->{body} = j($err->{body}) if $resp->headers->content_type eq "application/json"; $log->error(Dumper $err); }); } sub notify { my $chatid = shift; my $message = shift; my $rest = shift || {}; my $params = { chat_id => $chatid, text => $message, disable_web_page_preview => 1, }; $params->{parse_mode} ||= "HTML"; $params->{reply_to} = $rest->{reply_to} if $rest->{reply_to}; $params->{disable_notification} = 1 if $rest->{silent}; if ($rest->{menu}) { $params->{reply_markup} = { keyboard => $rest->{menu} }; $params->{resize_keyboard} = Mojo::JSON->true; } if ($rest->{inline_menu}) { $params->{reply_markup} = { inline_keyboard => $rest->{inline_menu} }; } my $disable_error_handler = delete $params->{disable_error_handler}; if ($params->{parse_mode} eq "HTML") { $params->{text} = $html_strip->process($params->{text}); } my $promise = request("sendMessage", $params); unless ($disable_error_handler) { $promise = $promise->catch(sub { $log->error(Dumper $params,@_); }); } return $promise; } sub reply($rec, @lines) { return notify($rec->{id}, join("\n", @lines), {reply_to=>$rec->{msgid}}); } sub reply_with($rec, $params, @lines) { $params->{reply_to} = $rec->{msgid}; return notify($rec->{id}, join("\n", @lines), $params); } ################################# sub do_command { my $cmd = shift; my $chatid = shift; my $rest = shift; local($Data::Dumper::Terse) = 1; my ($c,@args) = split(/\s+/,$cmd); $c =~ s|^/||; $c =~ s/\@MolAbonbotBot$//; if ($chatid<0) { return notify($chatid, _("Этот бот не работает в чатах"), $rest); } my $sub = refpath("command_$c"); unless ($sub) { return notify($chatid, _("Неизвестная команда"), $rest); } my $state; eval { my $res = $sub->($chatid, $fsa->notes("uid"), $rest); if (ref $res eq "Mojo::Promise") { $res->catch(sub($err) { $log->error(Dumper $err); }); } }; if ($@) { my $msg = ref $@ eq "HASH" ? Dumper($@) : $@; $log->error("$cmd from $chatid: $msg"); notify($chatid, "Ошибка при выполнении команды $cmd: $msg"); return; } } sub refpath { my $name = shift; $name =~ tr/.-/_/; $name =~ s|/|::|g; return reference($name); } sub reference { my $name = shift; return exists(&{$name}) ? \&{$name} : undef; } sub make_key($id, $type) { return "ab-$id-$type"; } sub _loc($lang, $str) { return $str unless exists $locale_handles->{$lang}; return $locale_handles->{$lang}->maketext($str); } sub _($str) { return _loc($fsa->notes("lang") || "ru", $str); } sub parse_time { no warnings; my $s = shift; my $time_format = "%Y-%m-%d %H:%M:%S%z"; $s =~ /([+-])(\d{4})$/; my $tz_sign = $1; my $tz = $2; $s =~ s/[+-]\d{4}$//; my $time = timegm(POSIX::strptime($s, $time_format)); if ($tz) { my $h = substr($tz, 0, 2); my $s = substr($tz, 2, 2); my $offset = ($h * 60 + $s) * 60; $offset = -$offset if $tz_sign eq "+"; $time += $offset; } return $time; } sub format_time($str) { my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(parse_time($str)); return sprintf("%2d.%02d.%d %2d:%02d", $mday, $mon+1, $year+1900, $hour, $min); } sub format_date($str) { my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(parse_time($str)); return sprintf("%2d.%02d.%d", $mday, $mon+1, $year+1900); } ###################################### $log->info("Started (".app->mode.")"); request("setWebhook",{url=>""})->then(sub { $log->info("Webhook to $config->{webhook}"); return request("setWebhook", {url=>"$config->{webhook}/$config->{token}"}); }) ->then(sub { my $list = [ map { {command=>$_->{command}, description=>$_->{description}} } @$commands ]; return request("setMyCommands", {language_code=>"ru", commands=>$list }); }) ->then(sub { my @promises = map { my $locale = $_; my $list = [ map { {command=>$_->{command}, description=>_loc($locale, $_->{description})} } @$commands ]; request("setMyCommands", {language_code=>$_, commands=>$list }) } @$locales; return Mojo::Promise->all(@promises); }) ->catch(sub { $log->error(Dumper @_); }); app->start;