#!/usr/bin/perl -w 

use strict;
use IO::Socket;
use IO::Select;

##########################################
# CONFIGURATION
#
# parameters to connect to Asterisk Manager
my $manager_host   = "192.168.0.1";
my $manager_user   = "dddd";
my $manager_secret = "ddddd";

#
# parameters for the op_server
my $web_hostname  = "sip.house.com.ar";   # must be the same address you use to contact the web server
my $listen_port   = 4445;
my $security_code = 'ddddd';           # secret code for performing hangups and transfers

#
# location of variables.txt needed by the flash applet
# (must be the same directory as the web page and swf file)
my $flash_dir = "/var/www/html/panel";

#
# Debug level to stdot
my $debug = 3;
##########################################
# From now on do not modify!

my $flash_file = $flash_dir . "/variables.txt";
my %datos      = ();
my $bloque_completo;
my $bloque_final;
my $todo;
my @bloque;
my @respuestas;
my %botones;
my %textos;

$SIG{PIPE} = 'IGNORE';
$SIG{ALRM} = 'alarma_al_minuto';
$SIG{INT}  = 'cierra_todo';

sub lee_config() {

    open( CONFIG, "<op_server.cfg" );

    while (<CONFIG>) {
        my $campo1 = "";
        my $campo3 = "";
        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/,$/;
        $botones{"$campos[0]"} = $campos[1];
        $textos{"$campos[1]"}  = $campos[2];
    }
    close(CONFIG);
}

sub genera_config {
    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;
        print VARIABLES "&texto$key=$val";
    }
    print VARIABLES "&CheckDone=1";
    close(VARIABLES);
}


if (!(-r "op_server.cfg")) {
  die("Missing op_server.cfg file");
}


lee_config();
genera_config();

my $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";

syswrite( $p, "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";
my $O = new IO::Select();
$O->add($m);
$O->add($p);
$/ = "\0";

alarm(15);

while (1) {

    while ( my @S = $O->can_read ) {
        foreach (@S) {

            if ( $_ == $m ) {

                # Se conecto un nuevo cliente, envio un pedido de Status
                log_debug( "Se conecto un nuevo cliente, manda un Status", 3 );
                my $C = $m->accept;
                $O->add($C);
                syswrite( $p, "Action: Status\r\n\r\n" );
            } else {

                # No es conexion nueva
                my $i;
                my $R = sysread( $_, $i, 2048 );
                if ( defined($R) && $R == 0 ) {
                    my $T = syswrite( $_, ' ', 2048 );
                    if ( defined($T) ) { }
                    else { $O->remove($_); }
                } else {

                    # pudo leer 2048 bytes en $i
                    log_debug( "I es igual a:\n--------\n$i\n-------\nLargo de i: " . length($i) . "\n------", 1 );
                    $bloque_completo = "" if ( !defined($bloque_completo) );

                    if (   ( substr( $i, -4 ) eq "\r\n\r\n" )
                        || ( substr( $i, -4 ) eq " />\0" ) )
                    {
                        log_debug( "Es un fin de linea!", 1 );
                        $bloque_final    = $bloque_completo . $i;
                        $bloque_completo = "";
                    } else {
                        my $quehay = substr( $i, -4 );
                        log_debug( "No es un fin de linea --$quehay--!", 1 );
                        $bloque_completo .= $i;
                        next;
                    }
                    foreach my $C ( $O->handles ) {
                        if ( $C == $p ) {

                            # Recibimos un evento de Asterisk
                            # Leo la info y armo bloques de datos para
                            # parsear en procesa_bloque
                            if ( $bloque_final =~ /Event:/ ) {
                                log_debug( "Hay Event en el bloque", 1 );
                                my @lineas = split( /\r\n/, $bloque_final );
                                @bloque = ();
                                my $contador = 0;
                                foreach $p (@lineas) {
                                    log_debug( "Parseo linea: $p", 4 );
                                    if ( $p =~ /Event:/ ) {
                                        log_debug( "Detectado evento! $p", 2 );
                                        $contador++;
                                    }
                                    my ( $atributo, $valor ) = split( /: /, $p );
                                    if ( defined $atributo && $atributo ne "" ) {
                                        $bloque[$contador]{"$atributo"} = $valor;
                                    }
                                }
                                log_debug( "Hay $contador bloques para procesar", 4 );
                                @respuestas = ();
                                log_debug( "Respuestas vaciadas", 4 );
                                @respuestas = digiere_el_bloque_y_devuelve_array_de_respuestas(@bloque);
                                my $cuantas = @respuestas;
                            } elsif ( $i =~ /--END/ ) {
                                log_debug( "El bloque tiene END en el texto", 1 );
                                $todo .= $bloque_final;
                                procesa_comando($todo);
                                my $cuantos = @bloque;
                                log_debug( "Hay $cuantos bloques para procesar", 1 );
                                @respuestas = digiere_el_bloque_y_devuelve_array_de_respuestas(@bloque);
                                $todo       = "";
                            } else {
                                log_debug( "No tiene event ni END, vacio los datos", 1 );

                                # No tiene Event en el texto, vacio los datos
                                @bloque = ();
                                $todo .= $bloque_final;
                            }
                        } else {
                            log_debug( "Bloque else para escribir a cliente flash", 2 );
                            my $cuantas = @respuestas;

                            # Escribe mensajes a los clientes Flash
                            # Recibio algo de un cilente?
                            # $print "Recibi de un cliente $i\n";
                            foreach my $valor (@respuestas) {
                                log_debug( "Escribo respuesta al cliente: $valor", 2 );
                                my $T = syswrite( $C, $valor, length($valor) );
                            }    # cierra foreach respuestas
                        }
                    }    # cierra el foreach handles

                    if ( $i =~ /^<msg/ ) {

                        # Trata de procesar los comandos recibidos
                        # de los clientes flash
                        procesa_comando_cliente($i);
                    }
                }
            }
        }    # end foreach @S -> can read
    }    # while can read
}    # endless loop

sub digiere_el_bloque_y_devuelve_array_de_respuestas {
    log_debug( "---- Empieza Digiere bloques ----", 1 );
    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;

    foreach my $blaque (@bloque) {
        log_debug( "Voy a procesar un bloque", 2 );
        $mensaje = procesa_bloque($blaque);
        delete $datos{""};

        ( $canal, $quehace, $dos, $uniqueid, $canalid ) =
          split( /\|/, $mensaje );
        if ( !defined($canal) )   { $canal   = ""; }
        if ( !defined($quehace) ) { $quehace = ""; }
        if ( !defined($dos) )     { $dos     = ""; }
        log_debug("Canal $canal en digiere!",1);
        if ( $canal ne "" ) {
            $interno      = $botones{$canal};
	    while ( my ($pepe,$papo) = each(%botones)) {
                 print "$pepe $papo\n";
            }
            log_debug("Interno $interno en digiere!",1);
            $interno      = "" if ( !defined($interno) );
            $mensajefinal = "<response data=\"$interno|$quehace|$dos\"/>\0";

            if ( $quehace eq 'corto' ) {
                delete $datos{$uniqueid};
                log_debug( "Corta, borra variable $uniqueid", 2 );
            }

            for $quehay ( keys %datos ) {
                log_debug( "Activos: $quehay", 5 );
                while ( my ( $key, $val ) = each( %{ $datos{$quehay} } ) ) {
                    log_debug( " -> $key = $val", 7 );
                }
            }
            if ( $quehace eq 'corto' ) {
                borra_todas_las_instancias_del_canal($canalid);
            }

            if ( chequea_interno_ocupado($canal) eq "si"
                && $quehace eq 'corto' )
            {
                log_debug( "Corto pero sigue ocupado!", 2 );

                # Como SIP puede transferir por si mismo, quedan zombies en Asterisk
                # Y no detecta bien el estado del cliente, forzamos un status
                log_debug( "Forzamos un status", 2 );

                syswrite( $p, "Action: Status\r\n\r\n" );
            } else {
                log_debug( "Mensaje final digerido: $mensajefinal", 1 );
                push( @respuestas, $mensajefinal );
                $cuantas = @respuestas;
            }
        } else {    # endif canal distinto de nada
            log_debug( "No esta definida la respuesta", 2 );
        }
    }    # cierra foreach bloques
    foreach my $valor (@respuestas) { log_debug( "R: $valor", 4 ); }
    log_debug( "---- Termina Digiere bloques ----", 1 );
    return @respuestas;
}

sub procesa_comando_cliente {
    log_debug( "Proceso el comando provieniente de un cliente flash!", 2 );
    my $comando       = shift;
    my $datos         = "";
    my $accion        = "";
    my $password      = "";
    my $valor         = "";
    my $canal_elegido = "";
    my $canal_destino = "";
    my $canal;
    my $nroboton;
    my $destino;

    $comando =~ s/<msg data=\"(.*)\"\s?\/>/$1/g;
    ( $datos, $accion, $password ) = split( /\|/, $comando );
    chop($password);
    $datos =~ s/_level0\.casilla(\d+)/$1/g;
    undef $canal_elegido;

    while ( ( $canal, $nroboton ) = each(%botones) ) {
        if ( $nroboton eq $datos ) {
            $canal_elegido = $canal;
            log_debug( "Si!!", 4 );
        }
    }
    if ( defined($canal_elegido) ) {
        if ( "$password" eq "$security_code" ) {
            log_debug( "El canal elegido es $canal_elegido y la clave coincide", 1 );
            if ( $accion eq "cortar" ) {
                my @cuales_cortar = extraer_todas_las_sesiones_de_un_canal($canal_elegido);
                foreach $valor (@cuales_cortar) {
                    $comando = "Action: Hangup\r\n";
                    $comando .= "Channel: $valor\r\n\r\n";
                    log_debug( "Comando recibido: $accion el $valor", 2 );
                    syswrite( $p, $comando );
                }
            } elsif ( $accion =~ /^transf/ ) {
                $destino = $accion;
                $destino =~ s/transferir//g;

                while ( ( $canal, $nroboton ) = each(%botones) ) {
                    if ( $nroboton eq $destino ) {
                        $canal_destino = $canal;
                        log_debug( "Si!!", 4 );
                    }
                }
                $canal_destino =~ s/.*\/(\d*)/$1/g;
                my @cuales_transferir = extraer_todas_las_sesiones_de_un_canal($canal_elegido);
                foreach $valor (@cuales_transferir) {
                    log_debug( "Voy a transferir el $valor al $canal_destino!", 1 );
                    $comando = "Action: Redirect\r\n";
                    $comando .= "Channel: $valor\r\n";
                    $comando .= "Exten: $canal_destino\r\n";
                    $comando .= "Priority: 1\r\n\r\n";
                    syswrite( $p, $comando );
                }
            }
        } else {
            log_debug( "La clave no coincide -$password-$security_code-!", 1 );
        }
    } else {
        log_debug( "No hay canal elegido", 1 );
    }
}

sub procesa_comando {

    log_debug( "--- Empieza procesa_comando -----\n", 1 );

    my $texto = shift;
    @bloque = ();
    my @lineas   = split( "\n", $texto );
    my $contador = 0;
    my $interno  = "";
    my $estado   = "";
    my $nada     = "";

    foreach my $valor (@lineas) {
        log_debug( "Linea: $valor", 4 );
        $valor =~ s/\s+/ /g;
        ( $interno, $nada, $nada, $nada, $nada, $estado ) =
          split( " ", $valor );
        if ( defined($estado) && $estado ne "" ) {
            log_debug( "Estado: $estado", 5 );
            $interno =~ s/(.*)\/(.*)/SIP\/$1/g;
            $bloque[$contador]{"Event"}   = "Regstatus";
            $bloque[$contador]{"Channel"} = $interno;
            $bloque[$contador]{"State"}   = $estado;
            $contador++;
        }
    }
    log_debug( "--- Termina procesa_comando - hay $contador bloques ----", 1 );
}

sub procesa_bloque {

    log_debug( "Comienzo subrutina procesa_bloque", 3 );

    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         = "";

    undef $unico_id;

    log_debug( "\n\n--- Empieza Procesa_bloque ---", 2 );
    while ( my ( $key, $val ) = each(%bloque) ) {
        if ( $key eq "Event" ) {
            $evento = "";
            $hash_temporal{$key} = $val;
            if    ( $val =~ /Newchannel/ ) { $evento = "newchannel"; }
            elsif ( $val =~ /Status/ )     { $evento = "status"; }
            elsif ( $val =~ /Newexten/ )   { $evento = "newexten"; }
            elsif ( $val =~ /Newstate/ )   { $evento = "newstate"; }
            elsif ( $val =~ /Hangup/ )     { $evento = "hangup"; }
            elsif ( $val =~ /Rename/ )     { $evento = "rename"; }
            elsif ( $val =~ /Regstatus/ )  { $evento = "regstatus"; }
            elsif ( $val =~ /Unlink/ )     { $evento = "unlink"; }
            else { log_debug( "No machea evento ($val)", 2 ); }
        } 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 "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( "Evento RENOMBRAR!!!!", 2 );
        $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;
                    print "Renombre $viejo_nombre por $nuevo_nombre\n";
                }
            }
        }
    }

    if ( $evento eq "unlink" ) {
        my $canal1 = $hash_temporal{"Channel1"};
        my $canal2 = $hash_temporal{"Channel2"};
        borra_todas_las_instancias_del_canal($canal1);
        borra_todas_las_instancias_del_canal($canal2);
        log_debug( "Desenlaza $canal1 de $canal2", 2 );
        $evento = "";
    }

    if ( $evento ne "" ) {    # Ignora eventos link unlink
        log_debug( "Puso evento en switch $evento", 2 );

        while ( my ( $key, $val ) = each(%hash_temporal) ) {
            $datos{$unico_id}{"$key"} = $val;
        }

        if ( $evento eq "hangup" ) {
            $datos{$unico_id}{'State'} = "Down";

            # Acordarse de borrar el array una vez devuelto el mensaje!!!!!
            # !!!!!!!!!!!!!!!!
        }
        log_debug( "Evento " . $datos{$unico_id}{'Event'}, 2 );

        # 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'} );
	$elemento =~ s/(.*)[-\/](.*)/$1\t$2/g;
	($canal,$sesion) = split(/\t/,$elemento);

        $canal =~ tr/a-z/A-Z/ if defined($canal);
        if ( !defined($canal) ) { $canal = ""; }

        log_debug( "!!! Canal: $canal", 3 ) if ( defined($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 ( $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        = "No 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";
        }

        if ( $state eq "Up" ) {
            if ( $exten ne "" ) {
                $conquien = $exten;
            } else {
                $conquien = $clid;
            }

            $texto        = "Talking to $conquien - $enlazado";
            $estado_final = "ocupado";
        }

        # Saca caracteres especiales del caller id
        $texto =~ s/\"/'/g;
        $texto =~ s/</[/g;
        $texto =~ s/>/]/g;

        $return = "$canal|$estado_final|$texto|$unico_id|$canalid";

    } else {

        log_debug( "No puso evento en switch ($evento)", 2 );
    }
    log_debug( "--- Termina Procesa Bloque -----", 3 );

    if ( $canal ne "" ) {
        return $return;
    }

}

sub borra_todas_las_instancias_del_canal {
    my $canalid = shift;
    my $quehay  = "";
    for $quehay ( keys %datos ) {
        while ( my ( $key, $val ) = each( %{ $datos{$quehay} } ) ) {
            if ( $val eq $canalid ) {
                log_debug( "Esta instancia es igual $canalid=$val ($quehay)!!", 2 );
                delete $datos{$quehay};
            }
        }
    }
}

sub extraer_todas_las_sesiones_de_un_canal {
    my $canal  = shift;
    my $quehay = "";
    my @result = ();
    for $quehay ( keys %datos ) {
        while ( my ( $key, $val ) = each( %{ $datos{$quehay} } ) ) {
            if ( $val =~ /^$canal/i ) {
                push( @result, $val );
            }
        }
    }
    return @result;
}

sub chequea_interno_ocupado {

    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} } ) ) {

            #     print "interno_ocupado $key $val\n";
            if ( $key eq "Channel" ) {
                if ( $val =~ /ZOMBIE/ ) {

                    # Si hay un Zombie trata de matarlo
                    $comando = "Action: Hangup\r\n";
                    $comando .= "Channel: $val\r\n\r\n";
                    syswrite( $p, $comando );
                    log_debug( "ZOMBIE!! Lo mato!! $val", 3 );
                } 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( "El interno sigue ocupado $canal $interno!!!!!!", 2 );
                    } else {
                        log_debug( "$canal $interno no son iguales", 2 );
                    }
                }
            }
        }
    }
    return $return;
}

sub log_debug {
    my $texto = shift;
    my $nivel = shift;
    print "$texto\n" if $debug >= $nivel;
}

sub alarma_al_minuto {
    my $comando = "Action: Command\r\n";
    $comando .= "Command: sip show peers\r\n\r\n";
    syswrite( $p, $comando );
    alarm(120);
}

sub cierra_todo {
    log_debug( "Exiting...", 1 );

    foreach my $hd ( $O->handles ) {
        $O->remove($hd);
        close($hd);
    }

    exit(0);
}