iterating over arrays with map - problem

Discussion in 'Perl Misc' started by Mothra, May 19, 2004.

  1. Mothra

    Mothra Guest

    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;

    }
    Mothra, May 19, 2004
    #1
    1. Advertising

  2. In article <rdJqc.15775781$>,
    Mothra <> wrote:

    > 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;
    >
    > }


    I think the following may do what you want, although I'm not positive it
    catches every possible variation. I've left in the print statements
    that show everything it tries...

    #!/usr/bin/perl
    use strict;
    use warnings;

    my $init_word = 'password';

    my %sub_matrix;

    @sub_matrix{qw/A a B b E e G g I i L l O o S s T t Z z/} =
    qw/4 4 8 8 3 3 6 6 1 1 1 1 0 0 5 5 7 7 2 2/;

    my %words;

    $words{$init_word}++;
    my $was_new = 1;

    while($was_new) {
    $was_new = 0;
    foreach my $word (keys %words) {
    foreach my $sub_let (keys %sub_matrix) {
    my $temp = $word;
    while ($temp =~ s/$sub_let/$sub_matrix{$sub_let}/) {
    print "# tried $temp";
    if (!defined($words{$temp})) {
    $was_new++;
    $words{$temp}++;
    print " - was new";
    }
    print "\n";
    }
    }
    }
    }
    print "\n";

    print map { $_ . "\n" } sort keys %words;

    __END__

    Output:

    # tried p4ssword - was new
    # tried passw0rd - was new
    # tried pa5sword - was new
    # tried pa55word - was new
    # tried p4ssw0rd - was new
    # tried p45sword - was new
    # tried p455word - was new
    # tried p4ssword
    # tried passw0rd
    # tried pa5sword
    # tried pa55word
    # tried p45sword
    # tried pa5sw0rd - was new
    # tried pa55word
    # tried p4ssw0rd
    # tried pa5sw0rd
    # tried pa55w0rd - was new
    # tried p455word
    # tried pa55w0rd
    # tried p4ssw0rd
    # tried p45sword
    # tried p455word
    # tried p4ssword
    # tried passw0rd
    # tried pa5sword
    # tried pa55word
    # tried p455w0rd - was new
    # tried p45sword
    # tried pa5sw0rd
    # tried pa55word
    # tried p45sw0rd - was new
    # tried p455w0rd
    # tried p45sw0rd
    # tried pa55w0rd
    # tried p4ssw0rd
    # tried pa5sw0rd
    # tried pa55w0rd
    # tried p455w0rd
    # tried p45sw0rd
    # tried p455word
    # tried p455word
    # tried pa55w0rd
    # tried p4ssw0rd
    # tried p45sword
    # tried p455word
    # tried p4ssword
    # tried passw0rd
    # tried pa5sword
    # tried pa55word
    # tried p455w0rd
    # tried p4ssw0rd
    # tried pa5sw0rd
    # tried pa55w0rd
    # tried p455w0rd
    # tried p455word
    # tried pa55w0rd
    # tried p455w0rd
    # tried p45sword
    # tried pa5sw0rd
    # tried pa55word
    # tried p45sw0rd
    # tried p455w0rd
    # tried p45sw0rd
    # tried pa55w0rd
    # tried p45sw0rd
    # tried p455word

    p455w0rd
    p455word
    p45sw0rd
    p45sword
    p4ssw0rd
    p4ssword
    pa55w0rd
    pa55word
    pa5sw0rd
    pa5sword
    passw0rd
    password


    ----------

    HTH,
    Ricky

    --
    Pukku
    Richard Morse, May 19, 2004
    #2
    1. Advertising

  3. Mothra

    Mothra Guest

    Richard Morse wrote:

    > In article <rdJqc.15775781$>,
    > Mothra <> wrote:
    >
    >
    >>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

    <snip>
    >

    Thanks - that's put me on the right track.

    Although some way to get around the repeated values would make the
    program work much faster - especially as my dictionary file might have
    several thousand words in it.
    :)
    Mothra, May 19, 2004
    #3
  4. Mothra

    Mothra Guest

    Oops! I just realised - you've done that for me as well!

    :-$
    Mothra, May 19, 2004
    #4
  5. [posted & mailed]

    On Wed, 19 May 2004, Mothra wrote:

    > 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;


    Sounds like a job for tr///

    $str =~ tr/AaBbEeGgIiLlOoSsTtZz/44883366111100557722/;

    --
    Jeff Pinyan RPI Acacia Brother #734 RPI Acacia Corp Secretary
    "And I vos head of Gestapo for ten | Michael Palin (as Heinrich Bimmler)
    years. Ah! Five years! Nein! No! | in: The North Minehead Bye-Election
    Oh. Was NOT head of Gestapo AT ALL!" | (Monty Python's Flying Circus)
    Jeff 'japhy' Pinyan, May 20, 2004
    #5
  6. In article
    <>,
    Jeff 'japhy' Pinyan <> wrote:

    > [posted & mailed]
    >
    > On Wed, 19 May 2004, Mothra wrote:
    >
    > > push @dict, map { s/[aA]/4/g;$_ } @dict;

    ...
    > > push @dict, map { s/[zZ]/2/g;$_ } @dict;

    >
    > Sounds like a job for tr///
    >
    > $str =~ tr/AaBbEeGgIiLlOoSsTtZz/44883366111100557722/;


    Except that he doesn't want to do all of the substitutions at once --
    he's looking to try and capture all possible variations, which would
    require doing things iteratively.

    Ricky

    --
    Pukku
    Richard Morse, May 20, 2004
    #6
  7. Mothra

    Anno Siegel Guest

    Richard Morse <> wrote in comp.lang.perl.misc:
    > In article <rdJqc.15775781$>,
    > Mothra <> wrote:


    [snip problem]

    > I think the following may do what you want, although I'm not positive it
    > catches every possible variation.


    No, it seems to miss a few.

    > I've left in the print statements
    > that show everything it tries...
    >
    > #!/usr/bin/perl
    > use strict;
    > use warnings;
    >
    > my $init_word = 'password';
    >
    > my %sub_matrix;
    >
    > @sub_matrix{qw/A a B b E e G g I i L l O o S s T t Z z/} =
    > qw/4 4 8 8 3 3 6 6 1 1 1 1 0 0 5 5 7 7 2 2/;
    >
    > my %words;
    >
    > $words{$init_word}++;
    > my $was_new = 1;
    >
    > while($was_new) {
    > $was_new = 0;
    > foreach my $word (keys %words) {
    > foreach my $sub_let (keys %sub_matrix) {
    > my $temp = $word;
    > while ($temp =~ s/$sub_let/$sub_matrix{$sub_let}/) {
    > print "# tried $temp";
    > if (!defined($words{$temp})) {
    > $was_new++;
    > $words{$temp}++;
    > print " - was new";
    > }
    > print "\n";
    > }
    > }
    > }
    > }
    > print "\n";
    >
    > print map { $_ . "\n" } sort keys %words;
    >
    > __END__
    >
    > Output:


    [snip tracing output]

    > p455w0rd
    > p455word
    > p45sw0rd
    > p45sword
    > p4ssw0rd
    > p4ssword
    > pa55w0rd
    > pa55word
    > pa5sw0rd
    > pa5sword
    > passw0rd
    > password


    I get these:

    password
    p4ssword
    pa5sword
    p45sword
    pas5word
    p4s5word
    pa55word
    p455word
    passw0rd
    p4ssw0rd
    pa5sw0rd
    p45sw0rd
    pas5w0rd
    p4s5w0rd
    pa55w0rd
    p455w0rd

    That are sixteen, as would be expected with four replaceable characters
    for four binary decisions.

    The problem can be seen as one of generating all combinations of character
    groups, where a replaceable character forms a group of two, and a character
    without replacement is a group of one. For the given "password", the
    structure begins:

    ( [ 'p'], [ 'a', '4'], [ 's', '5'], [ 's', '5'], [ 'w'], ... )

    I believe there are combinatorics modules on CPAN that operate on such
    structures. Otherwise, this will do:

    sub combinations { # starter-offer for the recursion
    add_combinations( [ ''], @_);
    }

    sub add_combinations {
    my $so_far = shift;
    my @coll;
    if ( @_ ) { # another character group to process?
    # for each character in the group
    for my $char ( @{ shift()} ) {
    # make a copy of the collected strings, extended by one char
    push @coll, map $_ . $char, @$so_far;
    }
    # repeat with remaining groups (we shifted the current one off)
    @coll = add_combinations( \ @coll, @_);
    } else { # no more groups
    @coll = @$so_far; # done!
    }
    @coll;
    }

    To arrive at the list of character groups, given a string, I gladly
    make use of your

    my %sub_matrix;
    @sub_matrix{qw/A a B b E e G g I i L l O o S s T t Z z/} =
    qw/4 4 8 8 3 3 6 6 1 1 1 1 0 0 5 5 7 7 2 2/;

    ....and extend it like this to a table that covers the alphabet:

    my %groups;
    for ( 'A' .. 'Z', 'a' .. 'z' ) {
    push @{ $groups{ $_}}, $_;
    push @{ $groups{ $_}}, $sub_matrix{ $_} if exists $sub_matrix{ $_};
    }

    The list of sixteen combinations is now produced by:

    print "$_\n" for combinations( @groups{ split //, $word });

    This method doesn't generate repeated combinations that have to be
    weeded out. It would also work with more than one (alternative)
    replacement characters.

    Anno
    Anno Siegel, May 20, 2004
    #7
  8. Mothra

    Joe Smith Guest

    Richard Morse wrote:
    > while ($temp =~ s/$sub_let/$sub_matrix{$sub_let}/) {


    For 's', that will produce "pa5sword" and "pa55word" but not "pas5word".
    -Joe
    Joe Smith, May 26, 2004
    #8
  9. In article <txZsc.3632$Ly.202@attbi_s01>,
    Joe Smith <> wrote:

    > Richard Morse wrote:
    > > while ($temp =~ s/$sub_let/$sub_matrix{$sub_let}/) {

    >
    > For 's', that will produce "pa5sword" and "pa55word" but not "pas5word".


    Thanks -- someone already replied with much better code, but I'm glad to
    know where I went wrong...

    Ricky

    --
    Pukku
    Richard Morse, May 26, 2004
    #9
    1. Advertising

Want to reply to this thread or ask your own question?

It takes just 2 minutes to sign up (and it's free!). Just click the sign up button to choose a username and then you can ask your own questions on the forum.
Similar Threads
  1. Mothra
    Replies:
    1
    Views:
    527
    ! aaa
    May 27, 2004
  2. Christine Mayer

    Iterating over a map with JSTL

    Christine Mayer, Aug 30, 2007, in forum: Java
    Replies:
    1
    Views:
    943
    Daniel Pitts
    Aug 30, 2007
  3. W. Martin Borgert

    Iterating over readlines() and map()

    W. Martin Borgert, Mar 25, 2009, in forum: Python
    Replies:
    0
    Views:
    343
    W. Martin Borgert
    Mar 25, 2009
  4. carl
    Replies:
    5
    Views:
    2,337
    James Kanze
    Nov 25, 2009
  5. Zoran Lazarevic
    Replies:
    5
    Views:
    174
    Ara.T.Howard
    Oct 8, 2003
Loading...

Share This Page