#!/usr/bin/perl

local( $word_pattern, $output_file );
local( %pat_codes );
local( $CHAR_SETS ) = 0;
$| = 1;

### - Well this is just about the only code that i didn't change.
print ("\n\t**************************************************");
print ("\n\t*                Wordlist.pl  V0.50              *");
print ("\n\t*          Rewritten By : ZeroDiVide             *");
print ("\n\t*         Shouts out to : manicx and G           *");
print ("\n\t*                24th Februrary 1999             *");
print ("\n\t*    Latest Version www.infowar.co.uk/manicx/    *");
print ("\n\t**************************************************");

if ( $ARGV[ 0 ] eq "--?" ) { $CHAR_SETS = 1; }

###
push( @{ $pat_codes{ 'X' }}, 65,    90    );
push( @{ $pat_codes{ 'x' }}, 97,    122   );
push( @{ $pat_codes{ '!' }}, 0,     47    );
push( @{ $pat_codes{ '@' }}, 58,    64    );
push( @{ $pat_codes{ '$' }}, 91,    96    );
push( @{ $pat_codes{ '^' }}, 123,   256   );
push( @{ $pat_codes{ '#' }}, 48,    57    );
print "\nPattern codes : \n";

if ( $CHAR_SETS ) {
print "Many characters avaiable cannot be rendered with ascii,\n";
print " so you may not see values within your [ ]'s for all of\n";
print " the characterset. ex. 184 [ ]\n";
}

print "X    : Upper case characters\n";
if ( $CHAR_SETS ) { disp_range( @{ $pat_codes{ 'X' } } ); }
print "x    : Lower case characters\n";
if ( $CHAR_SETS ) { disp_range( @{ $pat_codes{ 'x' } } ); }
print "!    : Special chars 1\n";
if ( $CHAR_SETS ) { disp_range( @{ $pat_codes{ '!' } } ); }
print "\@    : Special chars 2\n";
if ( $CHAR_SETS ) { disp_range( @{ $pat_codes{ '@' } } ); }
print "\$    : Special chars 3\n";
if ( $CHAR_SETS ) { disp_range( @{ $pat_codes{ '$' } } ); }
print "^    : Special chars 4\n";
if ( $CHAR_SETS ) { disp_range( @{ $pat_codes{ '^' } } ); }
print "#    : Numeric chars\n";
if ( $CHAR_SETS ) { disp_range( @{ $pat_codes{ '#' } } ); }

print "Rerun this program with --? if you would like output\n";
print "     of the character sets.\n";
print "     WARNING : It may mess up your terminal session\n";

local( $good_params ) = 'no';
while( $good_params eq 'no' ) {
$word_pattern        = get_line( 'Enter the word pattern you would like'
);
$output_file         = get_line( 'Enter the name of the output file' );
print "The values I have are : \n";
print "    Word Pattern          : $word_pattern\n";
print "    Output File           : $output_file\n";
local $temp = 'y';
$temp = get_line( 'Are these correct [y]', 1 );
if ( $temp =~ /y/i || $temp eq '' ) { $good_params = 'yes'; }
}

print "Building code : ";
# Meat and potatoe time ....
local $eval_code = '';
local $eval_code = <<"EVAL_HEAD";
open( OUT_FILE, "> $output_file" ) || die "Could not open output file :
\$!\\n\\n";
local \$smash_me = '';
EVAL_HEAD

local $open_loops = 0;
for( $i = 0; $i < length( $word_pattern ); $i++ ) {
   local $cur_letter = '';
   local $bat_letter = '';
   $cur_letter = substr( $word_pattern, $i, 1 );
   foreach $pat_letter ( keys %pat_codes ) {
      if ( $pat_letter eq $cur_letter ) {
         $bat_letter = $pat_letter;
      }
   }
   if ( $bat_letter eq '' ) {
      $eval_code .= '$smash_me_' . $i . ' = "' . $cur_letter . '";' .
"\n";
   } else {
      $open_loops++;
      @temp = @{ $pat_codes{ $cur_letter } };
      $low_value = $temp[ 0 ];
      $high_value = $temp[ 1 ];

      $eval_code .= <<"EVAL_LOOP";
for( \$xx_$open_loops = $low_value; \$xx_$open_loops <= $high_value;
 \$xx_$open_loops++ ) { 
      \$smash_me_$i = pack( 'c', \$xx_$open_loops );

EVAL_LOOP
   }
}

$eval_code .= 'print OUT_FILE ';
for( $i = 0; $i < length( $word_pattern ); $i++ ) {
   $eval_code .= '$smash_me_' . $i . ' . ' . "\n";
}
$eval_code .= '"\n";';
for( $i = 0; $i < $open_loops; $i ++ ) {
   $eval_code .= '}' . "\n";
}

$eval_code .= 'close( OUT_FILE );';
print "Done!\n";

#print $eval_code;
print "Running word create, this may take some time : ";
eval( $eval_code );
print "Done!\n";

# Gets a line of input from the user
sub get_line {
   local $prompt, $can_be_empty, $temp;
   local $input_ok = 'no';

   $prompt           = shift;
   $can_be_empty     = shift;

   while( $input_ok eq 'no' ) {
   print $prompt . ' : ';
   $temp = <STDIN>; $temp =~ s/\n//g; $temp =~ s/\r//g;
   if ( $temp  eq "" && $can_be_empty != 1) {
      print "I'm sorry but i require input for this value,";
      print " please try again.\n";
   } else {
   $input_ok = 'yes';
   }

   }
   return $temp;
}
# Display a range of character values
sub disp_range {
   local ( $start_val, $end_val ) = @_;

   print "Characters in set ( $start_val -> $end_val ) : \n";
   $line_break = 0;
   for( $i = $start_val; $i <= $end_val; $i++ ) {
      $line_break++;
      print $i . ' [ ' . pack( 'c', $i ) . ' ] ';
      if ( $line_break == 5 ) {
         $line_break = 0;
         print "\n";
      }
   }
   print "\n\n";
}
