START

.gitignore

@@ -0,0 +1 @@
+config/*

a.pl

@@ -0,0 +1,6 @@
+use strict;
+use warnings;
+
+$SIG{INT} = sub { die "Caught a sigint $!" };
+
+sleep(20);

config/mak/telegram.cfg

@@ -0,0 +1,14 @@
+log: /home/yzhilovets/telegram/telegram.log
+
+#http://telegram.me/MakeevkaOnlineBot
+token: 286383352:AAHCHzJLMUCc9d6BB1Y9m7oB7T3jqbYTG9g
+
+webhook: https://telegram.mol.net.ua
+
+rabbit:
+  host: rabbit.mol.net.ua
+  user: admin
+  password: russian-blue
+      
+queue: notify.telegram
+bind: notify.telegram.#

config/test/telegram.cfg

@@ -0,0 +1,15 @@
+log: /home/yzhilovets/telegram/telegram.log
+
+#http://telegram.me/MakeevkaOnlineBot
+
+token: 286383352:AAHCHzJLMUCc9d6BB1Y9m7oB7T3jqbYTG9g
+
+webhook: https://telegram.mol.net.ua
+
+rabbit:
+  host: dev.mol.net.ua
+  user: guest
+  password: guest
+      
+queue: notify.telegram
+bind: notify.telegram.#

lib/rabbit_async.pm

@@ -0,0 +1,250 @@
+#!/usr/bin/perl
+
+# Асинхронный доступ к RabbitMQ
+# Юрий Жиловец, 20.08.2015
+
+package rabbit_async;
+
+use Modern::Perl;
+use EV;
+use AnyEvent;
+use AnyEvent::RabbitMQ;
+use Data::Dumper;
+use Mojo::JSON qw/j/;
+
+sub new
+{
+  my $class = shift;
+  my $arg = shift;
+  my $callback = shift;
+    
+  my $host = $arg->{host};
+  my $user = $arg->{user};
+  my $password = $arg->{password};
+  
+  my $rab = AnyEvent::RabbitMQ->new->load_xml_spec();
+#  $rab->{verbose}= 1;
+  my $on_error = $arg->{on_error} || sub { say "RabbitMQ error: ".shift(); exit() };
+  
+  my $self = bless {rabbit=>$rab, on_error=>$on_error, host=>$host, user=>$user, password=>$password};
+  $self->_connect($callback);
+              
+  return $self;
+}
+
+sub _connect
+{
+  my $self = shift;
+  my $callback = shift;
+
+  $self->{rabbit}->connect(
+    host => $self->{host},
+    port => 5672,
+    user => $self->{user},
+    pass => $self->{password},
+    vhost => "/",
+    timeout => 1,
+    tls => 0,
+    tune => { heartbeat => 30, channel_max => 1 },
+    
+    on_failure => sub { $self->{on_error}->("connect failure: ".$_[2]) },
+    
+    on_read_failure => sub { $self->{on_error}->(@_) },
+    
+    on_return  => sub {
+      my $frame = shift;
+      $self->{on_error}->("Unable to deliver frame" . Dumper($frame));
+    },
+    
+    on_close   => sub {
+      my $why = shift;
+      if (ref($why)) {
+        my $method_frame = $why->method_frame;
+        $self->{on_error}->($method_frame->reply_code. ": ". $method_frame->reply_text);
+      }
+      else {
+        $self->{on_error}->($why);
+      }
+    },
+    
+    on_success => sub 
+    {
+      my $ar = shift;
+      $ar->open_channel(
+        on_success => sub 
+        {
+          my $channel = shift;
+          $self->{channel} = $channel;
+          $callback->() if $callback;
+        },
+        on_failure =>  sub { $self->{on_error}->("channel failure: ".$_[2]) },
+        on_close   => sub 
+        {
+          my $method_frame = shift->method_frame;
+          $self->{on_error}->($method_frame->reply_code . $method_frame->reply_text);
+        },
+      );
+    },
+  );
+}
+
+sub send
+{
+  my $self = shift;
+  my $key = shift;
+  my $obj = shift || {};
+  my $header = shift || {};
+  
+  $header->{delivery_mode} = 2;
+
+  $self->{channel}->publish(
+    body => j($obj),
+    exchange => "mol",
+    routing_key => $key,
+    header => $header,
+  );
+}
+
+sub emit
+{
+  my $self = shift;
+  my $key = shift;
+  my $obj = shift || {};
+  my $header = shift || {};
+  
+  $header->{delivery_mode} = 1;
+  
+  $self->{channel}->publish(
+    body => j($obj),
+    exchange => "mol",
+    routing_key => $key,
+    header => $header,
+  );
+}
+
+sub subscribe
+{
+  my $self = shift;
+  my $keys = shift;
+  my $callback = shift;
+  
+  $self->{channel}->declare_queue(
+    queue => "",
+    no_ack => 1,
+    durable => 0,
+    exclusive => 1,
+    on_failure => sub { $self->{on_error}->("declare queue failure: ".$_[2]) },
+    on_success => sub
+    {
+      my $method = shift;
+      my $name   = $method->method_frame->queue;
+      
+      $keys = [ $keys] unless ref($keys) eq "ARRAY";
+      foreach (@$keys)
+      {
+        $self->{channel}->bind_queue(
+          queue => $name,
+          exchange => "mol",
+          routing_key => $_,
+          on_failure => sub { $self->{on_error}->("bind queue failure: ".$_[0]) },
+          on_success => sub
+          {
+            $self->{channel}->consume(
+              queue => $name,
+              no_ack => 1,
+              on_failure => sub { $self->{on_error}->("consume failure: ".$_[0]) },
+              on_consume => sub
+              {
+                my $msg = shift;
+                $callback->({
+                  message => $msg,
+                  content => j($msg->{body}->{payload}),
+                  header =>  $msg->{header},
+                  routing_key => $msg->{deliver}->{method_frame}->{routing_key},
+               });
+              },
+            );
+          },
+        );
+      }
+    }
+  );
+}
+
+
+sub listen_queue
+{
+  my $self = shift;
+  my $queue = shift;
+  my $bind = shift;
+  my $callback = shift;
+  
+  $self->{channel}->declare_queue(
+    queue => $queue,
+    no_ack => 0,
+    durable => 1,
+    auto_delete => 0,
+    on_failure => sub { $self->{on_error}->("declare queue failure: ".$_[2]) },
+    on_success => sub
+    {
+      my $method = shift;
+      my $name   = $method->method_frame->queue;
+      
+      $self->{channel}->bind_queue(
+          queue => $queue,
+          exchange => "mol",
+          routing_key => $bind,
+      );
+      
+      $self->{channel}->consume(
+        queue => $queue,
+        no_ack => 0,
+        on_failure => sub { $self->{on_error}->("consume failure: ".$_[2]) },
+        on_consume => sub
+        {
+          my $msg = shift;
+          $callback->({
+            message => $msg,
+            content => j($msg->{body}->{payload}),
+            header =>  $msg->{header},
+            routing_key => $msg->{deliver}->{method_frame}->{routing_key},
+          });
+        },
+      );
+    }
+  );
+}
+
+sub ack
+{
+  my $self = shift;
+  my $m = shift;
+  
+  $self->{channel}->ack(
+    delivery_tag => $m->{deliver}->{method_frame}->{delivery_tag},
+  );
+}
+
+sub reject
+{
+  my $self = shift;
+  my $m = shift;
+  
+  $self->{channel}->reject(
+    delivery_tag => $m->{deliver}->{method_frame}->{delivery_tag},
+    requeue => 0,
+  );
+}
+
+sub requeue
+{
+  my $self = shift;
+  my $m = shift;
+
+  $self->{channel}->reject(
+    delivery_tag => $m->{deliver}->{method_frame}->{delivery_tag},
+    requeue => 1,
+  );
+}
+
+1;

run

@@ -0,0 +1 @@
+MOJO_LOG_LEVEL=debug perl telegram.pl daemon --mode test --listen http://*:2229

telegram.log

@@ -0,0 +1,89 @@
+[Mon Nov  7 20:18:09 2016] [info] Started (test)
+[Mon Nov  7 20:18:27 2016] [info] Started (test)
+[Mon Nov  7 20:30:40 2016] [info] Started (test)
+[Mon Nov  7 20:31:14 2016] [info] Started (test)
+[Mon Nov  7 20:31:29 2016] [info] Started (test)
+[Mon Nov  7 20:31:46 2016] [info] Started (test)
+[Mon Nov  7 20:33:23 2016] [info] Started (test)
+[Mon Nov  7 20:33:26 2016] [info] Started (test)
+[Mon Nov  7 20:33:42 2016] [info] Started (test)
+[Mon Nov  7 20:33:59 2016] [info] Started (test)
+[Mon Nov  7 20:36:27 2016] [info] Started (test)
+[Mon Nov  7 20:36:57 2016] [info] Started (test)
+[Mon Nov  7 20:37:01 2016] [info] Started (test)
+[Mon Nov  7 20:37:07 2016] [info] Started (test)
+[Mon Nov  7 20:37:53 2016] [info] Started (test)
+[Mon Nov  7 20:39:27 2016] [info] Started (test)
+[Mon Nov  7 20:41:40 2016] [info] Started (test)
+[Mon Nov  7 23:55:01 2016] [info] Started (test)
+[Mon Nov  7 23:55:01 2016] [info] Webhook to https://telegram.mol.net.ua
+[Mon Nov  7 23:56:40 2016] [info] Started (test)
+[Mon Nov  7 23:56:40 2016] [info] Webhook to https://telegram.mol.net.ua
+[Mon Nov  7 23:57:20 2016] [info] Started (test)
+[Mon Nov  7 23:57:20 2016] [info] Webhook to https://telegram.mol.net.ua
+[Mon Nov  7 23:57:34 2016] [info] Started (test)
+[Mon Nov  7 23:57:34 2016] [info] Webhook to https://telegram.mol.net.ua
+[Tue Nov  8 00:09:13 2016] [info] Started (test)
+[Tue Nov  8 00:09:13 2016] [info] Webhook to https://telegram.mol.net.ua
+[Tue Nov  8 00:36:12 2016] [info] Started (test)
+[Tue Nov  8 00:36:12 2016] [info] Webhook to https://telegram.mol.net.ua
+[Tue Nov  8 00:37:54 2016] [info] Started (test)
+[Tue Nov  8 00:37:54 2016] [info] Webhook to https://telegram.mol.net.ua
+[Tue Nov  8 00:40:12 2016] [info] Started (test)
+[Tue Nov  8 00:40:12 2016] [info] Webhook to https://telegram.mol.net.ua
+[Tue Nov  8 00:42:25 2016] [info] Started (test)
+[Tue Nov  8 00:42:25 2016] [info] Webhook to https://telegram.mol.net.ua
+[Tue Nov  8 00:43:01 2016] [info] Started (test)
+[Tue Nov  8 00:43:01 2016] [info] Webhook to https://telegram.mol.net.ua
+[Tue Nov  8 00:43:44 2016] [info] Started (test)
+[Tue Nov  8 00:43:45 2016] [info] Webhook to https://telegram.mol.net.ua
+[Tue Nov  8 00:52:47 2016] [info] Started (test)
+[Tue Nov  8 00:52:48 2016] [info] Webhook to https://telegram.mol.net.ua
+[Tue Nov  8 01:08:52 2016] [info] Started (test)
+[Tue Nov  8 01:08:53 2016] [info] Webhook to https://telegram.mol.net.ua
+[Wed Nov  9 22:09:50 2016] [info] Started (test)
+[Wed Nov  9 22:09:51 2016] [info] Webhook to https://telegram.mol.net.ua
+[Wed Nov  9 22:11:47 2016] [info] Started (test)
+[Wed Nov  9 22:11:48 2016] [info] Webhook to https://telegram.mol.net.ua
+[Wed Nov  9 22:12:22 2016] [info] Started (test)
+[Wed Nov  9 22:12:22 2016] [info] Webhook to https://telegram.mol.net.ua
+[Wed Nov  9 22:31:22 2016] [info] Started (test)
+[Wed Nov  9 22:32:33 2016] [info] Started (test)
+[Wed Nov  9 22:33:03 2016] [info] Started (test)
+[Wed Nov  9 22:33:04 2016] [info] Webhook to https://telegram.mol.net.ua
+[Wed Nov  9 22:44:15 2016] [info] Started (test)
+[Wed Nov  9 22:44:16 2016] [info] Webhook to https://telegram.mol.net.ua
+[Wed Nov  9 22:45:11 2016] [info] Started (test)
+[Wed Nov  9 22:45:11 2016] [info] Webhook to https://telegram.mol.net.ua
+[Wed Nov  9 22:55:27 2016] [info] Started (test)
+[Wed Nov  9 22:55:27 2016] [info] Webhook to https://telegram.mol.net.ua
+[Wed Nov  9 22:55:52 2016] [info] Started (test)
+[Wed Nov  9 22:55:52 2016] [info] Webhook to https://telegram.mol.net.ua
+[Wed Nov  9 22:59:58 2016] [info] Started (test)
+[Wed Nov  9 22:59:58 2016] [info] Webhook to https://telegram.mol.net.ua
+[Wed Nov  9 23:00:47 2016] [info] Started (test)
+[Wed Nov  9 23:00:47 2016] [info] Webhook to https://telegram.mol.net.ua
+[Wed Nov  9 23:02:14 2016] [info] Started (test)
+[Wed Nov  9 23:02:14 2016] [info] Webhook to https://telegram.mol.net.ua
+[Wed Nov  9 23:02:55 2016] [info] Started (test)
+[Wed Nov  9 23:02:56 2016] [info] Webhook to https://telegram.mol.net.ua
+[Wed Nov  9 23:03:30 2016] [info] Started (test)
+[Wed Nov  9 23:03:31 2016] [info] Webhook to https://telegram.mol.net.ua
+[Wed Nov  9 23:04:16 2016] [info] Started (test)
+[Wed Nov  9 23:04:17 2016] [info] Webhook to https://telegram.mol.net.ua
+[Wed Nov  9 23:05:52 2016] [info] Started (test)
+[Wed Nov  9 23:05:53 2016] [info] Webhook to https://telegram.mol.net.ua
+[Wed Nov  9 23:07:40 2016] [info] Started (test)
+[Wed Nov  9 23:07:41 2016] [info] Webhook to https://telegram.mol.net.ua
+[Wed Nov  9 23:07:50 2016] [info] Started (test)
+[Wed Nov  9 23:07:50 2016] [info] Webhook to https://telegram.mol.net.ua
+[Wed Mar 15 15:50:04 2017] [info] Started (test)
+[Wed Mar 15 15:50:04 2017] [info] Webhook to https://telegram.mol.net.ua
+[Wed Mar 15 15:53:04 2017] [info] Started (test)
+[Wed Mar 15 15:53:04 2017] [info] Webhook to https://telegram.mol.net.ua
+[Wed Mar 15 15:53:10 2017] [info] Started (test)
+[Wed Mar 15 15:53:10 2017] [info] Webhook to https://telegram.mol.net.ua
+[Wed Mar 15 15:55:57 2017] [info] Started (test)
+[Wed Mar 15 15:55:58 2017] [info] Webhook to https://telegram.mol.net.ua
+[Wed Mar 15 16:05:13 2017] [info] Started (test)
+[Wed Mar 15 16:05:14 2017] [info] Webhook to https://telegram.mol.net.ua

telegram.pl

@@ -0,0 +1,282 @@
+#!/usr/bin/perl
+
+# Бот и рассыльщик сообщений для Телеграм
+# Ю. Жиловец, 6 ноября 2016 года
+# 257663755 - это я
+
+use Modern::Perl;
+use utf8;
+
+use EV;
+use AnyEvent;
+use Mojolicious::Lite;
+use Mojo::UserAgent;
+use Data::Dumper;
+use Promises qw/deferred/;
+use Mojo::JSON qw/j/;
+
+my $NAME = "telegram";
+my $confdir = "config/".app->mode;
+
+use FindBin qw/$Bin/;
+use lib "$Bin/lib";
+
+use rabbit_async;
+
+plugin yaml_config => {
+  file      => "$confdir/$NAME.cfg",
+  stash_key => 'config',
+};
+
+our $config = app->config;
+
+app->secrets(["Marsz, Marsz, Dabrowski"]);
+
+my $log = new Mojo::Log(path=>$config->{log});
+
+my $term;
+my $int;
+my $hup;
+
+my $rabbit;
+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);
+
+  $rabbit = new rabbit_async($config->{rabbit}, sub
+  {
+    $rabbit->listen_queue($config->{queue}, $config->{bind}, \&incoming_message);
+  });
+});
+                            
+##########################
+
+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
+
+##########################
+
+post "/:token" => sub
+{
+  my $c = shift;
+  
+  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};
+  
+  my $chatid = $m->{chat}->{id};
+  my $from = $m->{from}->{first_name} . " " . $m->{from}->{last_name} . " (" . $m->{from}->{username} . ")";
+  my $cmd = $m->{text};
+  my $msgid = $m->{message_id};
+  
+  $c->render(text=>"ok");
+  
+  do_command($cmd, $chatid, {msgid=>$msgid, from=>$from});
+};
+
+sub incoming_message
+{
+  my $m = shift;
+  my $body = $m->{content};
+  $log->debug($m->{routing_key}." ".Dumper($m->{content})) if $config->{debug};
+
+  my $rk = $m->{routing_key};
+  $rk =~ s/\./::/g;
+  my $sub = reference($rk);
+              
+  unless ($sub)
+  {
+    $log->error("Unknown message: ".$rk);
+    $rabbit->reject($m);
+    return;
+  }
+                    
+  eval {
+    $sub->($body,$m);
+  };
+                
+  if ($@)
+  {
+    $log->error($@);
+    $rabbit->reject($m);
+  }
+  else
+  {
+    $rabbit->ack($m);
+    $log->debug("acknowledged") if $config->{debug};
+  }
+}
+
+sub notify::telegram::send
+{
+  my $body = shift;
+  notify($body->{to}, $body->{message});
+}
+
+############################
+
+sub command::help
+{
+  my $cmd = shift;
+  my $args = shift;
+  my $chatid = shift;
+  my $rest = shift;
+  
+  notify($chatid,"*/my_id* Узнать свой идентификатор в Телеграме", $rest);
+}
+
+sub command::my_id
+{
+  my $cmd = shift;
+  my $args = shift;
+  my $chatid = shift;
+  my $rest = shift;
+  
+  notify($chatid,"Ваш идентификатор в Телеграме: *$chatid*\nУстановите его в личном кабинете", $rest);
+}
+
+#sub command::credit
+#sub command::balance
+
+
+############################
+
+sub do_command
+{
+  my $cmd = shift;
+  my $chatid = shift;
+  my $rest = shift;
+  
+  my ($c,@args) = split(/ /,$cmd);
+  $c =~ s|^/||;
+  
+  my $sub = reference("command::$c");
+  unless ($sub)
+  {
+    return notify($chatid, "Неизвестная команда. Введите */help*, чтобы увидеть список команд", $rest);
+  }
+  
+  eval {
+    $sub->($c, \@args, $chatid, $rest);
+  };
+  
+  if ($@)
+  {
+    $log->error("$cmd from $chatid [$rest->{from}]: $@");
+    notify($chatid, "Ошибка при выполнении команды", $rest);
+    return;
+  }
+}
+
+sub terminate
+{
+  request("setWebhook",{url=>""})->then(sub
+  {
+    exit(0);
+  })->catch(sub
+  {
+    say Dumper @_;
+  });
+}
+
+sub request
+{
+  my $action = shift;
+  my $params = shift;
+
+  my $deferred = deferred;
+  $ua->post("https://api.telegram.org/bot$config->{token}/$action" => form => $params => sub
+  {
+    my ($ua, $tx) = @_;
+    my $resp = $tx->success;
+         
+    unless ($resp)
+    {
+       my $err = $tx->error;
+       $err->{code} ||= 500;
+       $err->{url} = $tx->req->url->to_string;
+       $err->{body} = $tx->res->body;
+       $err->{body} = j($err->{body}) if $tx->res->headers->content_type eq "application/json";
+       $deferred->reject($err);
+     }
+     else
+     {
+       my $body = $resp->body;
+       $body = j($body) if $resp->headers->content_type eq "application/json";
+       $deferred->resolve($body);
+     }
+   });
+  
+  return $deferred->promise;
+}
+
+sub notify
+{
+  my $chatid = shift;
+  my $message = shift;
+  my $rest = shift || {};
+  
+  my $params = {
+    chat_id => $chatid,
+    text => $message,
+    parse_mode => "Markdown",
+  };
+  
+  $params->{reply_to_message_id} = $rest->{msgid} if $rest->{msgid};
+  
+  return request("sendMessage", $params);
+}
+
+# убирать его при окончании работы
+# команды
+
+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;