# 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