#!/usr/bin/perl
#
# passwd_check.pl
#
# This program is an active password checker.  It will perform the
# following operations before a password is allowed to be changed:
#     - Check password for a 'sufficiently large' set of characters
#       included.
#     - Use a dictionary of bad passwords in a simple dictionary
#       attack.
#     - Handle words in the dictionary, all three of the following:
#       reverse, reflections, common suffixes and prefixes
#     - Check for bad forms:
#       Number as prefix/suffix, common character substitutions
#     - Admin-defined password rules
#
# All operations can be made turned on or off to add flexibility.
# Also includes a verbose mode for help for users.
#
# Any dictionary can be used, but a simple one is included.
#

# Global defines
$dictfile   = "password.lst";
$rulefile   = "rules.lst";
$rcfile     = "passwd_ck.rc";

# your path to 'passwd' should go here
$passwd_bin = "/usr/bin/passwd";
die "Can't find passwd binary\n" unless (-e "$passwd_bin");

#---------------------------------------------------------------------

# # # # # # # # # #
# Main Program
#

# grab args and clear ARGV
@temparg = @ARGV;
@ARGV = ();

# print some online help
if ($temparg[0] eq "-h" || $temparg[0] eq "-?") {
   print <<'EOM';

Active Password Checker - v0.1
----------------------------------------------------------------------
This program is a active password checker.  It acts as a wrapper
for your system password change binary.   It will perform the
following operations before a password is allowed to be changed:
    - Check password for a 'sufficiently large' set of characters
      included.
    - Use a dictionary of bad passwords in a simple dictionary
      attack.
    - Handle words in the dictionary, all three of the following:
      reverse, reflections, common suffixes and prefixes
    - Check for bad forms:
      Number as prefix/suffix, common character substitutions
    - Admin-defined password rules

Any dictionary file may be used by using the -d switch.
The wrapper can be run in configuration mode by using the -c switch.

Usage:  passwd_ck [-h/?]|[-c]|[-d dictionary file]

EOM

die;
}

# check for user defined dictionary file
if ($temparg[0] eq "-d") {
   if (-e "$temparg[1]") {
      $dictfile = $temparg[1];
   }
   else {
      print "$temparg[1] doesn't exist.  Using default\n";
      die "Can't open default password list\n" unless (-e "$dictfile");
   }
}

# check for administrator mode
if ($temparg[0] eq "-c") {
   $admin_mode = 1;
}

# check for super secret dummy mode
# no changes will be made to the password database if this is set
if ($temparg[0] eq "-dummy") {
   $dummy = 1;
}

# load defaults from file
if (-e "$rcfile") {
   print "Reading defaults from file...";
   
   open(RCFILE, "$rcfile");

   if (defined(RCFILE)) {
      ($temp,$verbose) = split(/\s/,<RCFILE>);
      ($temp,$charset) = split(/\s/,<RCFILE>);
      ($temp,$passlen) = split(/\s/,<RCFILE>);
      ($temp,$dictchk) = split(/\s/,<RCFILE>);
      ($temp,$fundict) = split(/\s/,<RCFILE>);
      ($temp,$reversed) = split(/\s/,<RCFILE>);
      ($temp,$mirrored) = split(/\s/,<RCFILE>);
      ($temp,$admrule) = split(/\s/,<RCFILE>);
   }

   close(RCFILE);
   
   print "done.\n";
}

# built-in defaults
$verbose = 0 unless defined($verbose);
$charset = 1 unless defined($charset);
$passlen = 6 unless defined($passlen);
$dictchk = 1 unless defined($dictchk);
$mirrored = 1 unless defined($mirrored);
$reversed = 1 unless defined($reversed);
$fundict = 0 unless defined($fundict);
$admrule = 0 unless defined($admrule);

# load administrator rules
if (-e "$rulefile" || $admrule == 1) {
   open(ADMFILE, "$rulefile");

   if (defined(ADMFILE)) {
      my $temp = <ADMFILE>;
      @admrules = split(/\s/,$temp);
   }
   close(ADMFILE);
}

if ($admin_mode) {
   &Configurate();
   die "Bye";
}

# Time to get user's old password and new password

$not_ok = 1;
while ($not_ok == 1) {
   print "Old password: ";
   $old_passwd = <STDIN>;
   chomp($old_passwd);
   print "New password: ";
   $new_passwd = <STDIN>;
   chomp($new_passwd);
   print "New password again: ";
   $new_passwd2 = <STDIN>;
   chomp($new_passwd2);

   if ("$new_passwd" ne "$new_passwd2") {
      print "\nPasswords don't match.  Try again\n";
      $not_ok = 1;
   }
   elsif ("$new_passwd" eq "$old_passwd") {
      print "\nOld password matches new password.  Try again\n";
      $not_ok = 1;
   }
   else {
      $not_ok = 0;
   }
}


# Now to check the password

if ($charset == 1) { $char_ok = &Check_CharSet($new_passwd); }
if ($dictchk == 1) { $dict_ok = &Check_Dict($new_passwd); }
if ($admrule == 1) { $form_ok = &Check_AdmRule($new_passwd); }

if (defined($char_ok) && $char_ok != 1) {
   print "\nPassword failed character set check.\n\n";
   if ($verbose) {
      print "  Your password didn't contain multiple cases or extra\n";
      print "  characters.  A good password contains these characters\n";
      print "  to increase the character set from which the password\n";
      print "  is chosen\n";
   }
   die "\nPlease try a different password\n\n";
}

if (defined($dict_ok) && $dict_ok != 1) {
   print "\nPassword failed dictionary attack.\n\n";
   if ($verbose) {
      print "  Your password was either a word from a dictionary,\n";
      print "  or a word like something found in the dictionary.\n";
      print "  Good passwords should not be derived from words that\n";
      print "  can be found in a dictionary, and should not contain\n";
      print "  common letter substitutions, like '0' for 'o' and '1'\n";
      print "  for 'i'.\n";
   }
   die "\nPlease try a different password\n\n";
}

if (defined($form_ok) && $form_ok != 1) {
   print "\nPassword failed administrator rules.\n\n";
   if ($verbose) {
      print "  Your administrator has set some rules that your password\n";
      print "  cannot match.  These rules could be to deny all passwords\n";
      print "  that are words followed by digits, or perhaps something\n";
      print "  more complicated.\n";
   }
   die "\nPlease try a different password\n\n";
}

if (!$dummy) {
   print "Changing system password.\n";

   system "stty -echo";
#   system "$passwd_bin | echo $old_passwd $new_passwd $new_passwd";
   system "stty echo";
}
else {
   print "In dummy mode...  not changing password.\n";
}

# # # # # # # # # #
# End Main
#

#---------------------------------------------------------------------

# # # # # # # # # #
# Begin Functions
#

# # # # # # # # # #
# Check_CharSet
#
# Function checks input string for length, existence of all one case,
# use of punctuation, and use of numbers.
# Input:
#     Character string
# Output:
#     If string passes all tests, true
#     else, false.

sub Check_CharSet {

   $passwd = shift @_;           # grab string
   chomp($passwd);               # clear trailing whitespace

   # check length
   if (length($passwd) < $passlen) {
      print "Password length too short.\n";
      print "Your password needs to be at least $passlen characters.\n";
      return 0;
   }

   # check for case
   if (!($passwd =~ /[A-Z]+/g)) {
      print "Password doesn't contain one or more uppercase letters.\n";
   }   

   # check for numbers
   if (!($passwd =~ /[0-9]+/g)) {
      print "Password doesn't contain one or more numbers.\n";
   }

   # check for punctuation
   if (!($passwd =~ /[^a-zA-Z0-9]+/g)) {
      print "Password doesn't contain one or more punctuations.\n";
   }

   return 1;

}

# # # # # # # # # #
# Check_Dict
#
# Function checks input string against a dictionary file.
# Check for straight matches, reverse matches, mirrored matches, 
# common suffixes (ie: -ed, -s, -ing)
# 
# Input:
#     Character string
# Output:
#     If string matches no words in file, true
#     else, false.

sub Check_Dict {

   my $passwd = shift @_;           # grab string
   chomp($passwd);               # clear trailing whitespace

   # these are all the suffixes I could think of or find.
   # this will probably be sufficient, either way.
   my @suffixes = ("ed","es","s","ing","ible","able","er","ly","ie");

   open(DICTIONARY,"$dictfile");

   while(<DICTIONARY>) {

      chomp;                     # clear trailing whitespace on $_
      
      # check straight match
      if ($passwd eq $_) { return 0; }

      if ($reversed == 1) {
         # check reverse match
         if ($passwd eq reverse($_)) { return 0; }
      }
         
      if ($mirrored == 1) {
         # check mirrored match
         my $mir = reverse($_);
         $mir = $_.$mir;
         if ($passwd eq $mir) { return 0; }
      }
         
      # if set, do the funky dictionary checks
      if ($fundict == 1) {

         # check common suffixes
         foreach $suf (@suffixes) {
            my $sufx = $_.$suf;
            if ($passwd eq $sufx) { return 0; }
         }

         # check common replacements
         # tr only operates on $_, so we need to save it
         my $temp = $_;
         tr/aeio/4310/;
         $replace = $_;
         if ($passwd eq $replace) { return 0; }
         $_ = $temp;

         # check for number as pre/suffix
         foreach $fix (0..9) {
            my $prex = $fix.$_;
            my $sufx = $_.$fix;
            if ($passwd eq $prex || $passwd eq $sufx) { return 0; }
         }
      }
   }

   # we've got a keeper!
   return 1;
}

# # # # # # # # # #
# Check_AdmRule
#
# Function checks string for admin rules
# Rules are in the form WDP for word, decimal, and punctuation.
#
# Input:
#     Character string
# Output:
#     If string does not fit character rules, true
#     else, false.

sub Check_AdmRule {

   my $passwd = shift @_;        # grab string
   chomp $passwd;

   foreach $item (@admrules) {
      my @rule = split(/[WDP]/,$item);

      foreach $inst (@rule) {
         if ($inst eq "W") {
            if (/\w/g) { return 0; }
         }
         if ($inst eq "D") {
            if (/[0-9]/g) { return 0; }
         }
         if ($inst eq "P") {
            if (/\W\D/) { return 0; }
         }
      }
   }
}

# # # # # # # # # #
# Configurate
#
# Function configures script.
# Prompts user for settings changes, and writes them back to the rc file.
#
# Input:
#     None.
# Output:
#     Writes back to $rcfile

sub Configurate {

   my $quit = 0;

   while (!$quit) {
      system "clear";

      print "1. Verbose mode................................[$verbose]\n";
      print "2. Character Set Check.........................[$charset]\n";
      print "3. Password Length.............................[$passlen]\n";
      print "4. Dictionary Check............................[$dictchk]\n";
      print "5. Funky Dictionary Check (subs, pre/suffixes).[$fundict]\n";
      print "6. Reversed Dictionary Check...................[$reversed]\n";
      print "7. Mirrored Dictionary Check...................[$mirrored]\n";
      print "8. Use Administrator Rules.....................[$admrule]\n";
      print "\n";
      print "Change which? [q to quit] ";
      my $change = <STDIN>;
      chomp($change);

      if    ($change == 1) { $verbose=&toggle($verbose); }
      elsif ($change == 2) { $charset=&toggle($charset); }
      elsif ($change == 3) { 
         print "New password length: ";
         $passlen = <STDIN>;
         chomp($passlen);
      }
      elsif ($change == 4) { $dictchk=&toggle($dictchk); }
      elsif ($change == 5) { $fundict=&toggle($fundict); }
      elsif ($change == 6) { $reversed=&toggle($reversed); }
      elsif ($change == 7) { $mirrored=&toggle($mirrored); }
      elsif ($change == 8) { $admrule=&toggle($admrule); }
      elsif ($change eq 'Q' || $change eq 'q') { $quit = 1; }
      else {
         print "Invalid choice\n";
      }
   }

   open(RCFILE, ">$rcfile");
   print RCFILE "verbose $verbose\n";
   print RCFILE "charset $charset\n";
   print RCFILE "passlen $passlen\n";
   print RCFILE "dictchk $dictchk\n";
   print RCFILE "fundict $fundict\n";
   print RCFILE "reversed $reversed\n";
   print RCFILE "mirrored $mirrored\n";
   print RCFILE "admrule $admrule\n";
   close(RCFILE);
}

# # # # # #
# toggle
# 
# Function changes value from 1 to 0 or vice versa.
#
# Input:
#     Numeric variable
# Output:
#     1 or 0

sub toggle {
   my $value = shift @_;

   if ($value > 0) { return 0; }
   else { return 1; }
}