Writing PBX in Perl for Yate

Someday I will write something like "How I became a programmer at 40" . But definitely not today, besides, I am no longer 40 and I do not consider myself a programmer. And I would like to tell you about my experience in developing PBX for my own needs. Yate is used as VoIP engine , front and backend will be in Perl.





I often come across questions in the comments to articles: "Why not (the commentators' favorite options follow)?" So, in order.





Why

Why not Asterisk, FreeSwitch, Kamailio and others. If my memory serves me right, then 12-13 years ago, it was with Asterisk that my acquaintance with the world of SIP telephony began, since the entry threshold was quite low, you could download a ready-made disk image, where Asterisk itself, a web muzzle and even some rudimentary versions of billing systems. Naturally, all this aroused exuberant delight, constantly fell, and after a successful setting it was better not to touch it. I remember we even tried to sell the sip telephony service to our clients, but at some point all this required obtaining licenses and it became simply economically unprofitable for our client base. Later, for a long time, I used Asterisk only as an office PBX, until I got tired of constantly dropping / freezing the service on FreeBSD (I answer in advance the question "why not Linux", -"because gladiolus" ). Experiments with other engines ended in nothing, as a rule, due to the lack of adequate web gui or the difficulty in setting up (here I exaggerated a little, in fact, I now have two working FreeSwitch installations that have been working for several years without any interference) ... While surfing the net, I stumbled upon Yate, in my opinion the 2nd version then. The first thing that I liked was the minimum of settings required to start calling, perhaps nowhere else have I come across a simpler setting. Second, there is a simple webcam, FreeSentralcovering 90 percent of an office PBX setup. And third, perhaps the most important thing - everything works out of the box. What I mean when I say "everything works" is, of course, work behind NAT and DTMF, regardless of the hardware / software on the client side. Perhaps it was just me that was so lucky, although I had to work with a bunch of pieces of iron from long to cisco, which, without dancing with a tambourine, with the same Asterisk, for example, did not transfer dtmf. Poor documentation and broken examples are perhaps the main drawback of the project. That is, if there is a desire to do something serious, you will have to go into the Yate sources.





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

      
      



In fact, I have more questions about working with Yate now than I had at the beginning. For example, I just can't figure out why dtmf is flying by in forwarded calls, which is not in the native pbx module, etc. By and large, the purpose of this post is to comment on the Perl implementation. It's a pity that the developers abandoned their project, although on the other hand, there is already functionality above the roof, from WebRTC to Jabber, and it's not a fact that more will be better. The guys rule critical errors in the kernel, although my ticket with the patch has been dangling for several years, but again, this is not an error in the kernel, but in a rarely used module and is rather a special case, since with a correct database structure, an error is simply impossible.








All Articles