[Perl Tk] LocateIP 0.4

[BigBear]

Un simple programa en Perl que sirve para buscar informacion sobre una IP , primero busca la localizacion y despues busca las DNS relacionadas.

Les dejo una imagen del programa

El codigo (formateado con perltidy) es

Código (perl) [Seleccionar] Expandir


#!usr/bin/perl
#Locate IP 0.4
#Version Tk
#Coded By Doddy H

use Tk;
use LWP::UserAgent;
use IO::Socket;

my $background_color = "black";
my $texto_color      = "green";

if ( $^O eq 'MSWin32' ) {
    use Win32::Console;
    Win32::Console::Free();
}

installer();

my $nave = LWP::UserAgent->new;
$nave->agent(
"Mozilla/5.0 (Windows; U; Windows NT 5.1; nl; rv:1.8.1.12) Gecko/20080201Firefox/2.0.0.12"
);
$nave->timeout(5);

$p = MainWindow->new(
    -background => $background_color,
    -foreground => $texto_color
);
$p->title("Locate IP 0.4 || Coded By Doddy H");
$p->geometry("440x300+20+20");
$p->resizable( 0, 0 );

$p->Label(
    -text       => "Target : ",
    -font       => "Impact",
    -background => $background_color,
    -foreground => $texto_color
)->place( -x => 20, -y => 20 );
my $tar = $p->Entry(
    -width      => 30,
    -background => $background_color,
    -foreground => $texto_color
)->place( -y => 24, -x => 80 );
$p->Button(
    -text             => "Find",
    -width            => 10,
    -background       => $background_color,
    -foreground       => $texto_color,
    -activebackground => $texto_color,
    -command          => \&st
)->place( -y => 23, -x => 272 );
$p->Button(
    -text       => "Logs",
    -width      => 10,
    -background => $background_color,
    -foreground => $texto_color,
    ,
    -activebackground => $texto_color,
    -command          => \&openlogs
)->place( -y => 23, -x => 350 );

$p->Label(
    -text       => "Information",
    -font       => "Impact",
    -background => $background_color,
    -foreground => $texto_color
)->place( -x => 80, -y => 80 );

$p->Label(
    -text       => "City : ",
    -font       => "Impact1",
    -background => $background_color,
    -foreground => $texto_color
)->place( -y => 140, -x => 23 );
my $city = $p->Entry(
    -width      => 21,
    -background => $background_color,
    -foreground => $texto_color
)->place( -y => 143, -x => 65 );

$p->Label(
    -text       => "Country : ",
    -font       => "Country",
    -background => $background_color,
    -foreground => $texto_color
)->place( -y => 170, -x => 23 );
my $country = $p->Entry(
    -width      => 17,
    -background => $background_color,
    -foreground => $texto_color
)->place( -y => 173, -x => 90 );

$p->Label(
    -text       => "State : ",
    -font       => "Impact1",
    -background => $background_color,
    -foreground => $texto_color
)->place( -y => 200, -x => 23 );
my $state = $p->Entry(
    -width      => 20,
    -background => $background_color,
    -foreground => $texto_color
)->place( -y => 203, -x => 75 );

$p->Label(
    -text       => "DNS Found",
    -font       => "Impact",
    -background => $background_color,
    -foreground => $texto_color
)->place( -y => 80, -x => 285 );
my $dns = $p->Listbox(
    -width      => 30,
    -background => $background_color,
    -foreground => $texto_color
)->place( -x => 230, -y => 130 );

MainLoop;

sub st {

    $city->configure( -text => " " );
    $country->configure( -text => " " );
    $state->configure( -text => " " );
    $dns->delete( "0.0", "end" );

    my $target = $tar->get;

    savefile( "info-logs.txt", "[+] Target : $target" );

    my $get    = gethostbyname($target);
    my $target = inet_ntoa($get);

    savefile( "info-logs.txt", "[+] IP : $target\n" );

    $total =
      "http://www.melissadata.com/lookups/iplocation.asp?ipaddress=$target";

    $re = toma($total);

    if ( $re =~ /City<\/td><td align=(.*)><b>(.*)<\/b><\/td>/ ) {
        savefile( "info-logs.txt", "[+] City : $2" );
        $city->configure( -text => $2 );
    }
    else {
        $city->configure( -text => "Not Found" );
    }
    if ( $re =~ /Country<\/td><td align=(.*)><b>(.*)<\/b><\/td>/ ) {
        savefile( "info-logs.txt", "[+] Country : $2" );
        $country->configure( -text => $2 );
        print "[+] Country : $2\n";
    }
    else {
        $country->configure( -text => "Not Found" );
    }
    if ( $re =~ /State or Region<\/td><td align=(.*)><b>(.*)<\/b><\/td>/ ) {
        savefile( "info-logs.txt", "[+] State of Region : $2" );
        $state->configure( -text => $2 );
    }
    else {
        $state->configure( -text => "Not Found" );
    }

    my $code = toma( "http://www.ip-adress.com/reverse_ip/" . $target );

    savefile( "info-logs.txt", "" );

    while ( $code =~ /whois\/(.*?)\">Whois/g ) {
        my $dnsa = $1;
        chomp $dnsa;
        savefile( "info-logs.txt", "[+] DNS Found : $dnsa" );
        $dns->insert( "end", $dnsa );
    }
    savefile( "info-logs.txt", "\n######################\n" );
}

sub openlogs {
    system("start logs/info-logs.txt");
}

sub installer {
    unless ( -d "/logs" ) {
        mkdir( "logs/", 777 );
    }
}

sub savefile {
    open( SAVE, ">>logs/" . $_[0] );
    print SAVE $_[1] . "\n";
    close SAVE;
}

sub toma {
    return $nave->get( $_[0] )->content;
}

#The End ?


[H20-X]

yo con ubuntu no consigo arrancarlo .........no se debe ser el cansancio.

[BigBear]

yo solo lo eh probado en Window Seven , podrias mostrar el error que te aparece para ver si te puedo ayudar.

[H20-X]

Es realmente estraño el perl que has hecho como link decoder va muy bien y encambio este nada!!!!

[BigBear]

eso es porque este programa esta hecho solo para Windows.

edito : si queres que te ande borra estas lineas del codigo

Código (perl) [Seleccionar] Expandir


if ( $^O eq 'MSWin32' ) {
   use Win32::Console;
   Win32::Console::Free();
}


Ese es el error que te aparece , pero como ya te dije el programa solo esta hecho para Windows porque se te va a ver todo el texto movido.

[H20-X]

nada le he quitado la linea esa que me  has dicho y ahora me sale esto :

   Can't locate Tk.pm in @INC (@INC contains: /etc/perl /usr/local/lib/perl/5.10.1 /usr/local/share/perl/5.10.1 /usr/lib/perl5 /usr/share/perl5 /usr/lib/perl/5.10 /usr/share/perl/5.10 /usr/local/lib/site_perl .) at LocateIP.pl line 6.
BEGIN failed--compilation aborted at LocateIP.pl line 6.

[BigBear]

Es porque te hace falta instalar Tk.

Si estas usando ubuntu podes instalarlo con Synaptic.