null

Пишем простенького jabber-бота на perl

В общем, есть, конечно isida, но по моему скромному мнению, когда нужен бот с пятью функциями, надо использовать бота с пятью функциями, а не пять функций из этого монстроузного проекта. Хотелось получить лёгкое решение, поэтому, как обычно, был расчехлён perl.

В первую очередь, откажемся от написания велосипедов -- поставим модуль для работы с Jabber (если ещё не стоит) и модуль jabber-бота для perl из cpan:

cpan Net::Jabber
cpan Net::Jabber::Bot

Во время компиляции модулей, если пять звёзд встанут в линию, а луна будет находиться в третьей фазе (т.е. у вас perl 5.18) можно наступить на известный баг в тестах, связанный с рандомным возвратом ключей хэшей в perl. Мне помогло просто запустить команды сборки ещё раз.

И дальше всё было чрезвычайно просто, если бы модуль не изобиловал комментариями вида "#TODO:" и не выводил в STDERR пару warning-ов при запуске.

Кроме того, современные MUC комнаты зачастую защищены паролем, а Net::Jabber::Bot такого не умеет.

Поэтому я написал небольшой патч, который вносит необходимые мне изменения в модуль.

Патч можно разделить на три части. В первой (строки 52-56 исходного файла) я добавляю workaround к использованию неинициализированных переменных. Во второй (строки 62-451) -- поддержку пароля для конференций и в третьей (со строки 652) -- отказываюсь от механизма разделения сообщений, предлагаемого разработчиком, в пользу обработки всех сообщений в коде бота. Текст патча ниже.

52c52
<                                                                        $self->username .
---
>                                                                        (defined $self->username ? $self->username : "username") .
54c54
<                                                                        $self->server .
---
>                                                                        (defined $self->server ? $self->server : "server") .
56c56
<                                                                        $self->alias});
---
>                                                                        ($self->alias ? $self->alias : "alias")});
62a63
> has 'forums_passwords'       => (isa => HashRef[Str], is => 'rw'); # List of forums passwords.
425c426
<         $self->JoinForum($forum);
---
>         $self->JoinForum($forum, $self->forums_passwords->{$forum});
445a447
>     my $forum_pass = shift;
451a454
>                                   password => $forum_pass,
652c655,656
<     my @aliases_to_respond_to = $self->get_responses($from);
---
>     ## Parse messages from any alias.
>     #my @aliases_to_respond_to = $self->get_responses($from);
654,666c658,670
<     if($#aliases_to_respond_to >= 0 and $type eq 'groupchat') {
<         my $request;
<         foreach my $address_type (@aliases_to_respond_to) {
<             my $qm_address_type = quotemeta($address_type);
<             next if($body !~ m/^\s*$qm_address_type\s*(\S.*)$/ms);
<             $request = $1;
<             $bot_address_from = $address_type;
<             last; # do not need to loop any more.
<         }
<         DEBUG("Message not relevant to bot");
<         return if(!defined $request);
<         $body = $request;
<     }
---
>     #if($#aliases_to_respond_to >= 0 and $type eq 'groupchat') {
>     #    my $request;
>     #    foreach my $address_type (@aliases_to_respond_to) {
>     #        my $qm_address_type = quotemeta($address_type);
>     #        next if($body !~ m/^\s*$qm_address_type\s*(\S.*)$/ms);
>     #        $request = $1;
>     #        $bot_address_from = $address_type;
>     #        last; # do not need to loop any more.
>     #    }
>     #    DEBUG("Message not relevant to bot");
>     #    return if(!defined $request);
>     #    $body = $request;
>     #}

Файл Bot.pm на FreeBSD можно найти тут: /usr/local/lib/perl5/site_perl/Net/Jabber.

Далее сначала приведу исходный текст самого бота и затем прокомментирую важные части.

#!/usr/local/bin/perl
# made by: KorG
use strict;
use warnings;
use v5.18;
use utf8;
no warnings 'experimental';

use Net::Jabber::Bot;
use Storable;

my $name = 'AimBot';
my $karmafile = '/tmp/karma';

my $qname = quotemeta($name);
store {}, $karmafile unless -r $karmafile;
my %karma = %{retrieve($karmafile)};
$SIG{INT} = \&shutdown;
$SIG{TERM} = \&shutdown;

sub shutdown {
   store \%karma, $karmafile and say "Karma saved to: $karmafile";
   exit 0;
}

sub background_checks {
   my $bot = shift;
   store \%karma, $karmafile;
}

sub new_bot_message {
   my %msg = @_;
   my $bot = $msg{'bot_object'};

   my $from = $msg{'from_full'};
   $from =~ s{^.+/([^/]+)$}{$1};

   my $to_me = ($msg{'body'} =~ s{^$qname: }{});

   given ($msg{'body'}) {
      when (/^time\s*$/i) {
         $bot->SendGroupMessage($msg{'reply_to'},
            "$from: " . time);
      }
      when (/^help\s*$/i) {
         $bot->SendGroupMessage($msg{'reply_to'},
            "$from: пробуй так: fortune karma time");
      }
      when (/^fortune\s*$/i) {
         my $fortune = `/usr/games/fortune -s`;
         chomp $fortune;
         $fortune =~ s/[\n\t]+/ /g;
         $bot->SendGroupMessage($msg{'reply_to'},
            "$from: $fortune");
         sleep 1;
      }
      when (/^karma\s*$/i) {
         $bot->SendGroupMessage($msg{'reply_to'},
            "$from: твоя карма: " . ($karma{lc($from)}||0));
      }
      when (/^karma\s*(\w+)$/i) {
         $bot->SendGroupMessage($msg{'reply_to'},
            "$from: карма $1: " . ($karma{lc($1)}||0));
      }
      when (/^(\w+):\s*\+[+1]\s*$/) {
         return if $1 eq $from;
         $karma{lc($1)}++;
         $bot->SendGroupMessage($msg{'reply_to'},
            "$from: поднял карму $1 до " . $karma{lc($1)});
      }
      when (/^(\w+):\s*\-[-1]\s*$/) {
         return if $1 eq $from;
         $karma{lc($1)}--;
         $bot->SendGroupMessage($msg{'reply_to'},
            "$from: опустил карму $1 до " . $karma{lc($1)});
      }
      default {
         $bot->SendGroupMessage($msg{'reply_to'},
            "$from: how about no, братиша?") if $to_me;
      }
   }
}

my %forum_list = ('ubuntulinux' => []); # [] due to Bot.pm.patch
my %forum_passwords = ('ubuntulinux' => 'ubuntu');

my $bot = Net::Jabber::Bot->new(
   server => 'zhmylove.ru',
   conference_server => 'conference.jabber.ru',
   port => 5222,
   username => 'aimbot',
   password => 'password',
   alias => $name,
   resource => $name,
   safety_mode => 1,
   message_function => \&new_bot_message,
   background_function => \&background_checks,
   loop_sleep_time => 60,
   forums_and_responses => \%forum_list,
   forums_passwords => \%forum_passwords,
);

$bot->Start();

К функционалу данного бота относятся следующие команды:

time -- показать время.

help -- вывести краткую справку.

karma [user] -- показать карму указанного пользователя или свою.

user: ++ -- увеличить или уменьшить карму указанного пользователя.

user: +1

user: -1

user: --

fortune -- показать случайную фразу из fortune(6).

Собственно, интерес для настроек представляют две переменные в начале скрипта: $name и $karmafile. В них указаны ник (и ресурс), путь к файлу, в котором сохранять информацию о карме. Информация о карме будет сохраняться при завершении бота сигналами SIGINT и SIGTERM, а также каждые 60 ($bot->loop_sleep_time) секунд при выполнении функции background_checks. Вообще, эта функция предназначена для мониторинга внешних ресурсов и вызывается с заданной частотой. Фактически, бот занимается вызовом этой функции и асинхронно обрабатывает приходящие сообщения. Рассмотрим сразу хэш с настройками в конце скрипта. В принципе, всё интуитивно понятно. username и password -- это логин и пароль для авторизации на порту port сервера server; conference_server -- это сервер конференций, к комнатам которого будет подключаться бот; alias и resourse, как было сказано, -- это ник и ресурс бота; safety_mode -- флаг включения некоторых фич безопасности (и его рекомендуется не выключать), остальное -- указатели на соответствующие функции и хэши. Ключи хэша forum_list используются для задания комнат, к которым подключается бот. Значения ключей изначально задают фразы, на которые должен реагировать бот, но он не реагирует на ряд фраз, поэтому в коде бота просто указатель на пустой хэш. В хэше forum_passwords значатся соответствия форум-пароль.

 

Теперь немного пройдёмся по коду. Старался написать не загромождённый и легко масштабируемый код.

Сначала указываем общеизвестные модули, выключаем experimental warning-и (т.к. я хочу использовать given) и подключаем модули Net::Jabber::Bot и Storable (для сохранения объектов в файл). Далее подготавливается файл для кармы и устанавливаются обработчики сигналов. Функция shutdown выполняется когда завершают работу бота; background_checks -- вызывается с определённой частотой; и самая большая функция -- обработчик новых сообщений. В нём мы видим получения информации о сообщении из аргументов, выделение ника отправителя из MUC JID, и удаление из тела сообщения нашего имени, если оно там присутствует. Большую часть кода занимает "switch" по телу. Фактически, на каждое действие вызывается функция SendGroupMessage, которая отправляет сообщение в MUC, в зависимости от распознанной команды. Последняя строка скрипта -- указание боту запустить свой вечный цикл.

 

Код довольно понятный и легко масштабируем, а по отзывам пользователей, бот работает весьма быстро. Исходный код, по просьбам трудящихся, был также размещён на https://github.com/tune-it/jplbot. Засим, пожалуй, всё.

korg

 

Коротко о себе

Работаю в компании Tune-IT, администрирую инфраструктуру компании и вычислительную сеть кафедры Вычислительной ТехникиСПбНИУ ИТМО.

Интересы: администрирование UNIX и UNIX-like систем и активного сетевого оборудования, написание shell- и perl-скриптов, изучение технологий глобальных сетей.
Люблю собирать GNU/Linux и FreeBSD, использовать тайлинговые оконные менеджеры и писать системный софт.