Пишем PBX на Perl для Yate

Когда-нибудь я напишу что-то в духе "Как я стал программистом в 40 лет". Но точно не сегодня, к тому же мне давно уже не 40 и программистом я себя не считаю. А рассказать я хотел бы о своём опыте разработки PBX для собственных нужд. В качестве VoIP движка используется Yate, фронт- и бэкенд будет на Perl.

Часто встречаю в комментариях к статьям вопросы: "Почему не (далее идут любимые варианты комментаторов)?". Итак, по порядку.

Почему

Почему не Asterisk, FreeSwitch, Kamailio и прочие. Если память мне не изменяет, то лет 12-13 назад, именно с Asterisk началось мое знакомство с миром SIP телефонии, благо порог вхождения был достаточно низким, можно было скачать готовый образ диска, где уже был и сам Asterisk, веб-морда и даже какие-то зачаточные версии биллинговых систем. Естественно всё это вызывало буйный восторг, постоянно падало, и после удачной настройки лучше было не трогать. Помню мы даже пытались продавать своим клиентам услугу sip-телефонии, но в какой-то момент всё это потребовало получения лицензий и на нашей клиентской базе стало просто экономически невыгодно. В дальнейшем, достаточно долго, я использовал Asterisk только в качестве офисной PBX, пока не надоело постоянно падение/зависание сервиса на FreeBSD(заранее отвечаю на вопрос "почему не Linux", - "потому что гладиолус"). Эксперименты с другими движками окончились ни чем, как правило, ввиду отсутстия адекватного веб-гуя либо сложности в настройке(тут я немного приувеличил, на самом деле у меня сейчас есть две работающие инсталляции FreeSwitch, которые вполне себе работают уже несколько лет без всякого вмешательства). Блуждая по сети, случайно наткнулся на Yate, по-моему 2-й тогда версии. Первое, что понравилось, минимум настроек, необходимых для того, чтобы уже начать звонить, пожалуй больше нигде я не встречал более простой настройки. Второе, - наличие простенькой вебки, FreeSentral, закрывающей 90 процентов настройки офисной PBX. Ну и третье, пожалуй самое главное - всё работает "из коробки". Что я подразумеваю, говоря "всё работает", - это конечно же работа за NAT и DTMF, вне зависимости от железа/софта на клиентской стороне. Возможно, это только мне так повезло, хотя приходилось работать с кучей железок от длинка до cisco, которые без танцев с бубном, с тем же Asterisk, к примеру не передавали dtmf. Убогая документация и неработающие примеры - пожалуй главный недостаток проекта. То есть если появится желание сделать что-либо серьезное, придется лезть в исходники Yate.

После 2-х литров кофе, пачки сигарет и такой-то матери, всё это было посажено в jail и вполне себе успешно крутилось 2-3 года. В один прекрасный день, плановое обновление портов поломало вебку из-за повышения версии php. Разработчики к тому времени забросили freesentral и пришлось самому ковырять код портала. Что-то удалось поправить, но большая часть функционала была потеряна, а на большее мне элементарно не хватило знаний. Варианты с откатом версий мной даже не рассматривались, ввиду того, что в клетке кроме Yate крутилось несколько других сервисов. Сдох бобик...

Так. Стоп. Что-то я уж очень далеко отошел от темы. Может быть в следующий раз я расскажу, как я докатился, до того до чего докатился. Поэтому кратенько, почему Perl. Всё это пишется модулем под Abiils, небольшой опыт работы с которым у меня уже есть.

Так как авторы Yate подзабили на своё детище и новые коммиты появляются раз в пятилетку, будем использовать более свежую версию библиотеки для Perl, от Vasily i. Redkin на github.

Установка и настройка

Итак с чего начнем. Думаю установка Yate не вызовет ни у кого затруднений, готовые пакеты есть по-моему под все платформы. У меня был какой-то сбой на сборке с clang под 64-х битной FreeBSD, что я там исправил - уже не помню. Вообще, запускать PBX можно практически сразу, так как нужные для этого модули на C++ уже есть в наличии, остается только подключить их, и рулить, например из mysql или psql(собственно у меня и было несколько таких инсталляций). Но поскольку легких путей я не искал, решил все это дело прикрутить через Perl к биллингу.

Для начала отредактируем файлы настроек. В файле yate.conf нам нужна секция [modules]. Здесь подключаем/отключаем нужные нам модули(далее с моими комментариями, хотя названия модулей говорят сами за себя):

[modules]
;Модуль необходимый для работы с протоколом SIP
ysipchan.yate=yes
;Записываем звук
wavefile.yate=yes
;Формируем CDR
cdrbuild.yate=yes
;Этот модуль позволяет комбинировать в логах входяшие и исходящие
cdrcombine.yate=yes
;Подключаем муззон в линию
moh.yate=yes
;Удаленный вход
rmanager.yate=yes
;Модуль регистрации
register.yate=yes
;Тонегенератор
tonegen.yate=yes
;А вот и модуль для подключения внешних обработчиков(Perl, PHP, JS и прочее)
extmodule.yate=yes
;Модуль RTP
yrtpchan.yate=yes
;Шифруемся
openssl.yate=yes
;Эээ, ну пусть будет виртуальный канал
dumbchan.yate=yes
;Очень нужный модуль для отладки, - кроме подключения модуля,
;нужно саму откладку включить отдельно.
msgsniff.yate=yes
;Модуль парковки, собственно я им не пользуюсь, но пусть тут будет
park.yate=yes

Следующий файл extmodule.conf. Здесь нам нужны две секции:

;Здесь указываем наш обработчик, предварительно положив его в папку scripts
[scripts]
pbx_route.pl=

;Если нужно внешнее выполнение скриптов, поднимаем порт
[listener tcp5039]
type=tcp
addr=10.0.0.7
port=5039

Как я уже писал, документации крайне мало, и даже та что есть, зачастую некорректна и содержит ошибки. Более-менее работающие обработчики и примеры есть на PHP, и принцип работы можно понять разобравшись с ними. Первая моя попытка написать роутер на Perl закончилась полным разочарованием и капитально уронило мою самооценку. Спустя полгода я снова вернулся к проекту и тут настоящим откровением для меня стал найденный в мылолисте Yate код от vir'а, который с небольшими правками заработал.

Ну и осталось адаптировать под собственные нужды. pbx_route.pl:

#!/usr/bin/perl -w
#
use strict;
use warnings;

#Добавляем в @INC папки биллинга
BEGIN {
    use FindBin '$Bin';
    our $libpath = $Bin . '/../';
    my $sql_type = 'mysql';
    unshift( @INC,
        $libpath . "Abills/$sql_type/",
        $libpath . '/lib/',
        $libpath . "Abills/modules" );
}

use Abills::SQL;

#Подключаем либу для работы с Yate
use Pbx::Yate;
#Либа для работы с новыми таблицами в биллинге
use Pbx::Pbx;

my $message = Yate->new();
my $Pbx = Pbx->new($db, $message, \%conf);

#Инициализирум транки
trunks_init($message);

#Дальше идет инсталяция обработчиков событий
$message->install('call.answered', \&call_answered_handler, 50);
$message->install('call.route', \&call_route_handler);
$message->install_watcher('call.execute', \&call_execute_handler, 50);
$message->install('chan.hangup', \&chan_hangup_handler);
$message->install('chan.disconnected', \&chan_disconnected_handler, 10);
$message->install('chan.dtmf', \&chan_dtmf_handler, 50);
$message->install('user.auth', \&user_auth_handler);
#$message->install('user.authfail', \&user_authfail);
$message->install('user.register', \&user_register_handler);
$message->install('user.unregister', \&user_unregister_handler);
$message->install('user.notify', \&user_notify_handler);
$message->install_watcher("engine.timer", \&engine_timer_handler);

#Начинаем перехватывать сообщения
$message->listen();

sub trunks_init {
  my $message = shift;
  my ($attr) = @_;
  #Выбираем данные транков
  my $trunks = $Pbx->trunk_list({
    ACCOUNT      => '_SHOW',
    PROTOCOL     => '_SHOW',
    USERNAME     => '_SHOW',
    PASSWORD     => '_SHOW',
    REGISTRAR    => '_SHOW',
    LOCALADDRESS => '_SHOW',
    OUTBOUND     => '_SHOW',
    DOMAIN       => '_SHOW',
    ENABLED      => 1,
    INTERVAL     => '_SHOW',
    OPTIONS      => '_SHOW',
    COLS_NAME    => 1
  });

  if ($trunks) {
    foreach my $tr (@$trunks) {
      $message->message('user.login', undef, undef, %$tr );#Поключаем транк
    }
  }
}

#Ну и сам роутер
sub call_route_handler {
    my $message = shift;
    my $id = $message->param('id');
    my $called = $message->param('called');
    my $caller = $message->param('caller');
    #выкидываю плюс из номеров
    $called =~ s/\+//g;
    #определяем направление звонка
    my $call_type = ($Pbx->extensions_list({ NUMBER => $called, LIST2HASH => 'number,location' })) ? 'to_internal' : 'to_external';
    
    #Здесь проверяем наличие маршрута для звонка,
    #навешиваем на него дополнительные атрибуты и чистим память
    if ($Pbx->get_route($called)) {
      $message->params($Pbx->{params});
      $message->param('call_type', $call_type);
      $message->param('copyparams', 'maxcall,call_type,pbx_from');
      delete $Pbx->{params};
      return $Pbx->{location}
    }

    return 'noroute'
}

#Авторизуем пользователей
sub user_auth_handler {
    my $message = shift;
    my $user = $message->param('username');
    if ($user) {
      my $auth = $Pbx->extensions_list({ NUMBER => $user, PASSWORD => '_SHOW', COLS_NAME => 1 });
      if ($auth) {
        return $auth->{password};
      }
    }
    return undef;
}

#Обновляем данные регистрации в базе
sub user_register_handler($) {
    my $message = shift;
    $Pbx->update_location({
      LOCATION => $message->param('data'),
      CONN_ID  => $message->param('connection_id'),
      EXPIRES  => $message->param('expires'),
      NUMBER   => $message->param('number')
    }); 
    return 'true'
}

sub user_unregister_handler($) {
    my $message = shift;
    $Pbx->update_location({
      CONN_ID  => '',
      NUMBER   => $message->param('number')
    });
    return 'true'
}

#То же самое с транками 
sub user_notify_handler($) {
    my $message = shift;
    my $account = $message->param('account');
    my $status = ($message->param('registered') ne 'false') ? 0 : 1;
    $Pbx->query2("UPDATE pbx_trunks SET status=$status WHERE account='$account';", 'do');
    return undef;
}

Тут я привел код роутера в сильно усеченном варианте, так как остальные функции используются для частных случаев, например обработка dtmf, запись звука или вызов абонента из веб-интерфейса. Если статья будет интересна, могу расписать пример работы с IVR. И несколько примеров работы с каналом:

#Проигрываем звук в линию
#id - в какой линии работаем,
#replace - если звук уже играет, заменяем его
$message->message('chan.attach', undef,'',
  replace => 'true',
  source => "wave/play/hi.wav",
  notify => $id,
  id => $id
);
    
#Если необходимо организовать проигрываение нескольких файлов подряд
#нужно отслеживать событие 'eof', которое генерирует модуль wavefile.yate
#Для этого перед началом проигрывания звука инсталируем обработчик события 'chan.notify'
#Возможно есть более простое решение, я же реализовал так
my $handl;
$message->install('chan.notify', $handl = sub {
		$message->message('chan.attach', undef, '',
      replace => 'true',
      source => "wave/play/hi.wav",
      notify => $id,
      id => $id
    )
  }, 50, 'reason', 'eof');
  
#А вот так я реализовал звонок из вебинтерфейса.
#Оператор жмет кнопку вызова в карточке клиента, -
#поднимается виртуальный канал с него идет вызов
#на телефон оператора, а уже затем вызывается номер абонента
#caller в данном случае - номер вызываемого клиента
#так как именно этот номер потом будет отображаться в CDR
sub pbx_call {
  my ($attr) = @_;
  #получаем номер оператора
  my $info = $admin->list({
  	SIP_NUMBER => '_SHOW',
    AID => $admin->{AID},
    COLS_NAME => 1
  });
  my $message = Yate->new();
  #Генерируем уникальный ID для канала
  my $msgid = $message->generate_id;
  #Тут подключаемся к порту, который ранее подняли в extmodule.conf
  $message->connect("10.0.0.7:5039");
  $message->message('call.execute', undef, $msgid,
    message    => 'call.execute',
    direct     => $Pbx->build_location($info->[0]->{sip_number}),
    caller     => $FORM{PHONE},#кому звоним, - забираем номер из формы клиента
    callto     => "dumb/",#тот самый виртуальный канал
    callback   => $FORM{PHONE},
    cdrwrite   => 'false',
    cdrtrack   => 'false',
    target     => $info->[0]->{sip_number},
  );
  return 1;
}
  

Итого

На самом деле, у меня сейчас вопросов по работе с Yate больше, чем было вначале. Например я никак не могу понять почему пролетают dtmf в переадресованных звонках, чего нет в родном модуле pbx, и т.п. По большому счету, цель этой публикации, комментарии тех, кто занимался реализацией на Perl. Жаль, что разработчики забросили свой проект, хотя с другой стороны, там и так уже функционала выше крыши, от WebRTC до Jabber, и не факт, что больше - будет лучше. Критичные ошибки в ядре ребята правят, правда мой тикет с патчем уже несколько лет болтается, но опять же - это ошибка не в ядре, а в редко используемом модуле и скорее является частным случаем, так как при корректной структуре БД, ошибка попросту невозможна.