rendered paste body#!/usr/bin/perl -w
# Flash Operator Panel. http://www.asternic.org
#
# Copyright (c) 2004 Nicolás Gudiño. All rights reserved.
#
# Nicolás Gudiño <asterisk@house.com.ar>
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
#
# 1. Redistributions of source code must retain the above copyright
# notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR
# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
# EVENT SHALL THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
# PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
# OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
# WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
# OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
# ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
use strict;
use IO::Socket;
use IO::Select;
use POSIX qw(setsid);
chdir '/' or die "Can't chdir to /: $!";
umask 0;
open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
#open STDOUT, '>/dev/null' or die "Can't write to /dev/null: $!";
open STDERR, '>/dev/null' or die "Can't write to /dev/null: $!";
defined(my $pid = fork) or die "Can't fork: $!";
exit if $pid;
setsid or die "Can't start a new session: $!";
my %datos = ();
my %auto_conference = ();
my %buttons = ();
my %textos = ();
my %iconos = ();
my %extension_transfer = ();
my %flash_contexto = ();
my $bloque_completo;
my $bloque_final;
my $todo;
my @bloque;
my @respuestas;
my @flash_clients;
my @status_active;
my %mailbox;
my %instancias;
my %orden_instancias;
my $p;
my $O;
my @S;
my $manager_host;
my $manager_user;
my $manager_secret;
my $web_hostname;
my $listen_port;
my $security_code;
my $flash_dir;
my $poll_interval;
my $kill_zombies;
my $debug;
my $flash_file;
my $auto_conf_exten;
my $meetme_context;
my $directorio = $0;
my $papa;
$SIG{PIPE} = 'IGNORE';
$SIG{ALRM} = 'alarma_al_minuto';
$SIG{INT} = 'close_all';
$SIG{HUP} = 'generate_configs_onhup';
$SIG{USR1} = 'dump_internal_hashes_to_stdout';
sub read_server_config()
{
$/ = "\n";
my %config = ();
open(CONFIG, "<$directorio/op_server.cfg")
or die("Could not open op_server.cfg. Aborting...");
while (<CONFIG>)
{
$_ =~ s/\s+//g;
$_ =~ s/(.*)#(.*)$/$1/g;
if (!/^$/)
{
my ($variable_name, $value) = split(/=/, $_);
$variable_name =~ tr/A-Z/a-z/;
$value =~ s/\"//g;
$config{"$variable_name"} = $value;
}
}
close(CONFIG);
$manager_host = $config{"manager_host"};
$manager_user = $config{"manager_user"};
$manager_secret = $config{"manager_secret"};
$web_hostname = $config{"web_hostname"};
$listen_port = $config{"listen_port"};
$security_code = $config{"security_code"};
$flash_dir = $config{"flash_dir"};
$poll_interval = $config{"poll_interval"};
$kill_zombies = $config{"kill_zombies"};
$debug = $config{"debug"};
$auto_conf_exten = $config{"auto_conference_extension"};
$meetme_context = $config{"conference_context"};
$flash_file = $flash_dir . "/variables.txt";
if (!defined $manager_host)
{
die("Missing manager_host in op_server.cfg!");
}
if (!defined $manager_user)
{
die("Missing manager_user in op_server.cfg!");
}
if (!defined $manager_secret)
{
die("Missing manager_secret in op_server.cfg!");
}
if (!defined $web_hostname)
{
die("Missing web_hostname in op_server.cfg!");
}
if (!defined $listen_port)
{
die("Missing listen_port in op_server.cfg!");
}
if (!defined $security_code)
{
die("Missing security_code in op_server.cfg!");
}
if (!defined $flash_dir) { die("Missing flash_dir in op_server.cfg!"); }
if (!defined $poll_interval)
{
die("Missing poll_interval in op_server.cfg!");
}
if (!defined $kill_zombies)
{
die("Missing kill_zombies in op_server.cfg!");
}
if (!defined $debug) { die("Missing debug in op_server.cfg!"); }
$/ = "\0";
}
sub read_buttons_config()
{
$/ = "\n";
open(CONFIG, "< $directorio/op_buttons.cfg")
or die("Could not open op_buttons.cfg. Aborting...");
while (<CONFIG>)
{
my $campo1 = "";
my $campo3 = "";
my $campo4 = "";
my $campo5 = "";
my $contexto;
my $indice;
my $canal;
my @campos = ();
chop($_);
$_ =~ s/^\s+(.*)/$1/g;
next if ($_ =~ /^#/);
while ($_ =~ m/"([^"\\]*(\\.[^"\\]*)*)",?|([^,]+),?|,/g)
{
$campo1 = $1;
$campo3 = $3;
$campo1 =~ s/^\s+//g if (defined($1));
$campo3 =~ s/^\s+//g if (defined($3));
push(@campos, defined($campo1) ? $campo1 : $campo3);
}
push(@campos, undef) if $_ =~ m/,$/;
$campos[0] =~ tr/a-z/A-Z/;
$campos[1] =~ tr/a-z/A-Z/;
my @partes = split(/\@/, $campos[1]);
if (defined($partes[1]) && length($partes[1]) > 0)
{
$campos[1] = $partes[0];
$contexto = $partes[1];
$contexto =~ s/^DEFAULT$//g;
$canal = $campos[0] . "&" . $contexto;
}
else
{
$contexto = "";
$canal = $campos[0];
}
my @repetido = split(/;/, $partes[0]);
my $cuantos = @repetido;
if ($cuantos > 1)
{
$instancias{$canal} = [];
my $contador = 0;
foreach my $numeroboton (@repetido)
{
$contador++;
if (length($contexto) > 0)
{
$indice = $numeroboton . "\@" . $contexto;
}
else
{
$indice = $numeroboton;
}
$buttons{"${canal}=${contador}"} = $indice;
$textos{"$indice"} = $campos[2] . " " . $contador;
$iconos{"$indice"} = $campos[4];
}
}
else
{
if (length($contexto) > 0)
{
$indice = $partes[0] . "\@" . $contexto;
}
else
{
$indice = $partes[0];
}
$buttons{"$canal"} = $indice;
# El contexto para nombre de canal se adjunta con &
# El contexto como indice se adjunto con @
$textos{$indice} = $campos[2];
$iconos{$indice} = $campos[4];
}
$extension_transfer{"$canal"} = $campos[3];
if (defined($campos[5]))
{
my @partes = split(/@/, $campos[3]);
$mailbox{"$canal"} = $partes[0] . "@" . $campos[5];
}
}
close(CONFIG);
$/ = "\0";
}
sub genera_config
{
$/ = "\n";
my $style_variables = "";
my @contextos = ();
open(STYLE, "<op_style.cfg")
or die("Could not open op_style.cfg for reading");
while (<STYLE>)
{
chop($_);
$_ =~ s/^\s+//g;
$style_variables .= $_ . "&";
}
close(STYLE);
for (keys %textos)
{
if ($_ =~ /\@/)
{
my @partes = split(/\@/);
push(@contextos, $partes[1]);
}
}
# Writes default context variables.txt
open(VARIABLES, ">$flash_file")
or die(
"Could not write configuration data $flash_file.\nCheck your file permissions\n"
);
print VARIABLES "server=$web_hostname&port=$listen_port";
while (my ($key, $val) = each(%textos))
{
$val =~ s/\"(.*)\"/$1/g;
if ($key !~ /\@/)
{
print VARIABLES "&texto$key=$val";
}
}
while (my ($key, $val) = each(%iconos))
{
$val =~ s/\"(.*)\"/$1/g;
if ($key !~ /\@/)
{
print VARIABLES "&icono$key=$val";
}
}
print VARIABLES "&" . $style_variables;
print VARIABLES "CheckDone=1";
close(VARIABLES);
# Writes variables.txt for each context defined
foreach (@contextos)
{
my $flash_context_file = $flash_dir . "/variables" . $_ . ".txt";
open(VARIABLES, ">$flash_context_file")
or die(
"Could not write configuration data $flash_file.\nCheck your file permissions\n"
);
print VARIABLES "server=$web_hostname&port=$listen_port";
while (my ($key, $val) = each(%textos))
{
$val =~ s/\"(.*)\"/$1/g;
if ($key =~ /\@$_$/)
{
$key =~ s/(\d+)\@.+/$1/g;
print VARIABLES "&texto$key=$val";
}
}
while (my ($key, $val) = each(%iconos))
{
$val =~ s/\"(.*)\"/$1/g;
if ($key =~ /\@$_$/)
{
$key =~ s/(\d+)\@.+/$1/g;
print VARIABLES "&icono$key=$val";
}
}
print VARIABLES "&" . $style_variables;
print VARIABLES "CheckDone=1";
close(VARIABLES);
}
$/ = "\0";
}
sub dump_internal_hashes_to_stdout
{
foreach (sort (keys(%buttons)))
{
printf("%-20s %-10s\n", $_, $buttons{$_});
}
print "---------------------------------------------------\n";
my $number_of_data_blocks = %datos;
if ($number_of_data_blocks ne "0")
{
print "---------------------------------------------------\n";
print "DATOS\n";
print "---------------------------------------------------\n";
for (keys %datos)
{
print $_. "\n";
while (my ($key, $val) = each(%{$datos{$_}}))
{
if (defined($val))
{
print "\t$key = $val\n";
}
}
print "---------------------------------------------------\n";
}
}
else
{
print "No data blocks in memory\n";
}
my $number_of_flash_clients_connected = @flash_clients;
if ($number_of_flash_clients_connected > 0)
{
print "\nFlash clients connected: $number_of_flash_clients_connected\n";
print "---------------------------------------------------\n";
foreach my $C (@flash_clients)
{
print "$C : ";
my $sockaddr = $C->peername;
my ($port, $inetaddr) = sockaddr_in($sockaddr);
my $ip_address = inet_ntoa($inetaddr);
print "$ip_address\n";
#print "\n";
}
print "---------------------------------------------------\n";
}
else
{
print "\nNo flash clients connected\n\n";
}
}
sub generate_configs_onhup
{
%buttons = ();
%textos = ();
%iconos = ();
%extension_transfer = ();
read_buttons_config();
read_server_config();
genera_config();
}
sub manager_reconnect()
{
my $attempt = 1;
my $total_attempts = 60;
do
{
log_debug("** Attempt reconnection to manager port # $attempt", 16);
$p =
new IO::Socket::INET->new(
PeerAddr => $manager_host,
PeerPort => 5038,
Proto => "tcp",
Type => SOCK_STREAM
);
$attempt++;
if ($attempt > $total_attempts)
{
die("!! Could not reconnect to Asterisk Manager port");
}
sleep(10); # wait 10 seconds before trying to reconnect
} until $p;
$O->add($p);
send_command_to_manager(
"Action: Login\r\nUsername: $manager_user\r\nSecret: $manager_secret\r\n\r\n"
);
}
# Checks file_name to find out the directory where the configuration
# files should reside
$directorio =~ s/(.*)\/(.*)/$1/g;
chdir($directorio);
$directorio = `pwd`;
chop($directorio);
read_buttons_config();
read_server_config();
genera_config();
$p =
new IO::Socket::INET->new(
PeerAddr => $manager_host,
PeerPort => 5038,
Proto => "tcp",
Type => SOCK_STREAM
)
or die "\nCould not connect to Asterisk Manager Port\n";
$p->autoflush(1);
send_command_to_manager(
"Action: Login\r\nUsername: $manager_user\r\nSecret: $manager_secret\r\n\r\n"
);
my $m =
new IO::Socket::INET(Listen => 1, LocalPort => $listen_port, ReuseAddr => 1)
or die "\nCan't listen to port $listen_port\n";
$O = new IO::Select();
$O->add($m);
$O->add($p);
$/ = "\0";
alarm(10);
while (1)
{
while (@S = $O->can_read)
{
foreach (@S)
{
if ($_ == $m)
{
# New client connection, lets send a Status to Asterisk Manager
log_debug("** New client connection", 16);
my $C = $m->accept;
push(@flash_clients, $C);
$O->add($C);
alarm(10);
}
else
{
# Its not a new client connection
my $i;
my $R = sysread($_, $i, 2); # 2048
if (defined($R) && $R == 0)
{
my $T = syswrite($_, ' ', 2); # 2048
if (!defined($T))
{
$O->remove($_);
$_->close;
# Removes handle from flash_clients array
my $cualborrar = $_;
my @temp = grep(!/\Q$cualborrar\E/, @flash_clients);
@flash_clients = @temp;
if ($_ == $p)
{
log_debug(
"** Asterisk Manager connection lost!!!!!",
16);
manager_reconnect();
}
}
}
else
{
$i =~ s/([^\r])\n/$1\r\n/g; # Reemplaza \n solo por \r\n
$bloque_completo = "" if (!defined($bloque_completo));
$papa = $i;
$papa = substr($bloque_completo, -5) . $papa;
if ($papa =~ "\r\n\r\n" || $i =~ /\0/)
{
log_debug("** End of block", 16);
$bloque_final = $bloque_completo . $i;
$bloque_completo = "";
$bloque_final =~
s/([^\r])\n/$1\r\n/g; # Reemplaza \n solo por \r\n
my @lineas = split("\r\n", $bloque_final);
foreach my $linea (@lineas)
{
if (length($linea) < 2)
{
$bloque_completo = $linea;
#my $largo = length($linea);
#$largo = $largo * -1;
#$bloque_final=substr($bloque_final,$largo);
}
else
{
if ($_ == $p) { log_debug("<- $linea", 1); }
}
}
if ($_ == $p) { log_debug(" ", 1); }
}
else
{
my $quehay = substr($i, -2);
$bloque_completo .= $i;
next;
}
foreach my $C ($O->handles)
{
if ($C == $p)
{
log_debug(
"** Asterisk event received, process block...",
16
);
# Asterisk event received
# Read the info and arrange it into blocks
# for processing in 'procesa_bloque'
if ( $bloque_final =~ /Event:/
|| $bloque_final =~ /Message: Mailbox/)
{
log_debug(
"** There's an 'Event' in the event block",
32
);
my @lineas = split(/\r\n/, $bloque_final);
@bloque = ();
my $contador = 0;
foreach $p (@lineas)
{
log_debug("** Parse line: $p", 64);
my $my_event = "";
if ($p =~ /Event:/)
{
log_debug("** Event detected $p", 32);
$contador++;
}
elsif ($p =~ /Message: Mailbox/)
{
log_debug(
"** Event mailbox detected $p",
32);
$my_event =
"MessageWaiting"; # Fake event
$contador++;
}
my ($atributo, $valor) =
split(/: /, $p);
if (defined $atributo && $atributo ne "")
{
if ($my_event ne "")
{
$atributo = "Event";
$valor = $my_event;
log_debug(
"** Fake event generated $atributo=$valor",
16
);
}
$bloque[$contador]{"$atributo"} =
$valor;
}
}
log_debug(
"** There are $contador blocks for processing",
32
);
@respuestas = ();
log_debug("** Answer block cleared", 32);
@respuestas =
digiere_el_bloque_y_devuelve_array_de_respuestas
(@bloque);
}
elsif ($bloque_final =~ /--END COMMAND--/)
{
log_debug(
"** There's an 'END' in the event block",
32);
$todo .= $bloque_final;
procesa_comando($todo);
my $cuantos = @bloque;
log_debug(
"There are $cuantos blocks for processing",
32
);
@respuestas =
digiere_el_bloque_y_devuelve_array_de_respuestas
(@bloque);
$todo = "";
}
elsif ($bloque_final =~ /<msg/)
{
log_debug(
"** Processing command received from flash clients...",
32
);
procesa_comando_cliente($bloque_final, $_);
@respuestas = ();
$bloque_final = "";
$todo = "";
}
else
{
log_debug(
"** There is no 'Event' nor 'End' in the block. Erasing block...",
32
);
# No Event in the block. Lets clear it up...
@bloque = ();
$todo .= $bloque_final;
}
}
else
{
my $contador = 0;
# Send messages to Flash clientes
foreach my $valor (@respuestas)
{
my $contextores = $valor;
$contextores =~
s/<response data=\"(.*)\|.*\|.*/$1/g;
my @pedacitos = split(/\@/, $contextores);
if (defined($pedacitos[1]))
{
$contextores = $pedacitos[1];
}
else
{
$contextores = "";
}
if (defined($flash_contexto{$C}))
{
if ($flash_contexto{$C} eq $contextores)
{
# Send messages only to the clients with
# the specific context
my $T =
syswrite($C, $valor, length($valor));
log_debug("=> $valor", 8);
$contador++;
}
}
} # end foreach respuestas
if ($contador > 0)
{
log_debug(" ", 8);
} # Cosmetic separator line in debug
}
} # end foreach handles
}
}
} # end foreach @S -> can read
} # while can read
} # endless loop
sub digiere_el_bloque_y_devuelve_array_de_respuestas
{
log_debug("** ---- Start sub digiere_el_bloque... ----", 16);
my $bloque = shift;
my @respuestas = ();
my $canal = "";
my $quehace = "";
my $dos = "";
my $uniqueid = "";
my $canalid = "";
my $quehay = "";
my $mensaje = "";
my $interno = "";
my $mensajefinal;
my $cuantas;
delete $datos{""};
foreach my $blaque (@bloque)
{
log_debug("** I will process one block", 16);
$mensaje = procesa_bloque($blaque);
if (defined($mensaje) && $mensaje ne "")
{
log_debug("** Got $mensaje", 128);
delete $datos{""}; # Erase the hash with no uniqueid
($canal, $quehace, $dos, $uniqueid, $canalid) =
split(/\|/, $mensaje);
if (!defined($canal)) { $canal = ""; }
if (!defined($quehace)) { $quehace = ""; }
if (!defined($dos)) { $dos = ""; }
if ($canal ne "")
{
# There is a channel defined, erase the %hash
if ($quehace eq 'corto')
{
erase_all_sessions_from_channel($canalid);
delete $datos{$uniqueid};
log_debug("Deleting hash for uniqueid $uniqueid", 32);
}
my @posibles_internos = ();
# Si el mismo canal esta en mas de un contexto, duplica
# el mensaje a enviar
for $quehay (keys %buttons)
{
if ($quehay =~ /^\Q$canal&\E|^\Q$canal\E$/)
{
push(@posibles_internos, $quehay);
}
}
if ($quehace eq "link")
{
for $quehay (keys %buttons)
{
if ($quehay =~ /^\Q$dos&\E|^\Q$dos\E$/)
{
push(@posibles_internos, $quehay);
}
}
$quehace = "ocupado";
$dos = "";
}
foreach my $canal (@posibles_internos)
{
$interno = $buttons{$canal};
$interno = "" if (!defined($interno));
$mensajefinal =
"<response data=\"$interno|$quehace|$dos\"/>\0";
for $quehay (keys %datos)
{
log_debug("** Active: $quehay", 16);
}
if (check_if_extension_is_busy($canal) eq "si"
&& $quehace eq 'corto')
{
log_debug("** Hangup but still busy", 16);
# Como SIP puede transferir por si mismo, quedan zombies en Asterisk
# Y no detecta bien el estado del cliente, forzamos un status
#### log_debug("** Force a status command", 16);
#### send_command_to_manager("Action: Status\r\n\r\n");
}
else
{
if (defined($mensajefinal) && $interno ne "")
{
push(@respuestas, $mensajefinal);
}
}
} # end foreach posibles_internos
}
else
{ # endif canal distinto de nada
log_debug("** There is no command defined", 16);
}
}
}
$cuantas = @respuestas;
log_debug("** There are $cuantas commands to send to flash clients", 16);
foreach my $valor (@respuestas) { log_debug("** R: $valor", 32); }
log_debug("** ---- End sub digiere_el_bloque ----", 16);
return @respuestas;
}
sub procesa_comando_cliente
{
# This function process a command received from a Flash client
# Including request of transfers, hangups, etc
my $comando = shift;
my $socket = shift;
my $datos = "";
my $accion = "";
my $password = "";
my $valor = "";
my $origin_channel = "";
my $canal_destino = "";
my $contexto = "";
my $btn_destino;
my $origin_context = "";
my $canal;
my $nroboton;
my $destino;
my $sesion;
my @partes;
my $ultimo;
my $clid;
my @pedazos;
log_debug("<= $comando\n", 4);
log_debug("** Incomming command from flash client", 16);
$comando =~ s/<msg data=\"(.*)\"\s?\/>/$1/g; # Removes XML markup
($datos, $accion, $password) = split(/\|/, $comando);
chop($password);
$datos =~ s/_level0\.casilla(\d+)/$1/g;
undef $origin_channel;
# Flash clients send a "contexto" command on connect, indicating
# the panel context they want to receive. We populate a hash with
# sockets/contexts in order to send only the events they want
# And because this is an initial connection, it triggers a status
# request to Asterisk
if ($accion =~ /^contexto\d+/)
{
my ($nada, $contextoenviado) = split(/\@/, $datos);
if (defined($contextoenviado))
{
$flash_contexto{$socket} = $contextoenviado;
}
else
{
$flash_contexto{$socket} = "";
}
send_initial_status();
}
# We have the origin button number from the drag&drop in the 'datos'
# variable. We need to traverse the %buttons hash in order to extract
# the channel name and the panel context, used to find the destination
# button of the command if any
while (($canal, $nroboton) = each(%buttons))
{
if ($nroboton eq $datos)
{
# A button key with an & is for a context channel
# A button key with an = if for a trunk channel
# This bit of code just cleans the channel name and context
@pedazos = split(/&/, $canal);
$origin_channel = $pedazos[0];
$origin_channel =~ s/(.*)[=](.*)/$1/g;
$origin_context = $pedazos[1];
}
}
if (defined($origin_channel))
{
if ("$password" eq "$security_code")
{
log_debug(
"** The channel selected is $origin_channel and the security code matches",
16
);
if ($accion =~ /-/)
{
#if action has an "-" the command has clid text to pass
@partes = split(/-/, $accion);
$ultimo = @partes;
$ultimo--;
$btn_destino = $partes[$ultimo];
$ultimo--;
$clid = $partes[$ultimo];
}
else
{
#strips the destination button (number at the end)
$btn_destino = $accion;
$btn_destino =~ s/[A-Za-z- ]//g;
if (defined($origin_context))
{
if (length($origin_context) > 0)
{
$btn_destino = $btn_destino . "@" . $origin_context;
}
}
}
# Now assigns the channel name to destino variable
# traversing the %buttons hash to find the key/channel
while (($canal, $nroboton) = each(%buttons))
{
if ($nroboton eq $btn_destino)
{
$canal =~ s/(.*)=(.*)/$1/g;
$destino = $canal;
}
}
if (is_number($destino))
{
# If the selected channel name is only digits, its a
# conference. So treat a conference command as a regular
# transfer or redirect. (We do not want to send into a
# meetme conference another ongoing meetme conference)
my @sesiones_del_canal =
extraer_todas_las_sesiones_de_un_canal($origin_channel);
my $cuantos = @sesiones_del_canal;
if ($accion =~ /^conference/)
{
if ($cuantos == 0)
{
$accion =~ s/conference/originate/g;
}
elsif ($cuantos > 0)
{
$accion =~ s/conference/transferir/g;
}
}
}
if ($accion eq "cortar")
{
log_debug("** Will try tu hangup channel: ", 16);
my @cuales_cortar =
extraer_todas_las_sesiones_de_un_canal($origin_channel);
foreach $valor (@cuales_cortar)
{
$comando = "Action: Hangup\r\n";
$comando .= "Channel: $valor\r\n\r\n";
log_debug("** Command received: $accion el $valor", 32);
send_command_to_manager($comando);
}
}
elsif ($accion =~ /^conference/)
{
my $originate = $extension_transfer{"$origin_channel"};
while (($canal, $nroboton) = each(%buttons))
{
if ($nroboton eq $btn_destino)
{
$canal =~ s/(.*)=(.*)/$1/g;
my @links =
extraer_todos_los_enlaces_de_un_canal($canal);
my @canal_transferir =
extraer_todas_las_sesiones_de_un_canal($canal);
log_debug(
"** !! $canal_transferir[0] $links[0] will be conferenced together with $origin_channel ($originate)",
16
);
$comando = "Action: Redirect\r\n";
$comando .= "Channel: $canal_transferir[0]\r\n";
$comando .= "ExtraChannel: $links[0]\r\n";
$comando .= "Exten: $auto_conf_exten\r\n";
$comando .= "ActionID: 1234\r\n";
$comando .= "Context: $meetme_context\r\n";
$comando .= "Priority: 1\r\n\r\n";
$auto_conference{$canal_transferir[0]} =
$origin_channel;
send_command_to_manager($comando);
}
}
}
elsif ($accion =~ /^ctransferir/)
{
$comando = "Action: Command\r\n";
$comando .= "Command: database put clid $destino ";
$comando .= "\"$clid\"\r\n\r\n";
send_command_to_manager($comando);
while (($canal, $nroboton) = each(%buttons))
{
if ($nroboton eq $btn_destino)
{
$canal =~ s/(.*)=(.*)/$1/g;
$canal_destino = $extension_transfer{"$canal"};
}
}
if ($canal_destino ne "-1")
{
if ($canal_destino =~ /\@/)
{
@pedazos = split(/\@/, $canal_destino);
$canal_destino = $pedazos[0];
$contexto = $pedazos[1];
}
my @cuales_transferir =
extraer_todas_las_sesiones_de_un_canal($origin_channel);
foreach my $valor (@cuales_transferir)
{
log_debug(
"** Will try to transfer $valor to extension number $canal_destino!",
16
);
$comando = "Action: Redirect\r\n";
$comando .= "Channel: $valor\r\n";
$comando .= "Exten: $canal_destino\r\n";
if ($contexto ne "")
{
$comando .= "Context: $contexto\r\n";
}
$comando .= "Priority: 1\r\n\r\n";
send_command_to_manager($comando);
}
}
else
{
log_debug("** Untransferable destination!", 16);
}
}
elsif ($accion =~ /^transferir/)
{
while (($canal, $nroboton) = each(%buttons))
{
if ($nroboton eq $btn_destino)
{
$canal =~ s/(.*)=(.*)/$1/g;
$canal_destino = $extension_transfer{"$canal"};
}
}
if ($canal_destino ne "-1")
{
if ($canal_destino =~ /\@/)
{
@pedazos = split(/\@/, $canal_destino);
$canal_destino = $pedazos[0];
$contexto = $pedazos[1];
}
my @cuales_transferir =
extraer_todas_las_sesiones_de_un_canal($origin_channel);
foreach my $valor (@cuales_transferir)
{
log_debug(
"** Will try to transfer $valor to extension number $canal_destino!",
16
);
$comando = "Action: Redirect\r\n";
$comando .= "Channel: $valor\r\n";
$comando .= "Exten: $canal_destino\r\n";
if ($contexto ne "")
{
$comando .= "Context: $contexto\r\n";
}
$comando .= "Priority: 1\r\n\r\n";
send_command_to_manager($comando);
}
}
else
{
log_debug("** Untransferable destination!", 16);
}
}
elsif ($accion =~ /^coriginate/)
{
$comando = "Action: Command\r\n";
$comando .= "Command: database put clid $destino ";
$comando .= "\"$clid\"\r\n\r\n";
send_command_to_manager($comando);
while (($canal, $nroboton) = each(%buttons))
{
if ($nroboton eq $btn_destino)
{
$canal =~ s/(.*)=(.*)/$1/g;
$canal_destino = $extension_transfer{"$canal"};
}
}
if ($canal_destino =~ /\@/)
{
@pedazos = split(/\@/, $canal_destino);
$canal_destino = $pedazos[0];
$contexto = $pedazos[1];
}
log_debug(
"** Will try to originate from $origin_channel to extension $canal_destino!",
16
);
#$clid =
# "$clid" . " <" . $extension_transfer{"$origin_channel"} . ">";
if ($origin_channel =~ /^IAX2/)
{
$origin_channel =~ s/^IAX2\[(.*)\]/IAX2\/$1/g;
}
$comando = "Action: Originate\r\n";
$comando .= "Channel: $origin_channel\r\n";
#$comando .= "Callerid: $clid\r\n";
$comando .= "Exten: $canal_destino\r\n";
if ($contexto ne "")
{
$comando .= "Context: $contexto\r\n";
}
$comando .= "Priority: 1\r\n";
$comando .= "\r\n";
send_command_to_manager($comando);
}
elsif ($accion =~ /^originate/)
{
while (($canal, $nroboton) = each(%buttons))
{
if ($nroboton eq $btn_destino)
{
$canal =~ s/(.*)=(.*)/$1/g;
$canal_destino = $extension_transfer{"$canal"};
}
}
if ($canal_destino =~ /\@/)
{
@pedazos = split(/\@/, $canal_destino);
$canal_destino = $pedazos[0];
$contexto = $pedazos[1];
}
log_debug(
"** Will try to originate from $origin_channel to extension $canal_destino!",
16
);
$clid =
$textos{"$datos"} . " <"
. $extension_transfer{"$origin_channel"} . ">";
if ($origin_channel =~ /^IAX2/)
{
$origin_channel =~ s/^IAX2\[(.*)\]/IAX2\/$1/g;
}
$comando = "Action: Originate\r\n";
$comando .= "Channel: $origin_channel\r\n";
$comando .= "Callerid: $clid\r\n";
$comando .= "Exten: $canal_destino\r\n";
if ($contexto ne "")
{
$comando .= "Context: $contexto\r\n";
}
$comando .= "Priority: 1\r\n";
$comando .= "\r\n";
send_command_to_manager($comando);
}
}
else
{
log_debug("** Password mismatch -$password-$security_code-!", 1);
}
}
else
{
log_debug("** There is no channel selected ?", 16);
}
}
sub send_initial_status
{
log_debug("** About to send Initial Status", 16);
send_command_to_manager("Action: Status\r\n\r\n");
# Send commands to check the mailbox stauts for each mailbox defined
while (my ($key, $val) = each(%mailbox))
{
log_debug("mailbox $key $val", 32);
send_command_to_manager(
"Action: MailboxStatus\r\nMailbox: $val\r\n\r\n");
}
for my $key (keys %buttons)
{
if ($key =~ /^\d+$/)
{
# If there is a meetme defined, query for status
send_command_to_manager(
"Action: Command\r\nActionID: meetme_$key\r\nCommand: meetme list $key\r\n\r\n"
);
}
}
send_command_to_manager("Action: QueueStatus\r\n\r\n");
}
sub procesa_comando
{
# This subroutine process the output for a manager "Command"
# sent, as 'sip show peers'
log_debug("** --- Start sub procesa_comando -----\n", 16);
my $texto = shift;
@bloque = ();
my @lineas = split("\r\n", $texto);
my $contador = 0;
my $interno = "";
my $estado = "";
my $nada = "";
my $conference = 0;
if ($texto =~ "ActionID: meetme")
{
# Its a meetme status report
foreach my $valor (@lineas)
{
$valor =~ s/\s+/ /g;
my ($key, $value) = split(/: /, $valor);
if (defined($key))
{
if ($key eq "ActionID")
{
$value =~ s/meetme_(\d+)$/$1/g;
$conference = $value;
}
if ($key eq "User #")
{
$contador++;
}
}
}
if ($contador > 0)
{
$bloque[0]{"Event"} = "MeetmeJoin";
$bloque[0]{"Meetme"} = $conference;
$bloque[0]{"Count"} = $contador;
$bloque[0]{"Fake"} = "hola";
}
}
else
{
# Its a sip show peers report
foreach my $valor (@lineas)
{
log_debug("** Line: $valor", 32);
$valor =~ s/\s+/ /g;
my @parametros = split(" ", $valor);
my $interno = $parametros[0];
my $ultimo = @parametros;
$ultimo = $ultimo - 1;
my $estado = $parametros[$ultimo];
if (defined($estado)
&& $estado ne "") # If set, is the status of 'sip show peers'
{
$interno = "SIP/" . $interno;
log_debug("** State: $estado Extension: $interno", 16);
$bloque[$contador]{"Event"} = "Regstatus";
$bloque[$contador]{"Channel"} = $interno;
$bloque[$contador]{"State"} = $estado;
$contador++;
}
}
}
log_debug("** --- End sub procesa_comando ---", 16);
}
sub procesa_bloque
{
log_debug("** --- Start sub procesa_bloque ---", 16);
my $blaque = shift;
my %bloque = %$blaque if defined(%$blaque);
my %hash_temporal = ();
my $evento = "";
my $canal = "";
my $sesion = "";
my $texto = "";
my $estado_final = "";
my $unico_id = "";
my $exten = "";
my $clid = "";
my $canalid = "";
my $key = "";
my $val = "";
my $return = "";
my $conquien = "";
my $enlazado = "";
my $viejo_nombre = "";
my $nuevo_nombre = "";
my $quehay = "";
my $elemento = "";
my $state = "";
my $exists = 0;
undef $unico_id;
while (my ($key, $val) = each(%bloque))
{
if ($key eq "Event")
{
$evento = "";
$hash_temporal{$key} = $val;
if ($val =~ /Newchannel/) { $evento = "newchannel"; }
if ($val =~ /Newcallerid/) { $evento = "newcallerid"; }
elsif ($val =~ /^Status$/) { $evento = "status"; }
elsif ($val =~ /^StatusComplete/) { $evento = "statuscomplete"; }
elsif ($val =~ /Newexten/) { $evento = "newexten"; }
elsif ($val =~ /ParkedCall/) { $evento = "parkedcall"; }
elsif ($val =~ /Newstate/) { $evento = "newstate"; }
elsif ($val =~ /Hangup/) { $evento = "hangup"; }
elsif ($val =~ /Rename/) { $evento = "rename"; }
elsif ($val =~ /MessageWaiting/) { $evento = "voicemail"; }
elsif ($val =~ /Regstatus/) { $evento = "regstatus"; }
elsif ($val =~ /Unlink/) { $evento = "unlink"; }
elsif ($val =~ /QueueParams/) { $evento = "queueparams"; }
elsif ($val =~ /Link/) { $evento = "link"; }
elsif ($val =~ /^Join/) { $evento = "join"; }
elsif ($val =~ /^MeetmeJoin/) { $evento = "meetmejoin"; }
elsif ($val =~ /^MeetmeLeave/) { $evento = "meetmeleave"; }
elsif ($val =~ /^SIPPeerRegistration/)
{
$evento = "sipregistration";
}
elsif ($val =~ /^SIPPeerStatus/) { $evento = "sipregistration"; }
elsif ($val =~ /^Leave/) { $evento = "leave"; }
else { log_debug("** No event match ($val)", 16); }
}
else
{ # Guarda todos los otros datos en un hash nuevo
$hash_temporal{$key} = $val;
}
}
$unico_id = "";
$unico_id = $hash_temporal{"Uniqueid"}
if defined($hash_temporal{"Uniqueid"});
$enlazado = "";
$enlazado = $datos{$unico_id}{"Link"}
if defined($datos{$unico_id}{"Link"});
$enlazado .= " - " . $datos{$unico_id}{"Context"}
if defined($datos{$unico_id}{"Context"});
$enlazado .= ":" . $datos{$unico_id}{"Priority"}
if defined($datos{$unico_id}{"Priority"});
if ($evento eq "queueparams")
{
$canal = $hash_temporal{"Queue"};
$canal =~ tr/a-z/A-Z/;
$estado_final = "ocupado";
my $plural = "";
if ($hash_temporal{"Calls"} > 0)
{
if ($hash_temporal{"Calls"} > 1) { $plural = "s"; }
$texto =
$hash_temporal{"Calls"} . " member$plural waiting on queue...";
$unico_id = $canal;
$return = "$canal|$estado_final|$texto|$unico_id|$canalid";
$evento = "";
}
}
if ($evento eq "join")
{
$canal = $hash_temporal{"Queue"};
$canal =~ tr/a-z/A-Z/;
$estado_final = "ocupado";
my $plural = "";
if ($hash_temporal{"Count"} > 1) { $plural = "s"; }
$texto = $hash_temporal{"Count"} . " member$plural waiting on queue...";
$unico_id = $canal;
$return = "$canal|$estado_final|$texto|$unico_id|$canalid";
$evento = "";
}
if ($evento eq "meetmejoin")
{
my $originate = "no";
$canal = $hash_temporal{"Meetme"};
$canal =~ tr/a-z/A-Z/;
# Originates a call to the third extension if it finds
# an auto created conference
for $quehay (keys %auto_conference)
{
if ($quehay eq $hash_temporal{"Channel"})
{
$originate = $auto_conference{"$quehay"};
}
}
if ($originate ne "no")
{
my $comando = "Action: Originate\r\n";
$comando .= "Channel: $originate\r\n";
$comando .= "Exten: $canal\r\n";
$comando .= "Context: $meetme_context\r\n";
$comando .= "Priority: 1\r\n";
$comando .= "\r\n";
send_command_to_manager($comando);
}
$estado_final = "ocupado";
my $plural = "";
if (!defined($hash_temporal{"Fake"}))
{
if (!defined($datos{$canal}{"Count"}))
{
$datos{$canal}{"Count"} = 0;
}
$datos{$canal}{"Count"}++;
}
if ($datos{$canal}{"Count"} > 1) { $plural = "s"; }
$texto = $datos{$canal}{"Count"} . " member$plural on conference.";
$unico_id = $canal;
$return = "$canal|$estado_final|$texto|$unico_id|$canalid";
$evento = "";
}
if ($evento eq "meetmeleave")
{
$canal = $hash_temporal{"Meetme"};
$canal =~ tr/a-z/A-Z/;
$estado_final = "ocupado";
my $plural = "";
$datos{$canal}{"Count"}--;
if ($datos{$canal}{"Count"} > 1) { $plural = "s"; }
if ($datos{$canal}{"Count"} <= 0) { $estado_final = "corto"; }
$texto = $datos{$canal}{"Count"} . " member$plural on conference.";
$unico_id = $canal;
$return = "$canal|$estado_final|$texto|$unico_id|$canalid";
$evento = "";
my $canaleja = $hash_temporal{"Channel"};
delete $auto_conference{$canaleja};
log_debug("** Erasing auto_conference $canaleja", 16);
for $quehay (keys %auto_conference)
{
log_debug("** Remaining conferences: $quehay", 16);
}
}
if ($evento eq "leave")
{
$canal = $hash_temporal{"Queue"};
$canal =~ tr/a-z/A-Z/;
$estado_final = "ocupado";
my $plural = "";
if ($hash_temporal{"Count"} > 1) { $plural = "s"; }
if ($hash_temporal{"Count"} == 0) { $estado_final = "corto"; }
$texto = $hash_temporal{"Count"} . " member$plural on queue";
$unico_id = $canal;
$return = "$canal|$estado_final|$texto|$unico_id|$canalid";
$evento = "";
}
if ($evento eq "voicemail")
{
while (my ($ecanal, $eextension) = each(%mailbox))
{
if ($eextension eq $hash_temporal{"Mailbox"})
{
$canal = $ecanal;
}
}
$unico_id = $canal;
if (defined($hash_temporal{"Waiting"}))
{
$estado_final = "voicemail";
$texto = $hash_temporal{"Waiting"};
if ($texto eq "1")
{
# If it has new voicemail, ask for mailboxcount
send_command_to_manager(
"Action: MailboxCount\r\nMailbox: $hash_temporal{'Mailbox'}\r\n\r\n"
);
}
}
else
{
$estado_final = "voicemailcount";
my $nuevos = $hash_temporal{"NewMessages"};
my $viejos = $hash_temporal{"OldMessages"};
$texto = "New: $nuevos, Old: $viejos";
}
$return = "$canal|$estado_final|$texto|$unico_id|$canalid";
$evento = "";
}
if ($evento eq "link")
{
my $uniqueid1 = $hash_temporal{"Uniqueid1"};
my $uniqueid2 = $hash_temporal{"Uniqueid2"};
my $channel1 = $hash_temporal{"Channel1"};
my $channel2 = $hash_temporal{"Channel2"};
$datos{$uniqueid1}{"Link"} = $channel2;
$datos{$uniqueid2}{"Link"} = $channel1;
my ($canal1, $sesion1) = remove_session_from_channel($channel1);
my ($canal2, $sesion2) = remove_session_from_channel($channel2);
$return = "$canal1|link|$canal2|$uniqueid1|";
delete $datos{$unico_id};
$evento = "";
$canal = $canal1;
$estado_final = "ocupado";
}
if ($evento eq "newexten")
{
# Si es una extension nueva sin state, por defecto lo pone en UP
$datos{$unico_id}{'State'} = "Up";
}
if ($evento eq "rename")
{
log_debug("** RENAME Event", 16);
$evento = "";
while (($key, $val) = each(%hash_temporal))
{
if ($key =~ /newname/i)
{
my $nuevo_nombre = $val;
}
if ($key =~ /oldname/i)
{
my $viejo_nombre = $val;
}
}
for $quehay (keys %datos)
{
while (($key, $val) = each(%{$datos{$quehay}}))
{
if (($key eq "Channel") && ($val eq $viejo_nombre))
{
$datos{"$quehay"}{"$key"} = $nuevo_nombre;
}
}
}
}
if ($evento eq "unlink")
{
my $canal1 = $hash_temporal{"Channel1"};
my $canal2 = $hash_temporal{"Channel2"};
# erase_instances_for_trunk_buttons($canal1);
# erase_instances_for_trunk_buttons($canal2);
$canal1 =~ s/(.*)[-\/](.*)(<.*>)/$1\t$2/g;
$canal2 =~ s/(.*)[-\/](.*)(<.*>)/$1\t$2/g;
erase_all_sessions_from_channel($canal1);
erase_all_sessions_from_channel($canal2);
log_debug("** Unlink $canal1 and $canal2", 16);
$evento = "";
}
if ($evento eq "sipregistration")
{
if (defined $hash_temporal{"Peername"})
{
$canal = $hash_temporal{"Peername"};
}
if (defined $hash_temporal{"Peer"})
{
$canal = $hash_temporal{"Peer"};
}
$state = $hash_temporal{"Status"};
log_debug(
"** Event sipregistration|peerstatus chan: $canal, state: $state",
16);
if ($state eq "Registred")
{
$estado_final = "registrado";
$texto = "Registrado";
}
elsif ($state eq "reachable")
{
$estado_final = "registrado";
$texto = "Registrado";
}
elsif ($state eq "unreachable")
{
$estado_final = "unreachable";
$texto = "No Reachable";
}
elsif ($state eq "lagged")
{
$estado_final = "noregistrado";
$texto = "Lagged";
}
$evento = "";
$return = "SIP/$canal|$estado_final|$texto|$unico_id|$canalid";
log_debug("** $return", 16);
}
# if ($evento eq "status") {
# push(@status_active,$unico_id);
# }
# if ($evento eq "statuscomplete") {
#
# for $quehay (keys %datos) {
# $exists=0;
# foreach my $valor (@status_active) {
# if($valor eq $quehay) {
# $exists=1;
# }
# }
# if($exists == 0) {
# # If not found in status, delete the hash from %datos
# delete $datos{$quehay};
# log_debug("** ACABO DE BORRAR la SESSION $quehay",16);
# }
# }
# @status_active = ();
# }
if ($evento ne "")
{
log_debug("** Event $evento", 16);
while (my ($key, $val) = each(%hash_temporal))
{
$datos{$unico_id}{"$key"} = $val;
}
if ($evento eq "hangup")
{
$datos{$unico_id}{'State'} = "Down";
}
log_debug("** Event " . $datos{$unico_id}{'Event'}, 32);
# De acuerdo a los datos de la extension genera
# la linea con info para el flash
$elemento = $datos{$unico_id}{'Channel'}
if defined($datos{$unico_id}{'Channel'});
my $canalsesion = $datos{$unico_id}{'Channel'}
if defined($datos{$unico_id}{'Channel'});
if ($elemento =~ /^IAX2/ && $elemento =~ /\@/)
{
# The channel is IAX2 and has the @context
# I will remove the @context/host because it varies
$elemento =~ s/IAX2\[(.*)@(.*)\](.*)/IAX2\[$1\]$3/g;
}
$elemento =~ s/(.*)[-\/](.*)/$1\t$2/g;
$elemento =~ tr/a-z/A-Z/;
($canal, $sesion) = split(/\t/, $elemento);
if (defined($canal))
{
if (defined($instancias{$canal}) && $evento ne "regstatus")
{
$canal = count_instances_for_channel($canalsesion);
}
}
$canal =~ tr/a-z/A-Z/ if defined($canal);
if (!defined($canal)) { $canal = ""; }
$exten = $datos{$unico_id}{'Extension'}
if (defined($datos{$unico_id}{'Extension'}));
$clid = $datos{$unico_id}{'Callerid'}
if (defined($datos{$unico_id}{'Callerid'}));
$state = $datos{$unico_id}{'State'}
if (defined($datos{$unico_id}{'State'}));
if ($evento eq "parkedcall")
{
$texto = "Parked on " . $datos{$unico_id}{'Exten'};
$estado_final = "ringing";
}
if ($state eq "Ring")
{
$texto = "Making call " . $exten;
$estado_final = "ocupado";
}
if ($state =~ /^UNK/)
{
$texto = "No registrado " . $exten;
$estado_final = "noregistrado";
}
if ($state =~ /^UNR/)
{
$texto = "No alcanzable " . $exten;
$estado_final = "unreachable";
}
if ($state =~ /^Unm/)
{
$texto = "Registrado " . $exten;
$estado_final = "registrado";
}
if ($state =~ /^OK/)
{
$texto = "Registrado " . $exten;
$estado_final = "registrado";
}
if ($state eq "Ringing")
{
$texto = "Incomming call from " . $clid . " " . $enlazado;
$estado_final = "ringing";
}
if ($state eq "Down")
{
$canalid = $elemento;
$estado_final = "corto";
erase_instances_for_trunk_buttons($canalsesion);
}
if ($state eq "Up")
{
if ($exten ne "")
{
$conquien = $exten;
}
else
{
$conquien = $clid;
}
$texto = "Talking to $conquien - $enlazado";
$estado_final = "ocupado";
}
# Remove special character from Caller ID string
$texto =~ s/\"/'/g;
$texto =~ s/</[/g;
$texto =~ s/>/]/g;
$return = "$canal|$estado_final|$texto|$unico_id|$canalid";
}
else
{
log_debug("** No 'event' in block ($evento)", 32);
}
log_debug("** --- End sub procesa_bloque -----", 16);
if ($canal ne "" && $estado_final ne "")
{
log_debug("** Return $return", 16);
return $return;
}
}
sub count_instances_for_channel
{
my $canalid = shift;
my $sesion;
my $canalglobal;
my @uniq;
$canalid =~ s/(.*)<(.*)>/$1/g;
$canalid =~ tr/a-z/A-Z/;
log_debug("** Count instances channel $canalid", 16);
$canalglobal = $canalid;
$canalglobal =~ s/(.*)[-\/](.*)/$1/g;
$canalglobal =~ s/IAX2\[(.*)@(.*)\]/IAX2\[$1\]/g;
$canalglobal =~ tr/a-z/A-Z/;
my $cuantos = @{$instancias{$canalglobal}};
if (!defined($orden_instancias{$canalid}))
{
$cuantos++;
$orden_instancias{$canalid} = $cuantos;
}
if (defined($instancias{$canalglobal}))
{
push @{$instancias{$canalglobal}}, $canalid;
my %seen = ();
@uniq = grep { !$seen{$_}++ } @{$instancias{$canalglobal}};
delete $instancias{$canalglobal};
$instancias{$canalglobal} = [@uniq];
my $contador = 0;
foreach my $valor (@uniq)
{
$contador++;
if ($valor eq $canalid)
{
my $queboton = $orden_instancias{$canalid};
return "$canalglobal=$queboton";
}
}
}
}
sub remove_session_from_channel()
{
my $elemento = shift;
$elemento =~ s/(.*)[-\/](.*)/$1\t$2/g;
$elemento =~ tr/a-z/A-Z/;
my @partes = split(/\t/, $elemento);
return @partes;
}
sub erase_instances_for_trunk_buttons()
{
my $canalid = shift;
my $canalglobal;
my $valor;
my @new;
$canalid =~ s/(.*)<(.*)>/$1/g;
$canalid =~ tr/a-z/A-Z/;
$canalglobal = $canalid;
$canalglobal =~ s/(.*)[-\/](.*)/$1/g;
$canalglobal =~ s/IAX2\[(.*)@(.*)\]/IAX2\[$1\]/g;
$canalglobal =~ tr/a-z/A-Z/;
if (defined($instancias{$canalglobal}))
{
log_debug("** Erase instance $canalid", 16);
foreach $valor (@{$instancias{$canalglobal}})
{
if ($valor ne $canalid)
{
push(@new, $valor);
}
}
delete $instancias{$canalglobal};
delete $orden_instancias{$canalid};
my $cuantos = @new;
if ($cuantos == 0)
{
$instancias{$canalglobal} = [];
}
else
{
$instancias{$canalglobal} = [@new];
}
foreach $valor (@new)
{
log_debug("Session remaining: $valor", 64);
}
}
}
sub erase_all_sessions_from_channel
{
my $canalid = shift;
$canalid =~ s/(.*)<(.*)>/$1/g;
log_debug("** Erase all instances of channel $canalid", 16);
my $quehay = "";
for $quehay (keys %datos)
{
while (my ($key, $val) = each(%{$datos{$quehay}}))
{
if ($key eq "Channel")
{
$val =~ s/(.*)[-\/](.*)/$1\t$2/g;
if ($val =~ /$canalid/i)
{
log_debug(
"** Found a match $canalid=$val ($quehay) - Cleared!",
16);
delete $datos{$quehay};
}
}
}
}
}
sub extraer_todas_las_sesiones_de_un_canal
{
my $canal = shift;
my $canalbase = "";
my $sesion_numero = "";
my $sesion = "";
my $key = "";
my $val = "";
my $quehay = "";
my @result = ();
log_debug("** Extracts all sessions from the channel $canal", 16);
# Checks if the channel name has an equal sign
# (its a trunk button channel)
if ($canal =~ /(.*)=(\d+)/)
{
($canalbase, $sesion_numero) = split(/\=/, $canal);
log_debug("** Its a trunk $canalbase button number $sesion_numero!", 8);
# $sesion_numero--;
# push(@result, $instancias{$canalbase}[$sesion_numero]);
for $quehay (keys %orden_instancias)
{
my $vel = $quehay;
$vel =~ s/IAX2\[(.*)@(.*)\](.*)/IAX2\[$1\]$3/g;
$vel =~ s/(.*)[-\/](.*)/$1/g;
if ($vel eq $canalbase)
{
my $orden = $orden_instancias{$quehay};
$orden = $orden + 1 - 1;
if ($sesion_numero == $orden)
{
push(@result, $quehay);
}
}
}
}
my $cuantos = @result;
if ($cuantos == 0)
{
# If there is no results for a trunk button, look into the %datos
# hash.
for $quehay (keys %datos)
{
while (($key, $val) = each(%{$datos{$quehay}}))
{
if (defined($val))
{
my $vel = $val;
if ($vel =~ /^IAX2/)
{
$vel =~ s/IAX2\[(.*)@(.*)\](.*)/IAX2\[$1\]$3/g;
}
if ($vel =~ /^\Q$canal\E[-\/]/i && $key eq "Channel")
{
push(@result, $val);
log_debug("** Sesion: $val", 16);
}
}
}
}
}
return @result;
}
sub extraer_todos_los_enlaces_de_un_canal
{
my $canal = shift;
my $quehay = "";
my @result = ();
for $quehay (keys %datos)
{
my $canalaqui = 0;
my $linkeado = "";
while (my ($key, $val) = each(%{$datos{$quehay}}))
{
if ($val =~ /^$canal/i && $key =~ /^Chan/i)
{
$canalaqui = 1;
}
if ($key =~ /^Link/i)
{
$linkeado = $val;
}
}
if ($canalaqui == 1 && $linkeado ne "")
{
push(@result, $linkeado);
}
}
return @result;
}
sub check_if_extension_is_busy
{
my $interno = shift;
my $return = "no";
my $quehay = "";
my $canal = "";
my $sesion = "";
my $comando = "";
for $quehay (keys %datos)
{
while (my ($key, $val) = each(%{$datos{$quehay}}))
{
if ($key eq "Channel")
{
if ($val =~ /ZOMBIE/)
{
if ($kill_zombies == 1)
{
# If it finds a Zombie, try to hang it up
$comando = "Action: Hangup\r\n";
$comando .= "Channel: $val\r\n\r\n";
send_command_to_manager($comando);
log_debug("** ZOMBIE!! I will try to kill it!! $val",
16);
}
}
else
{
$val =~ s/(.*)[-\/](.*)/$1\t$2/g;
($canal, $sesion) = split(/\t/, $val);
$canal =~ tr/a-z/A-Z/;
if ($canal eq $interno)
{
$return = "si";
log_debug(
"** Extension still busy $canal $interno!!!!!!",
16);
}
else
{
log_debug("** $canal <> $interno", 32);
}
}
}
}
}
return $return;
}
sub log_debug
{
my $texto = shift;
$texto =~ s/\0//g;
my $nivel = shift;
if (!defined($nivel)) { $nivel = 1; }
if (!defined($debug)) { $debug = 1; }
print "$texto\n" if $debug & $nivel;
}
sub alarma_al_minuto
{
if (defined $p)
{
my $comando = "Action: Command\r\n";
$comando .= "Command: sip show peers\r\n\r\n";
send_command_to_manager($comando);
}
alarm($poll_interval);
}
sub send_command_to_manager
{
my $comando = shift;
if (defined $p)
{
my @lineas = split("\r\n", $comando);
foreach my $linea (@lineas)
{
syswrite($p, "$linea\r\n");
log_debug("-> $linea", 2);
}
log_debug(" ", 2);
syswrite($p, "\r\n");
}
}
sub is_number
{
my $num = shift;
if (!defined($num)) { return 1; }
if ($num =~ /[^0-9]/)
{
return 0;
}
else
{
return 1;
}
}
sub close_all
{
log_debug("Exiting...", 0);
foreach my $hd ($O->handles)
{
$O->remove($hd);
close($hd);
}
exit(0);
}