#!/usr/local/bin/perl
#
# $Id: SortDict.pl,v 1.2 2004/08/31 00:55:49 rdilley Exp $
#
# author: ron dilley
#
# desc: this perl script sorts password dictionaries to place simpler passwords
#       infront of more complex
#
# Copyright (C) 2004  Ron A. Dilley
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; version 2
# of the License.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
#
# ron.dilley@uberadmin.com
#
############################################################################

#
# modules
#
use Getopt::Std;

#
# pragmas
#
use strict;

#
# set environment
#
$ENV{PATH} = "/usr/bin:/bin:/usr/sbin:/sbin:/usr/ucb";

#
# turn on autoflush
#
select STDERR; $| = 1;
select STDOUT; $| = 1;

#
# defines
#
$::TRUE = 1;
$::FALSE = 0;
$::FAILED = -1;

$::VERSION = '$Id: SortDict.pl,v 1.2 2004/08/31 00:55:49 rdilley Exp $';
$::PROGNAME = "SortDict.pl";

%::Config = ();
$::Config{'debug'} = $::FALSE;

%::passwords = ();

#
# main routine
#
if ( &main() != $::TRUE ) {
  exit( 1 );
}

exit( 0 );

############################################################################
#
# sub-routines
#

#
# main routine
#
sub main {
  my $arg;

  #
  # display script banner
  #
  &show_banner();

  #
  # parse command-line
  #
  &parse_command_line();

  # process args that are left
  while( $arg = shift( @::ARGV ) ) {
    &process_dict_file( $arg );
  }

  # done
  return $::TRUE;
}

#
# display banner info
#
sub show_banner {
  print stderr "$::VERSION\n";
  print stderr "By: Ron Dilley\n";
  print stderr "\n";
  print stderr "$::PROGNAME comes with ABSOLUTELY NO WARRANTY.\n";
  print stderr "This is free software, and you are welcome\n";
  print stderr "to redistribute it under certain conditions;\n";
  print stderr "See the GNU General Public License for details.\n";
  print stderr "\n";

  return $::TRUE;
}

#
# display help info
#
sub show_help {
  print stderr "Syntax:\n";
  print stderr "\n";
  print stderr "$::PROGNAME [options] {file} [{file} ...]\n";
  print stderr "\n";
  print stderr "-d {0-9}   Display debug information during program run\n";
  print stderr "\n";

  return $::TRUE;
}

#
# parse command-line arguments
#
sub parse_command_line {
  no strict 'vars';

  if ( getopts( 'd:' ) == $::FALSE ) {
    &show_help();
    return $::FAILED;
  }
  if ( defined $opt_d ) {
    if ( $opt_d > 0 ) {
      # set debug mode
      $::Config{'debug'} = $opt_d;
    }
  }

  return $::TRUE;
}

#
# process dict file
#
sub process_dict_file {
  my ( $fname ) = @_;
  my $passwd;
  my $strength;
  my $lc;
  my $c;
  my @tokens;

  if ( ! defined open( DICTFILE, $fname ) ) {
    print "ERROR - Unable to open [$fname]\n";
    return $::FAILED;
  }

  # read in the file
  while( $passwd = <DICTFILE> ) {
    # strip off <CR> and <LF>
    $passwd =~ s/\r//g;
    $passwd =~ s/\n//g;
    $strength = 0;
    $lc = 'n';
    # break up the password into characters
    @tokens = split( //, $passwd );
    foreach $c ( @tokens ) {
      if ( $c =~ m/[A-Z]/ ) { # uppercase alpha
	if ( $lc eq 'l' | $lc eq 'd' | $lc eq 's' ) {
	  # new type
	  $strength += 2;
	} else {
	  $strength++;
	}
	$lc = 'u';
      } elsif ( $c =~ m/[a-z]/ ) { # lowercase alpha
	if ( $lc eq 'u' | $lc eq 'd' | $lc eq 's' ) {
	  # new type
	  $strength += 2;
	} else {
	  $strength++;
	}
	$lc = 'l';
      } elsif ( $c =~ m/\d/ ) { # decimal
	if ( $lc eq 'u' | $lc eq 'l' | $lc eq 's' ) {
	  # new type
	  $strength += 3;
	} else {
	  $strength++;
	}
	$lc = 'd';
      } elsif ( $c =~ m/[^a-zA-Z0-9]/ ) { # special
	if ( $lc eq 'u' | $lc eq 'l' | $lc eq 'd' ) {
	  # new type
	  $strength += 5;
	} else {
	  $strength += 3;
	}
	$lc = 's';
      }
    }
    @tokens = ();
    $::passwords{$passwd} = $strength;
    if ( $::Config{'debug'} >= 4 ) {
      print "DEBUG - [$passwd] [$strength]\n";
    }
  }
  # we are done with the file
  close( DICTFILE );
  # print out the passwords in strength sorted order
  foreach $passwd ( sort by_strength ( keys( %::passwords ) ) ) {
    print "$passwd\n";
  }
  # done, get outta here
  return $::TRUE;
}

#
# sort by password strength
#
sub by_strength {
  my $s_a;
  my $s_b;

  $s_a = $::passwords{$a};
  $s_b = $::passwords{$b};

  if ( $s_a < $s_b ) {
    return $::FAILED;
  } elsif ( $s_a > $s_b ) {
    return $::TRUE;
  }
  return $::FALSE;
}
