abonbot/abonbot.pl

#!/usr/bin/perl

# Бот-исполнитель запросов техподдержки
# Ю. Жиловец, 11 января 2023 года

use Modern::Perl;
use utf8;

use EV;
use AnyEvent;
use Mojolicious::Lite;
use Mojo::UserAgent;
use Data::Dumper;
use Mojo::Promise;
use Mojo::JSON qw/j/;
use NetAddr::IP;
use HTML::Restrict;
use Attribute::Handlers;
use Redis;

use FindBin qw/$Bin/;
use lib "$Bin/lib";
use lib "$Bin/modules";

use darsan_auth;
use darsan_client;

our $log = Mojo::Log->new;
our %aliases;

use alias;
use commands;

my $NAME = "djinn";
my $confdir = app->home.'/config/'.app->mode;

use rabbit_async_rec;

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});

my $term;
my $int;
my $hup;

our $redis;

if ($config->{redis} =~ m|/|)
{
  $redis = Redis->new(sock => $config->{redis}, name=>"poller");
}
else
{
  $redis = Redis->new(server => $config->{redis}, name=>"poller");
}

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);

##########################

=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 => "Djinn OK");
};

post "/:token" => sub
{
  my $c = shift;

  $c->render(text=>"ok");

  unless ($c->param("token") eq $config->{token})
  {
    return $c->render(status=>401, text=>"Request from unknown URL");
  }

  my $body = j($c->req->body);
  my $m = $body->{message} || $body->{edited_message};

  my $chatid = $m->{chat}->{id};

  if ($m->{chat}->{type} ne "supergroup")
  {
    return notify($chatid, "Общение с ботом возможно только в чате");
  }

  my $from = $m->{from};
  my $cmd = $m->{text};
  my $msgid = $m->{message_id};

  return unless substr($cmd, 0, 1) eq "/"; # Бот не должен мешать общению, даже если его добавили админом

  do_command($cmd, $chatid, {msgid=>$msgid, from=>$from});
};

##################################

sub terminate
{
  request("setWebhook", {url=>""})->then(sub
  {
    exit(0);
  })->catch(sub
  {
    $log->error(Dumper @_);
  });
}

sub request
{
  my $action = shift;
  my $params = shift;

  return $ua->post_p("https://api.telegram.org/bot$config->{token}/$action" => form => $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";
       die $err;
     }
     else
     {
       my $body = $resp->body;
       $body = j($body) if $resp->headers->content_type eq "application/json";
       $body;
     }
   });
}

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_message_id} = $rest->{reply_to} if $rest->{reply_to};
  $params->{disable_notification} = 1 if $rest->{silent};

  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 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/\@MolDjinnBot$//;

  my $sub = reference("command_$c") || $aliases{$c};

  unless ($sub)
  {
    return notify($chatid, "Неизвестная команда. Введите <b>/help</b>, чтобы увидеть список команд", $rest);
  }

  eval {
    $sub->($c, \@args, $chatid, $rest);
  };

  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;
}

######################################

$log->info("Started (".app->mode.")");

request("setWebhook",{url=>""})->then(sub
{
  $log->info("Webhook to $config->{webhook}");
  return request("setWebhook", {url=>"$config->{webhook}/$config->{token}"});
})->catch(sub
{
  $log->error(Dumper @_);
});

app->start;