#/usr/local/bin/perl

# Customizable items.

$AGEWEEKS = 8;
$EXPWEEKS = 12;
$BADPATS = '/u/wjm/perl/cops/jargon';
$BADWORDS = '/u/wjm/perl/cops/bad_pws.dat';

# Make a list of dictionaries to search with &look

@words = $BADWORDS;
if (-f '/usr/dict/web2') {
    push(@words,'/usr/dict/web2');
}
push(@words,'/u/wjm/perl/cops/words');
$fh = 'dictaa';
foreach $dict (@words) {
    open($fh,$dict) && push(@dicts, eval "*$fh");
    $fh++;
}

# Security blankets.

$ENV{'IFS'} = '' if $ENV{'IFS'};
$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin:/usr/ucb';
umask(022);

chdir '/etc' || die "Can't find /etc.\n";
die "passwd program isn't running setuid to root\n" if $>;

@INC = $INC[$#INC - 1];         # Use only perl library.
die "Perl library is writable by world!!!\n"
    if $< && -W $INC[0];
die "look.pl is writable by world!!!\n"
    if $< && -W "$INC[0]/look.pl";
require "look.pl";

# Uncustomizable items.

$| = 1;         # command buffering on STDOUT

@saltset = ('a' .. 'z', 'A' .. 'Z', '0' .. '9', '.', '/');

chop($host = `hostname`);

# Process the arguments.

$relax = shift if $ARGV[0] =~ /^-r/;
$relax = 0 if $<;               # (superuser only)

if ($ARGV[0] =~ /^-a(.*)/) {
    $AGE = $1;
    $AGE = $AGEWEEKS + 1 if $AGE <= 0;
    $AGE = $EXPWEEKS + 1 if $AGE > $EXPWEEKS;
    shift;
}

# Whose password are we changing, anyway?

# (We use getlogin in preference to getpwuid($<)[0] in case
#  different accounts are sharing uids.)

($me) = @ARGV;
die "You can't change the password for $me.\n" if $me && $<;
$me = getlogin unless $me;
$me = (getpwuid($<))[0] unless $me;

# Trap these signals

$SIG{'INT'} = 'CLEANUP';
$SIG{'HUP'} = 'CLEANUP';
$SIG{'QUIT'} = 'CLEANUP';
$SIG{'PIPE'} = 'CLEANUP';
$SIG{'ALRM'} = 'CLEANUP';

# Check first before putting them through the wringer.  (We'll
#   check again later.)

die "/etc/passwd file busy--try again later.\n" if -f 'ptmp';

# A check to see if they have an application form on file.

#open(FORMS,"forms") || die "Can't open /etc/forms";
#$informs = 0;
#while (<FORMS>) {
#    chop;
#    if ($_ eq $me) {
#	$informs = 1;
#	last;
#    }
#}
#close(FORMS);

#die <<"EOM" unless $informs;
#No application on file for $me--contact system administration.
#EOM

# Give them something to read so they don't get bored.

print "\nChanging password for $me.\n";

# Get passwd entry and remember all logins

$login = '';
open(PASSWD,"passwd") || die "Can't open /etc/passwd";
while (<PASSWD>) {
    /^([^:]+)/;
    if ($1 eq $me) {
	($login,$opasswd,$uid,$gid,$ogcos,$home,$shell)
	    = split(/:/);
	die "You aren't you! ($< $uid $me $x $login)\n"
	    if $< && $< != $uid;      # Just being paranoid...
	$salt = substr($opasswd,0,2);

	# Canonicalize name.

	$ogcos =~ s/,.*//;
	$mynames = $ogcos;
	$mynames =~ s/\W+/ /;
	$mynames =~ s/^ //;
	$mynames =~ s/ $//;
	$mynames =~ s/ . / /g;
	$mynames =~ s/ . / /g;
	$mynames =~ s/^. //;
	$mynames =~ s/ .$//;
	$mynames =~ s/ /|/;
	$mynames = '^$' if $mynames eq '';
    }
    ++$isalogin{$1} if length($1) >= 6;
}
close(PASSWD);
die "$me isn't in the passwd file.\n" unless $login;

# Check for shadow password file.

if ($opasswd eq 'x' && -f '/etc/shadow') {
    $shadowing = 1;
    open(SHADOW,"shadow") || die "Can't open /etc/shadow";
    while (<SHADOW>) {
	/^([^:]+)/;
	if ($1 eq $me) {
	    ($login,$opasswd) = split(/:/);
	    $salt = substr($opasswd,0,2);
	    last;
	}
    }
    close(SHADOW);
}

# Fetch old passwords (the encrypted version).

open(PASSHIST,"passhist");
while (<PASSHIST>) {
    /^([^:]+)/;
    if ($1 eq $me) {
	($login,$opass,$when) = split(/:/);
	$opass{$opass} = $when;
    }
}
close PASSHIST;

# Build up a subroutine that does matching on bad passwords.
# We'll use an eval to define the subroutine.

$foo = 'sub badpats {local($_) = @_;study;';
open(BADPATS,$BADPATS);
while (<BADPATS>) {
    ($badpat,$maybe) = split(/[\n\t]+/);
    ($response = $maybe) =~ s/'/\\'/ if $maybe;
    $foo .= "return '$response' if /$badpat/;\n";
}
close BADPATS;
$foo .= 'return 0;}';
eval $foo;              # Note: this defines sub badpats

# Finally we can begin.

system 'stty', '-echo';

if ($<) {
    print "Old password: ";
    chop($pass0 = <STDIN>);
    print "\n";

    # Note: we shouldn't use die while echo is off.

    do myexit(1) unless $pass0;
    if (crypt($pass0,$salt) ne $opasswd) {
	print "Sorry.\n";
	do myexit(1);
    }
}

# Pick a password

for (;;) {
    $goodenough = 0;
    until ($goodenough) {
	print "New password: ";
	chop($pass1 = <STDIN>);
	print "\n";
	do myexit(1) unless $pass1;
	print "(Checking for lousy passwords...)\n";
	$goodenough = &goodenough($pass1);

	# If longer than 8 chars, check first 8 chars alone.

	if ($goodenough && length($pass1) > 8) {
	    $pass8 = substr($pass1,0,8);
	    print "(Rechecking first 8 characters...)\n";
	    unless ($goodenough = &goodenough($pass8)) {
		    print <<'EOM';
(Note that only the first 8 characters count.)
EOM
	    }
	}
    };

    print "Retype new passwd: ";
    chop($pass2 = <STDIN>);
    print "\n";
  last if ($pass1 eq $pass2);
    print "Password mismatch--try again.\n";
}

system 'stty', 'echo';

# Now check again for a lock on the passwd file.

if (-f 'ptmp') {
    print "Password file busy--waiting up to 60 seconds...\n";
    for ($i = 60; $i > 0; --$i) {
	sleep(1);
	print $i,'...';
	last unless -f 'ptmp';
    }
}
die "\n/etc/passwd file busy--try again later.\n" if -f 'ptmp';

# Create the lock using link() for atomicity

open(PTMP,">ptmptmp$$")
    || die "Can't create tmp passwd file.\n";
close PTMP;
$locked = link("ptmptmp$$",'ptmp');
unlink "ptmptmp$$";
$locked || die "/etc/passwd file busy--try again later.\n";

open(PASSWD,"passwd") || die "Can't open passwd file.\n";
open(PTMP,">ptmp") || die "Can't copy passwd file.\n";

# Encrypt using salt that's fairly random but encodes weeks
# since 1970, mod 64.

# (We perturb the week using the first two chars of $me so
# that if everyone changes their password the same week we
# still get more than 64 possible salts.)

$now = time;
($pert1, $pert2) = unpack("C2", $me);
$week = $now / (60*60*24*7) + $pert1 + $pert2 - $AGE;
$nsalt = $saltset[$week % 64] .  $saltset[$now % 64];
$cryptpass = crypt($pass1,$nsalt);

# Now build new passwd file

while (<PASSWD>) {
    chop;
    ($login,$passwd,$uid,$gid,$gcos,$home,$shell) = split(/:/);
    next if $login eq '';       # remove garbage entries

    # Disable open accounts.  Login ids beginning with + are
    # NIS (aka YP) indirections and aren't a problem.

    $passwd = '*' if $passwd eq '' && $login !~ /^\+/;

    # Is this the line to change?

    if ($login eq $me) {
	if ($shadowing) {
	    $passwd = 'x';
	}
	else {
	    $passwd = $cryptpass;
	}

	# The following code implements a password aging scheme
	# by substituting a different shell for aged or expired
	# accounts.  Ordinarily this is done by another script
	# running in the middle of the night.  Unless someone
	# typed "passwd -a", this script always makes a new
	# password and unexpires the account.

	if ($shell =~ /(exp|age)\.(.*)/) {
	    $shell = "/bin/$2";
	}
	if ($AGE >= $EXPWEEKS) {
	    if ($shell =~ m|/bin/(.*)|) {
		$sh = $1;
		$sh = 'csh' if $sh eq '';
		$shell = "/usr/etc/exp.$sh";
	    }
	}
	elsif ($AGE >= $AGEWEEKS) {
	    if ($shell =~ m|/bin/(.*)|) {
		$sh = $1;
		$sh = 'csh' if $sh eq '';
		$shell = "/usr/etc/age.$sh";
	    }
	}
    }
    print PTMP "$login:$passwd:$uid:$gid:$gcos:$home:$shell\n"
	|| do { unlink 'ptmp'; die "Can't write ptmp: $!"; };
}
close PASSWD;
close PTMP;

# Sanity checks.

($dev,$ino,$omode,$nlink,$uid,$gid,$rdev,$osize)
    = stat('passwd');
($dev,$ino,$nmode,$nlink,$uid,$gid,$rdev,$nsize)
    = stat('ptmp');
if ($nsize < $osize - 20 || $uid) {
    unlink 'ptmp';
    die "Can't write new passwd file! ($uid)\n";
}
chmod 0644, 'ptmp';

# Do shadow password file while we still have ptmp lock.

if ($shadowing) {
    open(SHADOW,"shadow") || die "Can't open shadow file.\n";
    umask 077;
    open(STMP,">stmp") || die "Can't copy shadow file.\n";

    # Now build new shadow file.

    while (<SHADOW>) {
	chop;
	@fields = split(/:/);
	if ($fields[0] eq $me) {
	    $fields[1] = $cryptpass;
	}
	print STMP join(':',@fields), "\n";
    }
    close SHADOW;
    close STMP;
    chmod 0600, 'shadow';       # probably unnecessary
    rename('shadow','shadow.old');
    chmod 0600, 'stmp';
    rename('stmp','shadow');
}

# Release lock by renaming ptmp.

rename('passwd','passwd.old');
rename('ptmp','passwd')
    || die "Couldn't install new passwd file: $!\n";

# Now remember the old password forever (in encrypted form).

$now = time;
open(PASSHIST,">>passhist") || exit 1;
print PASSHIST "$me:$opasswd:$now\n";
close PASSHIST;
exit 0;

###############################################################
#                                                             #
# This subroutine is the whole reason for this program.  It   #
# checks for many different kinds of bad password.  We don't  #
# tell people what kind of pattern they MUST have, because    #
# that would reduce the search space unnecessarily.           #
#                                                             #
# goodenough() returns 1 if password passes muster, else 0.   #
#                                                             #
###############################################################

sub goodenough {
    return 1 if $relax;         # Only root can bypass this.
    $pass = shift(@_);
    $mono = $pass !~ /^.+([A-Z].*[a-z]|[a-z].*[A-Z])/;
    $mono = 0 if $pass =~ /[^a-zA-Z0-9 ]/;

    $now = time;
    ($nsec,$nmin,$nhour,$nmday,$nmon,$nyear) = localtime($now);

    # Embedded null can spoof crypt routine.

    if ($pass =~ /\0/) {
	print <<"EOM";
Please don't use the null character in your password.
EOM
	return 0;
    }
   if (!(($pass =~ /\d/)||($pass =~ /\W/))){
      print <<"EOM";
Please use at least one numeric or control character in your password
EOM
       return 0;
     }
    # Same password they just had?

    if (crypt($pass,$salt) eq $opasswd) {
	print <<"EOM";
Please use a different password than you just had.
EOM
	return 0;
    }

    # Too much like the old password?

    if ($pass0 && length($pass0) == length($pass)) {
	$diff = 0;
	for ($i = length($pass)-1; $i >= 0; --$i) {
	    ++$diff
	      if substr($pass,$i,1) ne substr($pass0,$i,1);
	}
	if ($diff <= 2) {
	    print <<"EOM";
That's too close to your old password.  Please try again.
EOM
	    return 0;
	}
    }

    # Too short?  Get progressively nastier.

    if (length($pass) < 6) {
	print "I SAID, " if $isaid++;
	print "Please use at least 6 characters.\n";
	print "\nIf you persist I will log you out!\n\n"
	    if $isaid == 3;
	print "\nI mean it!!\n\n"
	    if $isaid == 4;
	print "\nThis is your last warning!!!\n\n"
	    if $isaid == 5;
	if ($isaid == 6) {
	    print "\nGoodbye!\n\n";
	    seek(STDIN,-100,0);  # Induce indigestion in shell.
	    exit 123;
	}
	return 0;
    }
    $isaid = 0;

    # Is it in one of the dictionaries?

    if ($pass =~ /^[a-zA-Z]/) {
	($foo = $pass) =~ y/A-Z/a-z/;

	# First check the BADPATS file.

	if ($response = do badpats($foo)) {
	    print $response, "  Please try again.\n";
	    return 0;
	}

	# Truncate common suffixes before searching dict.

	$shorte = '';
	$short = $pass;
	$even =
	    ($short =~ s/\d+$//)
		? " (even with a number)"
		: "";
	$short =~ s/s$//;
	$short =~ s/ed$// && ($shorte = "${short}e");
	$short =~ s/er$// && ($shorte = "${short}e");
	$short =~ s/ly$//;
	$short =~ s/ing$// && ($shorte = "${short}e");
	($cshort = $short) =~ y/A-Z/a-z/;

	# We'll iterate over several dictionaries.

	@tmp = @dicts;
	while ($dict = shift(@tmp)) {
	    local(*DICT) = $dict;

	    # Do the lookup (dictionary order, case folded)

	    &look($dict,$short,1,1);
	    while (<DICT>) {
		($cline = $_) =~ y/A-Z/a-z/;
	    last if substr($cline,0,length($short)) ne $cshort;
		chop;
		($_,$response) = split(/\t+/);
		if ($pass eq $_ ||
		  ($pass eq substr($_,0,8)) ||
		  ($pass =~ /^$_$/i && $mono) ||
		  $shorte eq $_ ||
		  ($shorte =~ /^$_$/i && $mono) ||
		  $short eq $_ ||
		  ($short =~ /^$_$/i && $mono)) {
		    if ($response) {      # Has a snide remark.
			print $response,
			    "  Please try again.\n";
		    }

		    elsif (/^[A-Z]/) {
			if (/a$|ie$|yn$|een$|is$/) {
			    print <<"EOM";
Don't you use HER name that way!
EOM
			}
			else {
			    print <<"EOM";
That name is$also too popular.  Please try again.
EOM
			    $also = ' also';
			}
		    }
		    else {
			print <<"EOM";
Please avoid words in the dictionary$even.
EOM
		    }
		    return 0;
		}
	    }
	}
    }

    # Now check for two word-combinations.  This gets hairy.
    # We look up everything that starts with the same first
    # two letters as the password, and if the word matches the
    # head of the password, we save the rest of the password
    # in %others to be looked up later.  Passwords which have
    # a single char before or after a word are special-cased.

    # We take pains to disallow things like "CamelAte",
    # "CameLate" and "CamElate" but allow things like
    # "CamelatE" or "CameLAte".

    # If the password is exactly 8 characters, we also have
    # to disallow passwords that consist of a word plus the
    # BEGINNING of another word, such as "CamelFle", which
    # will warn you about "camel" and "flea".

    if ($pass =~ /^.[a-zA-Z]/) {
	%others = ();
	($cpass = $pass) =~ y/A-Z/a-z/;
	($oneup) = $pass =~ /.[a-z]*([A-Z][a-z]*)$/;
	$cpass =~ s/ //g;
	if ($pass !~ /.+[A-Z].*[A-Z]/) {
	    $others{substr($cpass,1,999)}++
		if $pass =~ /^..[a-z]+$/;
	    @tmp = @dicts;
	    while ($dict = shift(@tmp)) {
		local(*DICT) = $dict;
		$two = substr($cpass,0,2);
		&look($dict,$two,1,1);
		$two++;
		word: while (<DICT>) {
		    chop;
		    s/\t.*//;
		    y/A-Z/a-z/;
		    last if $_ ge $two;
		    if (index($cpass,$_) == 0) {
			$key = substr($cpass,length($_),999);
			next word if $key =~ /\W/;
			$others{$key}++ unless $oneup
			&& length($oneup) != length($key);
		    }
		}
	    }

	    @tmp = @dicts;
	    while ($dict = shift(@tmp)) {
		local(*DICT) = $dict;
		foreach $key (keys(%others)) {
		    &look($dict,$key,1,1);
		    $_ = <DICT>;
		    chop;
		    s/\t.*//;
		    if ($_ eq $key
		      || length($pass) == 8 && /^$key/) {
			$pre = substr($cpass,0,length($cpass)
			    - length($key));
			if (length($pre) == 1) {
			    $pre = sprintf("^%c", ord($pre)^64)
				unless $pre =~ /[ -~]/;
			    print <<"EOM";
One char "$pre" plus a word like "$_" is too easy to guess.
EOM
			    return 0;
			}

			print <<"EOM";
Please avoid two-word combinations like "$pre" and "$_".
Suggestion: insert a random character in one of the words,
or misspell one of them.
EOM
			return 0;
		    }
		    elsif (length($key) == 1
		      && $pass =~ /^.[a-z]+.$/) {
			chop($pre = $cpass);
			$key = sprintf("^%c", ord($key)^64)
			    unless $key =~ /[ -~]/;
			print <<"EOM";
A word like "$pre" plus one char "$key" is too easy to guess.
EOM
			return 0;
		    }
		}
	    }
	}
    }

    # Check for naughty words.   :-)

    # (Add the traditional naughty words to the list sometime
    # when your mother isn't watching.  We didn't want to
    # print them in a family-oriented book like this one...)

    if ($pass =~ /(ibm|dec|sun|at&t|nasa)/i) {
	print qq#A common substring such as "$1" makes your# .
	    " password too easy to guess.\n";
	return 0;
    }

    # Does it look like a date?

    if ($pass =~ m!^[-\d/]*$!) {
	if ($pass =~ m!^\d{3}-\d{2}-\d{4}$! ||
	    $pass =~ m!^\d\d\d\d\d\d\d\d\d$!) {
	    print <<"EOM";
Please don't use a Social Security Number!
EOM
	    return 0;
	}
	if ($pass =~ m!^\d*/\d*/\d*$! ||
	    $pass =~ m!^\d*-\d*-\d*$! ||
	    $pass =~ m!$nyear$!) {
	    print "Please don't use dates.\n";
	    return 0;
	}
	if ($pass =~ m!^\d\d\d-?\d\d\d\d$!) {
	    print "Please don't use a phone number.\n";
	    return 0;
	}
	if ($pass =~ m!^\d{6,7}$!) {
	    print "Please don't use a short number.\n";
	    return 0;
	}
    }

    if ($mo = ($pass =~ /^[ \d]*([a-zA-Z]{3,5})[ \d]*$/) &&
        $mo =~ /^(jan|feb|mar(ch)?|apr(il)?|may|june)$/i ||
       $mo =~ /^(july?|aug|sept?|oct|nov|dec)$/i ) {
	print "Please don't use dates.\n";
	return 0;
    }

    # Login id?

    if ($pass =~ /$me/i) {
	print "Please don't use your login id.\n";
	return 0;
    }

    # My own name?

    if ($pass =~ /$mynames/i) {
	print "Please don't use part of your name.\n";
	return 0;
    }

    # My host name?

    if ($pass =~ /$host/i) {
	print "Please don't use your host name.\n";
	return 0;
    }

    # License plate number?

    if ($pass =~ /^\d?[a-zA-Z][a-zA-Z][a-zA-Z]\d\d\d$/ ||
	$pass =~ /^\d\d\d[a-zA-Z][a-zA-Z][a-zA-Z]$/) {
	print "Please don't use a license number.\n";
	return 0;
    }

    # A function key?  (This pattern checks Sun-style fn keys.)

    if ($pass =~ /^\033\[\d+/) {
	print "Please don't use a function key.\n";
	return 0;
    }

    # A sequence of closely related ASCII characters?

    @ary = unpack('C*',$pass);
    $ok = 0;
    for ($i = 0; $i < $#ary; ++$i) {
	$diff = $ary[$i+1] - $ary[$i];
	$ok = 1 if $diff > 1 || $diff < -1;
    }
    if (!$ok) {
	print "Please don't use sequences.\n";
	return 0;
    }

    # A sequence of keyboard keys?

    ($foo = $pass) =~ y/A-Z/a-z/;
    $foo =~ y/qwertyuiop[]asdfghjkl;'zxcvbnm,.\//a-la-ka-j/;
    $foo =~ y/!@#\$%^&*()_+|~/abcdefghijklmn/;
    $foo =~ y/-1234567890=\\`/kabcdefghijlmn/;
    @ary = unpack('C*',$foo);
    $ok = 0;
    for ($i = 0; $i < $#ary; ++$i) {
	$diff = $ary[$i+1] - $ary[$i];
	$ok = 1 if $diff > 1 || $diff < -1;
    }
    if (!$ok) {
	print "Please don't use consecutive keys.\n";
	return 0;
    }

    # Repeated patterns: ababab, abcabc, abcdabcd

    if ( $pass =~ /^(..)\1\1/
      || $pass =~ /^(...)\1/
      || $pass =~ /^(....)\1/ ) {
	print <<"EOM";
Please don't use repeated sequences of "$1".
EOM
	return 0;
    }

    # Reversed patterns: abccba abcddcba

    if ( $pass =~ /^(.)(.)(.)\3\2\1/
      || $pass =~ /^(.)(.)(.)(.)\4\3\2\1/ ) {
	print <<"EOM";
Please don't use palindromic sequences of "$1$2$3$4".
EOM
	return 0;
    }

    # Some other login name?

    if ($isalogin{$pass}) {
	print "Please don't use somebody's login id.\n";
	return 0;
    }

    # A local host name?

    if (-f "/usr/hosts/$pass") {
	print "Please don't use a local host name.\n";
	return 0;
    }

    # Reversed login id?

    $reverse = reverse $me;
    if ($pass =~ /$reverse/i) {
	print <<"EOM";
Please don't use your login id spelled backwards.
EOM
	return 0;
    }

    # Previously used?

    foreach $old (keys(%opass)) {
	if (crypt($pass,$old) eq $old) {
	    $when = $opass{$old};
	    $diff = $now - $when;
	    ($osec,$omin,$ohour,$omday,$omon,$oyear)
		= localtime($when);
	    if ($oyear != $nyear) {
		$oyear += 1900;
		print "You had that password back in $oyear.";
	    }
	    elsif ($omon != $nmon) {
		$omon = (January, February, March, April, May,
		    June, July, August, September, October,
		    November, December)[$omon];
		print "You had that password back in $omon.";
	    }
	    elsif ($omday != $nmday) {
		$omday .= (0,'st','nd','rd')[$omday%10]||'th';
		print "You had that password on the $omday.";
	    }
	    else {
		print "You had that password earlier today.";
	    }
	    print "  Please pick another.\n";
	    return 0;
	}
    }
    1;
}

sub CLEANUP {
    system 'stty', 'echo';
    print "\n\nAborted.\n";
    exit 1;
}

sub myexit {
    system 'stty', 'echo';
    exit shift(@_);
}