# Bruterate.pm brute force list iterator generator 03jul09waw
package Bruterate; { # begin Bruterate private package closure
use warnings FATAL => 'all';
# use warnings;
use strict;
use Exporter;
our @ISA = qw(Exporter);
our $VERSION = '0.1.0';
our @EXPORT = (); # default exports
our @EXPORT_OK = qw(bruterate); # optional exports
sub Iterator (&) { return $_[0] } # syntactic sugar per hop
# return iterator that will iterate over all elements of a set
# of referenced arrays. referenced arrays that are empty are
# ignored. elements in array referenced by right-most argument
# in call to function are iterated most rapidly, elements in
# array referenced by left-most argument least rapidly.
sub bruterate {
# ignore any referenced arrays that are empty.
my @ar_non_empty = grep @$_ > 0, @_;
# no referenced non-empty arrays to iterate over.
return Iterator { return } unless @ar_non_empty;
# at least one referenced non-empty array to iterate over.
my @items = @{ shift @ar_non_empty };
my $item = $[;
# is this the rightmost referenced non-empty array to be iterated?
@ar_non_empty == 0 and return Iterator {
$item = $[, return if $item > $#items;
return [ $items[$item++] ];
};
# there are more referenced arrays (to the right) to iterate.
my $cr_get_rightward_items = bruterate(@ar_non_empty);
return Iterator {
my $ar_rightward = $cr_get_rightward_items->();
return [ $items[$item], @$ar_rightward ] if $ar_rightward;
++$item;
$item = $[, return if $item > $#items;
return [ $items[$item], @{ $cr_get_rightward_items->() } ];
};
} # end sub bruterate()
} # end Bruterate private package closure
1;
####
# crack_pw_2.pl 08jul09waw
use warnings;
use strict;
use Bruterate qw(bruterate);
# guess that pw is probably:
# 1. english or english-like word, so all alphas;
# 2. english or english-like word, so starts with consonant-vowel;
# 3. lower case if an alpha (people are lazy).
my @alphas = ('a' .. 'z', 'A' .. 'Z'); # lower case first!
my @digits = ('0' .. '9');
my @oddballs = (qw(! @ $ % ^ & *), '#', ' ');
my @vowels = qw(a e i o u A E I O U);
my $rx_consonants = qr{ [^@{[ join '', @vowels ]}] }xms;
my @consonants = ( grep /$rx_consonants/, @alphas );
my $char1 = [ @consonants, @vowels, @digits, @oddballs ];
my $char2 = [ @vowels, @consonants, @digits, @oddballs ];
my $any_char = [ @alphas, @digits, @oddballs ];
# this contrary, 'worst guess' order will try vowel-vowel alpha
# combinations first (and upper case, too), but only after trying
# oddballs, then digits.
my $contrary = [ reverse @$char1 ];
my $reti4 = bruterate(
($contrary) x 4 # worst 4 char guess
);
my $iter1 = bruterate($any_char); # 1 char
my $iter2 = bruterate($char1, $any_char); # 2 chars
my $iter3 = bruterate($char1, $char2, $any_char); # 3 chars
my $iter4 = bruterate($char1, $char2, $any_char, $any_char); # 4 chars
my $password = shift or die "usage: perl $0 password \n";
my $tries = 0;
my $starttime = time();
# work through iterators of increasing length trying to guess
# password by brute force.
LEN:
for my $iter ($iter1, $iter2, $iter3, $iter4) {
GUESS:
while (my $ar_guess_chars = $iter->()) {
++$tries;
my $guess = join '', @$ar_guess_chars;
next GUESS if $guess ne $password;
my $elapsed = time() - $starttime;
print "found password '$guess' ",
"in $elapsed seconds with $tries tries \n";
exit;
} # end while GUESS
} # end for LEN
my $elapsed = time() - $starttime;
die "FAILED to find password '$password' ",
"in $elapsed seconds with $tries tries \n";
##
##
>perl crack_pw_2.pl
usage: perl crack_pw_2.pl password
>perl crack_pw_2.pl z
found password 'z' in 0 seconds with 26 tries
>perl crack_pw_2.pl zz
found password 'zz' in 0 seconds with 1517 tries
>perl crack_pw_2.pl xy5
found password 'xy5' in 3 seconds with 97967 tries