#! /bin/perl -Tw
#############################################################################
#
#                 NOTE: This file under revision control using RCS
#                       Any changes made without RCS will be lost
#
#              $Source: U:\\mhansen\\bin\\RCS\\chpasswd,v $
#            $Revision: 1.0 $
#                $Date: 1999-08-14 17:35:43-05 $
#              $Author: mhansen $
#              $Locker:  $
#               $State: Exp $
#
#
#              Purpose: Check proposed password for weaknesses such as:
#                       Too short, variation of user's last passwd, account 
#                       name, must contain a special character, etc.
#
#          Description: Encrypts password and inserts into /etc/shadow file,
#                       does not use /bin/passwd command. Runs setuid root.
#
#           Directions: Usage: passwd [account]
#                       old password not required when invoked by root
#                       (unless changing root's password, of course.)
#
#     Default Location: /share/local/bin/ch_passwd
#
#           Invoked by: operator
#
#           Depends on: 
#
#       Copyright (C) 1999  Marc Hansen
#
#       This program is free software; you can redistribute it and/or
#       modify it under the terms of version 2 of the GNU General Public
#       License as published by the Free Software Foundation available at:
#       http://http://www.gnu.org/copyleft/gpl.html
#
#       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.
#
#############################################################################
#
#
#       REVISION HISTORY:
#
#       $Log: chpasswd,v $
#       Revision 1.0  1999-08-14 17:35:43-05  mhansen
#       Initial revision
#
#
#


#
# Program modules.
#
use Term::ReadKey;              # Needed to stop echo for password
use File::LckPwdF;              # Provides locking for passwd and shadow files

#
# Constants
#
$PASSLENGTH=6;                  # Minimum password length
$MAXTRY=3;                      # Maximum number of tries to comply with rules
$SHADOW = "/etc/shadow";
$STMP = "/etc/stmp";

#
# We are running setuid, clean up the environment
#
$ENV{PATH}="/bin";
$ENV{ENV}="";

# Generate random salt for password crypt
srand(time()^($$+($$<<15)));
@saltlist = qw(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 .
               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 /);
$salt     = $saltlist[int(rand(54))].$saltlist[int(rand(54))];


#
# Check UID, we must be root.
#
if ($> ne 0) {
    die "This program must be setuid root.\n
         Run once as root to set mode.\n"
}


#
# Set interrupt handlers
# so that any interrupt removes locks
#
$SIG{INT} = \&ulexit;
$SIG{QUIT} = \&ulexit;
$SIG{TERM} = \&ulexit;



#
# Get account name to change and print confirmation
#
if (scalar(@ARGV) > 0) {            # If there are args then account 
    $acct=$ARGV[0];                 # name is the first argument.
}
else {
    @acct=getpwuid($<);             # Otherwise use UID of the person
    $acct=$acct[0];                 # logged in.
}
print  "Changing password for $acct\n";



# Turn echo off while we get passwords
ReadMode('noecho');               
$noecho++;


#
# If user is not root, get their old password
#
if ($< eq 0 && $acct ne "root") {   # if we are root then we can
    $root++;                        # change others without authenticating
}                           
else {                              
    $root=0;
    print  "Enter Old Password: ";  # Otherwise get their old password
    $old=ReadLine(0);
    print "\n";
    chomp $old;
}


#
# Build list of weak words
# Fragments and rotations of old password
# and account name.
#
frag(4,\@weakwords, $old, $acct,);
rot(\@weakwords, $old, $acct,);



#
# Get new password (twice to avoid misunderstandings)
#
{
    my ($n, $e, $newchk);
    # Loop for maximum number of tries to type it the same twice in row
    NEWPW: for ($n=0;1;$n++) { 

        # Loop for maximum number of tries to choose a good password
        ENTER: for ($e=0;1;$e++) {           

            print  "New Password: ";                    # Get requested password
            $new=ReadLine(0);                   
            print "\n";
            chomp $new;
            if (weak($new,$acct,$old)) {                # Test it for weakness
                print "passwd: $msg\n";
                if ($e>=$MAXTRY) {
                    ulexit("Too many failures, exiting.\n",1);
                }
                next ENTER;
            }
            else {last ENTER;}
        }

        print  "Re-enter new Password: ";               # Get password again 
        $newchk=ReadLine(0);                            
        print "\n";
        chomp $newchk;
        if ($new ne $newchk) {                          # Is it the same?
            print "passwd: They don't match; ";
            if ($n>=$MAXTRY) {
                ulexit("Too many failures, exiting.\n",1);
            }
            print "Try again.\n";
            next NEWPW;
        }
        else {last NEWPW;}
    }
    ReadMode('normal');                                 # turn echo back on
    $noecho=0;
}



#
# change password
#
$status = chpasswd();
if ($status) {
  ulexit("$msg\nPassword NOT changed.\n", $status);
}

ulexit ("Password changed.\n",0);

exit 0;




###################
#
# Function: weak
#  Purpose: test password for weaknesses
#     Arg1: new password
#     Arg2: account name
#     Arg3: old password
#  Returns: 1 if weak, 0 if good
#           sets $msg to message describing weakness
#
sub weak {
  my ($new, $acct, $old) = @_;
  if (length($new)<$PASSLENGTH) {
    $msg = "Password must be at least $PASSLENGTH character long.";
    return 1;
  }

  if ($new =~ /[\000-\037\177]/) {
    $msg = "Password cannot contain control codes.";
    return 1;
  }

  if ($new =~ /$acct/) {
    $msg = "Password cannot contain login name.";
    return 1;
  }

  if ($new =~ /$old/) {
    $msg = "New password cannot contain old password.";
    return 1;
  }

  if ($new !~ /[\040-\100\133-\140\173-\176]/) {
    $msg = "Password must contain one numeric or special character.";
    return 1;
  }

  if ($new !~ /[a-zA-Z].*[a-zA-Z]/) {
    $msg = "Password must contain at least two alphabetic characters.";
    return 1;
  }
  
  foreach (@weakwords) {
    if ($new =~ /$_/) {
    $msg = "Password cannot contain permutations of the login or password.";
    return 1;
    }
  }

  return 0;
}



###################
#
# Function: rot
#  Purpose: builds a list of all possible rotations
#           and reverse rotations of source strings
#     Arg1: destination list (must ref as \@array)
#    Arg2+: list of source strings
#
sub rot {
  my ($dlist, @source) = @_;
  foreach $_ (@source){
    my (@word, @rev, $i, $len);
    @word = split //, $_;
    $len = scalar(@word);
    for ($i=0;$i<$len;$i++) {
      push @word, shift @word;
      push @$dlist, (join '', @word);
    } 
    @rev = reverse @word;
    for ($i=0;$i<$len;$i++) {
      push @rev, shift @rev;
      push @$dlist, (join '', @rev);
    } 
  }
}



###################
#
# Function: frag
#  Purpose: builds a list of all possible fragments of source strings
#     Arg1: size of fragment
#     Arg2: destination list (must ref as \@array)
#    Arg3+: list of source strings 
#
sub frag {
  my ($size, $dlist, @source) = @_;
  foreach $_ (@source){
    my ($i, $len);
    $len = length($_);
    for ($i=0;$i<($len-$size+1);$i++) {
      push @$dlist, substr($_, $i, $size);
    } 
  } 
}



###################
#
# Function: ulexit
#  Purpose: exit program clearing lock files and resetting readmode if needed
#
sub ulexit {
  my ($msg, $status) = @_;
  if ($noecho) {ReadMode('normal')}     # turn echo back on
  print "\n$msg\n";                     
  unlock_passwd() || (die "Can't unlock password file:\n$! stopped");
  unlink ("$STMP");
  exit $status;
}



###################
#
# Function: chpasswd
#  Purpose: change password in /etc/shadow
#
sub chpasswd {
  my $changed = 0;
  
  # Lock passwd and shadow files  
  lock_passwd(15) or (die "Can't lock password file:\n$! stopped");

  # Open tmp file to write
  if (! -e $STMP) {
    open (TMP, ">$STMP") 
      or (die "can't open tmp file:\n$! stopped");
  } else {die "$STMP already exists:\n$! stopped"}
  
  # Open shadow file to read
  open (FILE, "<$SHADOW") or (die "can't open $SHADOW:\n$! stopped");
  
  # Loop through shadow file
  while (<FILE>) {
    @line = split /:/;

    # Check to see if this is the line to change
    if ($line[0] eq "$acct") {
    
      # Check to see if user provided correct old password
      if ((! $root) && (crypt($old,$line[1]) ne $line[1])) {
        ulexit ("Old login password is wrong.",1);
        return(1);
      }
      
      # Put new hashed password in its place
      $line[1]=crypt($new,$salt);
      
      # Set changed flag
      $changed++;
    }
    
    # Write current line to tmp file
    print TMP join ':',@line;
  }
  close TMP;
  close FILE;
  
  # If changed flag not set then we never found the user
  if (! $changed) {
    ulexit ("User $acct not found.",1);
    return(1);
  }
  
  # replace the shadow file with the tmp file
  rename("$SHADOW", "$SHADOW.orig") 
        or die "can't rename $SHADOW, $SHADOW.orig: $!";
  rename("$STMP", "$SHADOW")        
        or die "can't rename $STMP, $SHADOW: $!";
        
  # Unlock passwd and shadow files  
  unlock_passwd() or (die "Can't unlock password file:\n$! stopped");
  return 0;
}


__END__