Messenger Sniffer en Perl

[brians444]

Hola amigos, hace unos dias comenze a estudiar perl, y por estar boludeando con wireshark me di cuenta que se puede leer una conversacion de msn, sin mas que un sniffer.
Perl me vino como anillo al dedo, por lo que hice una clase en perl, que una vez almacenados los paquetes capturados en un archivo, esta me extrae la conversacion en una bonita lista html.

Aqui adjunto la clase:

Código [Seleccionar] Expandir


package Packet::Extractor;

use strict;
use warnings;
use Path::Class;
use autodie;

require Exporter;

our $VERSION = '0.001';

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration use Packet::Extractor ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(

) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(

);

our $VERSION = '0.01';


# Preloaded methods go here.
  ######################################################################
  #Constructor de la clase
  #

sub new
{
my $this=shift; #Cogemos la clase que somos o una referencia a la clase (si soy un objeto)
    my $class = ref($this) || $this; #Averiguo la clase a la que pertenezco

    my $self={}; #Inicializamos la tabla hash que contendrá las var. de instancia
    $self ->{ENTRADA}  = ""; #La clase ExtractText nace sin un fichero de entrada
    $self ->{SALIDA}   = ""; #La clase ExtractText y sin uno de salida
    $self ->{PATRON_I} = ""; #Patrones de comienzo del paquete
    $self ->{PATRON_O} = ""; #Patrones del final del paquete
    $self ->{F_i} = undef; #Fichero de entrada
    $self ->{F_o} = undef; #Fichero de salida
    #$self ->{DATA} = undef; #
    $self ->{NUMBER} = 0; #Numero de mensajes encontrados
    $self ->{MSN} = 0; #Valor que determina si se extraera una conversacion de MSN o no
#Debe valer 1 en caso afirmativo, 0 en caso contrario

    $self ->{Fh_i} = undef; # File Handler de entrada
    $self ->{Fh_o} = undef; # File Handler de salida
   
    #my %mensaje = ("Sender" => "", "Nick" => "", "Content-Type" => "", "Font" => "", "Msj" => "");

    bless $self, $class; #Perl nos tiene que dar el visto bueno (bendecirla)
    return ($self); #Devolvemos la clase recién construida
  }
 
 
  ######################################################################
  #Métodos de acceso a los datos de la clase
  #

  #metodo para ver/cambiar el entrada
sub entrada
{
my $self=shift; #El primer parámetro de un metodo es la  clase
#Miramos si se le ha pasado algún parámetro, en cuyo caso será el nombre
if (@_)
{
$self->{ENTRADA}=shift;
# $self->abrir_i();
}

#Devolvemos el nombre
    return $self->{ENTRADA};
 
}
 
    #metodo para ver/cambiar el entrada
sub salida
{
my $self=shift; #El primer parámetro de un metodo es la  clase

#Miramos si se le ha pasado algún parámetro, en cuyo caso será el nombre
if (@_)
{
$self->{SALIDA}=shift;
# $self->abrir_o();
}
   
    #Devolvemos el nombre
    return $self->{SALIDA};

}
 
sub comienzo
{
my $self=shift; #El primer parámetro de un metodo es la  clase

#Miramos si se le ha pasado algún parámetro, en cuyo caso será el nombre
    $self->{PATRON_I}=shift if (@_);
   
    #Devolvemos el nombre
    return $self->{PATRON_I};

}
 
sub fin
{
my $self=shift; #El primer parámetro de un metodo es la  clase

#Miramos si se le ha pasado algún parámetro, en cuyo caso será el nombre
    $self->{PATRON_O}=shift if (@_);
   
    #Devolvemos el nombre
    return $self->{PATRON_O};

}

sub abrir_i
{

my $self=shift;  #El primer parámetro de un metodo es la  clase

if($self->{ENTRADA} ne "")
{
$self->{F_i} = file($self->{ENTRADA});
$self->{Fh_i} =  $self->{F_i}->openr();
}
else
{
print "Debe cargar el nombre del archivo de entrada primero\n";
}
}

sub abrir_o
{
my $self=shift;  #El primer parámetro de un metodo es la  clase

if($self->{SALIDA} ne "")
{
$self->{F_o} = file($self->{SALIDA});
$self->{Fh_o} =  $self->{F_o}->openw();
}
else
{
print "Debe cargar el nombre del archivo de salida primero\n";
}

}

sub run
{

my $self = shift;

$self->abrir_i();
$self->abrir_o();
if($self->{MSN})
{
$self->crear_tabla();
}
$self->buscar_mensajes();
if($self->{MSN})
{
$self->cerrar_tabla();
}

}

sub buscar_mensajes
{
my $self = shift;
my $pos;
my @pin= $self->adecuar_patrones();
my @po;
for( my $c = pop(@pin); $c>0; $c--)
{
$po[$c-1] = pop(@pin);
}


while ( !$self->{Fh_i}->eof() )
{
if($self->buscar_pat( $#pin, @pin ))
{
$pos = $self->{Fh_i}->getpos();
if($self->buscar_pat($#po, @po ))
{
$self->copiar($pos, $self->{Fh_i}->getpos());
}
}
}


}

sub buscar_pat
{
my $self = shift;
my $l = shift;
my @po;
for( my $c = 0; $c <= $l; $c++)
{
push(@po, shift);
}

my $caracter;
my $i;

#print "Buscando @po \n";

for($i =0; $i<= $#po && !$self->{Fh_i}->eof(); )
{
$caracter = $self->{Fh_i}->getc();
if ($caracter eq $po[$i])
{
$i++;
}
else
{
$i = 0;
}
}
return $i;

}

sub adecuar_patrones
{
my $self = shift;
my @pin;
my @pout;

my $len = length( $self->{PATRON_I} );
for( my $i = 0; $i < $len; $i++)
{
unshift(@pin, chop($self->{PATRON_I}));
}
$len = length( $self->{PATRON_O} );


for( my $i = 0; $i < $len; $i++)
{
unshift(@pout, chop($self->{PATRON_O}));
}

return @pin, @pout, $len;

}

sub copiar
{
my $self = shift;
my $inicio = shift;
my $final = shift;
my $caracter;

$self->{Fh_i}->setpos($inicio);
while( $self->{Fh_i}->getpos() ne $final)
{
$caracter .= $self->{Fh_i}->getc();
}
chop($caracter);
if( $self->{MSN} )
{
$caracter = $self->extraer_mensaje($caracter);
}

$self->{Fh_o}->print($caracter);

$self->{NUMBER}++;

}


sub set_msn
{
my $self=shift; #El primer parámetro de un metodo es la  clase
#Miramos si se le ha pasado algún parámetro, en cuyo caso será el nombre
$self->{MSN} = 1;

#Devolvemos el nombre
    return $self->{MSN};
 
}

sub unset_msn
{
my $self=shift; #El primer parámetro de un metodo es la  clase
#Miramos si se le ha pasado algún parámetro, en cuyo caso será el nombre
$self->{MSN} = 0;

#Devolvemos el nombre
    return $self->{MSN};
 
}

sub extraer_mensaje
{
my $self = shift;
my $mensaje = shift;
my @cadenas = split( "\n", $mensaje);
my @remitente;
if($#cadenas <3)
{
return "";
}
elsif ( $cadenas[2] =~ m/text\/plain/)
{
chop($cadenas[$#cadenas]);
chop($cadenas[$#cadenas]);
chop($cadenas[$#cadenas]);
@remitente = split ( " ", $cadenas[0]);
if($#remitente > 1 )
{
$cadenas[0] = "<td> $remitente[0] </td> <td> $remitente[1] </td>";
}
$mensaje = "<tr>".$cadenas[0]. "<td>" . $cadenas[$#cadenas]. "</td></tr>\n";
}
else{ return "";}
$mensaje =~ tr/áéíóúÁÉÍÓÚ/aeiouAEIOU/;
$mensaje =~ s/%20/ /g;
return $mensaje;

}

sub crear_tabla
{
my $self = shift;

my $table = "<table border=\"1\" align=\"center\" bgcolor=\"yellow\" style=\"text-align : center;\">
  <caption>Conversaciones grabadas con Packet::Extractor</caption>
  <thead>
    <tr>
      <th>Remitente</th>
      <th>Nick</th>
      <th>Mensaje</th>
    </tr>
  </thead>
  <tfoot bgcolor=\"cyan\" style=\" font : icon; font-style : oblique; text-decoration : underline; text-transform : none;\">
    <tr>
      <td>Hecho por </td>
      <td>Brian Schmidt</td>
      <td><a href=\"mailto:brians444\@hotmail.com\">brians444\@hotmail.com</a></td>
    </tr>
  </tfoot>
  <tbody>";
 
  $self->{Fh_o}->print($table);
 
}

 
sub cerrar_tabla
{
my $self = shift;
my $table = "</tbody> \n </table>";

$self->{Fh_o}->print($table);

}
 
 
  ######################################################################
  #Destructor
  #

sub DESTROY
{
my $self=shift; #El primer parámetro de un metodo es la  clase
delete ($self->{ENTRADA});
delete ($self->{SALIDA});
    delete ($self->{PATRON_I});
    delete ($self->{PATRON_O});
    delete ($self->{EXTRAIDO});

}

  #Fin


1;
__END__
# Below is stub documentation for your module. You'd better edit it!

=head1 NAME

Packet::Extractor - Perl extension for extracting caracters between 2 string in a file

=head1 SYNOPSIS

use Packet::Extractor; #Please sorry by my english
 

=head1 DESCRIPTION

use Packet::Extractor; #Please sorry by my english again
 
my $asd;

$asd = Packet::Extractor->new(); #Create a object

$asd->entrada("packet.cap"); # Set the input file
$asd->salida("out.html"); # Set the output file

$asd->comienzo("MSG"); # Set the string to begin the cut
$asd->fin("IO"); # Set the string to finish the cut

$asd->set_msn(); # Here we tell to the class, that extract a MSN conversation from input file

$asd->run(); # We put to work the class

=head2 EXPORT

None by default.



=head1 SEE ALSO

Mention other useful documentation such as the documentation of
related modules or operating system documentation (such as man pages
in UNIX), or any relevant external documentation such as RFCs or
standards.

If you have a mailing list set up for your module, mention it here.

If you have a web site set up for your module, mention it here.

=head1 AUTHOR

Brian Eric Schmidt, E<lt>brians444@hotmail.com<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2012 by Brian Eric Schmidt

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.14.2 or,
at your option, any later version of Perl 5 you may have available.

=cut



Y un ejemplo de su uso :

Código [Seleccionar] Expandir


use Packet::Extractor;

my $asd;

$asd = Packet::Extractor->new();   #Aqui creo el objeto
$asd->entrada("packet.cap");           #Aqui cargo el nombre del fichero de entrada
$asd->salida("out.html");                   #Aqui cargo el nombre del fichero de salida

$asd->comienzo("MSG");                 # Aqui ingreso, 2 patrones el de inicio, y el de salida.
$asd->fin("IO");                           # Los cuales corresponden al inicio de los datos sensibles de los
                                                   # paquetes de msn, el de fin a veces varias siendo tambien     
                                                    #posible  "MO"

$asd->set_msn();                 # Seteo que debe extraer una conversacion de msn
$asd->run();                             #Pongo la clase a trabajar



Mi idea ahora es usar la libreria Net::Pcap para que el script directamente capture el trafico, luego ver la posibilidad de que se pueda inyectar un paquete falso para poder responder sin que el usuario local se de cuenta.. (Desconozco si es posible)

Tengo varias consultas... Primero como la ven a la clase, que se puede mejorar, etc.. La idea es aprender y mejorar, por lo que cualkier sugerencia es aceptada

Ademas como se puede hacer para leer caracter a caracter una variable escalar (para compararla con los patrones)

Desde ya muchas gracias...

Por lo pronto ire actualizando cualquier mejora que consiga..

saludos 

[megabyte18a]

buen dia yo tambien estoy en formacion en leguaje perl y tengo dos inquietudes, una es es posible este codigo con una interface de  otro lenguaje?? y dos conoce algun curso virtual de perl que me pueda recomendar? gracias