iterating over arrays with map - problem

[Mothra]

Trying (just for fun) to write my own Perl version of 'Crack' but am
stumbling a bit trying to iterate over my dictionary file to generate
possible passwords. When I run the code below with "dictionary.txt"
containing the single word "password", I get around 4,000 entries, most
of which are identical, even though on most occassions there is no
subsitution to be made.

I tried using next in the map block, but it won't let me. What I would
like it to generate (for each word in the dictionary file) all possible
letter/number substitution combinations, that is, not to simply
accumulate changes, but nor to needlessly repeat them either.

The best I can get is either:
password
p4ssword
p455word
p455w0rd

which is useless; the only other result I get is thousands of redundant
entries.

What is the more efficient way I should be writing this (see below)?

---------------------------------
sub init_dictionary {
open(DICT,"dictionary.txt");
chomp(@dict=<DICT>);
close DICT;

push @dict, map { s/[aA]/4/g;$_ } @dict;
push @dict, map { s/[bB]/8/g;$_ } @dict;
push @dict, map { s/[eE]/3/g;$_ } @dict;
push @dict, map { s/[gG]/6/g;$_ } @dict;
push @dict, map { s/[iI]/1/g;$_ } @dict;
push @dict, map { s/[lL]/1/g;$_ } @dict;
push @dict, map { s/[oO]/0/g;$_ } @dict;
push @dict, map { s/[sS]/5/g;$_ } @dict;
push @dict, map { s/[tT]/7/g;$_ } @dict;
push @dict, map { s/[zZ]/2/g;$_ } @dict;

}

 

[! aaa]

You're on the wrong path - you need to use recursion,
since the input is of arbitrary length.

I've attached (below) a proggy below that reads a dictionary and
prints out all words that can be expresses in hexadecimal.

I adapted it from something else I wrote that finds cool
car numberplates (you know - like GR8 ST8) so there's
old crap in there still - but it's something to look at...

Trying (just for fun) to write my own Perl version of 'Crack' but am
stumbling a bit trying to iterate over my dictionary file to generate
possible passwords. When I run the code below with "dictionary.txt"
containing the single word "password", I get around 4,000 entries, most
of which are identical, even though on most occassions there is no
subsitution to be made.

I tried using next in the map block, but it won't let me. What I would
like it to generate (for each word in the dictionary file) all possible
letter/number substitution combinations, that is, not to simply
accumulate changes, but nor to needlessly repeat them either.

The best I can get is either:
password
p4ssword
p455word
p455w0rd

which is useless; the only other result I get is thousands of redundant
entries.

What is the more efficient way I should be writing this (see below)?

---------------------------------
sub init_dictionary {
open(DICT,"dictionary.txt");
chomp(@dict=<DICT>);
close DICT;

push @dict, map { s/[aA]/4/g;$_ } @dict;
push @dict, map { s/[bB]/8/g;$_ } @dict;
push @dict, map { s/[eE]/3/g;$_ } @dict;
push @dict, map { s/[gG]/6/g;$_ } @dict;
push @dict, map { s/[iI]/1/g;$_ } @dict;
push @dict, map { s/[lL]/1/g;$_ } @dict;
push @dict, map { s/[oO]/0/g;$_ } @dict;
push @dict, map { s/[sS]/5/g;$_ } @dict;
push @dict, map { s/[tT]/7/g;$_ } @dict;
push @dict, map { s/[zZ]/2/g;$_ } @dict;

}

#!perl

# Program to find hex words


open(IN,"<WORDSENG.all");
open(OUT,">HEXWDS.TXT");

if(0) {
if(1) {

@nseq=('0','1','2','3','4','5','6','7','8','9','o','i','z','s','six','seven'
,

'ate','nine','three','four','oh','one','ow','won','pher','fer','for');
@pnsq=('0','1','2','3','4','5','6','7','8','9','0','1','2','5','6','7',
'8','9','3','4','0','1','0','1','4','4','4');
} else {
@nseq=('0','1','2','3','4','5','6','7','8','9','o','i',
'ate','oh','one','ow','won','pher','fer','for');
@pnsq=('0','1','2','3','4','5','6','7','8','9','0','1',
'8','0','1','0','1','4','4','4');
}


@aseq=('a','b','c','d','e','f','g','h','i','j','k','l','m','n','o','p','q',

'r','s','t','u','v','w','x','y','z','bee','be','sea','dee','gee','jay','kay'
,

'em','en','pee','que','queue','er','es','tee','you','vee','ex','why','im',
'oh','aye');

@pasq=('A','B','C','D','E','F','G','H','I','J','K','L','M','N','O','P','Q',
'R','S','T','U','V','W','X','Y','Z','B','B','C','D','G','J','K',
'M','N','P','Q','Q','R','S','T','U','V','X','Y','M',
'O','A');
} else {
# Hex digits


@nseq=('0','1','2','3','4','5','6','7','8','9','o','i','z','s','six','seven'
,

'ate','nine','three','four','oh','one','ow','won','pher','fer','for');
@pnsq=('0','1','2','3','4','5','6','7','8','9','0','1','2','5','6', '7',
'8', '9', '3', '4', '0', '1', '0', '1', '4', '4',
'4');

@aseq=('a','b','c','d','e','f','bee','be','sea','dee');
@pasq=('A','B','C','D','E','F','B', 'B', 'C', 'D');

}

@seq=(@aseq,@nseq);
@pseq=(@pasq,@pnsq);
$lastline='';

while($wd=<IN>) {
chop($wd);
# print "$wd ";
&tryit($wd,'',''); # Match it up.
} # while



sub tryit { # call tryit (word, meaning, hex)
my($w,$m,$h)=@_;
my($i);

#print "Trying $w,$m,$h\n";

for($i=0;$i<$#seq;$i++) { # Go through all possible letters in the word
if($w=~/^$seq[$i]/) { # Matched!

#print "$w =~ $seq[$i]\n";

$w=~s/^$seq[$i]//; # remove it
$m.=$pseq[$i];$h.=$seq[$i]; # remember what we used
if($w=~/^$/) { # TaDa!! got one.
$line="$h = $wd = $m\n";
print $line if($line ne $lastline);
print OUT $line if($line ne $lastline);
$lastline=$line;
} else {
&tryit($w,$m,$h);
}
}
}
}