#!/usr/local/bin/perl
#
# ANL passwd program 
#
$Version = "Version 2.2";
#
# Last modified: 9/12/93
#
##################################################
#  Notice:  This is basically the same code as in the perl nutshell book.
#  The main changes are that it now does the right thing when called 
#  (It figures out if yp makes sense or if local password changes are
#  what should be done. )  It also makes a call that searches all the 
#  bad clear text passwords with a binary search.
#
#  We striped out password aging.  (If you have a good password...)
#  We also stripped out the forms, as we don't have that in place.
#
#  --Mark Henderson, Gene Rackow, Bill Nickless, Bob Olson, Andrew Cherry
##################################################

#################################################
#         BUG FIXES AND IMPROVEMENTS
#  Many of these fixes are from part of a group effort as people found bugs
#  and/or new features were discussed and implemented.
#
#  Fixed bug for accounts that started off with no password.
#  Two locations, where entered, and beginning of checks for same passwd
#  						--Mark Henderson 8-26-92
#
#  Add the usage statement 			--Mark Henderson 8-26-92
#  
#  Add the option parser for various arguments  --Mark Henderson 8-26-92
#
#  Added the ability for a user to be able to change their shell
#  ( I don't know how I can check to see if it's a valid shell 
#  across various machines.  So what is supported you'll find 
#  in legal_shells)				--Mark Henderson 8-26-92
#
#  Added the ability to change the gecos information.
#  Could use additional checks so that phone numbers are really 
#  numbers.  Changes are logged to "$accounts" to deter silly names
#						--Mark Henderson 9-1-92
#
#  Added /usr/local/bin/tcsh and /usr/local/bin/zsh to valid shells
#  Added check to ensure that a shell change was actually being made
#  because the rpc call bombs with ugly error messages if no change is made.
#  passwd file on non-yp machines.
#						--Kass Schmitt 3-24-93
#
#  Added list of dictionaries to be used in testing acceptability of
#  passwords.  Concatenations of two words no longer pass. 
#						--Kass Schmitt 3-26-93
#
#  Fixed problem with ypmatch producing an error if the user
#  has no yppasswd entry, even if the user called the program
#  as "passwd". 
#						--Andrew Cherry 6-14-93
#
#  Made various changes to (hopefully) make the program easier to set
#  up in environments other than our own. :)
#						--Andrew Cherry 7-13-93
#
#  Added checks to ensure there are no matches between the cleartext
#  password and the gcos field. Now checks to make sure the new
#  password is not already in the gcos field, and checks to
#  make sure no part of a new gcos field contains the current
#  password.
#						--Andrew Cherry 7-14-93
#
#
#  Now searches the user's .plan and .project files (if they exist)
#  for the cleartext of the new password.
#					        --Andrew Cherry 7-14-93
#
# Returned the code from the Camel book on "badpats".  Not quite exact
# as in the Camel book, it translated the pass to all lower before
# checking badpats.  I prefer allowing badpats to be case sensitive. 
# (Cuts megadict size by 2/3rds with 6 patterns.)
# Corrected some pattern matching problems when a * was part of the
# new password.
#						--Gene Rackow 9-12-93
#
# Added a eof check in the binary search.  This bug was found
# by Dave Somogyi x5133 <SYS_SOMOGYI@SSCVX1.SSC.GOV>
# Many thanks.
#                                                --Gene 9-15-93
#################################################

#############
# Configs

$debug = 1;			# 1 is on 0 is off

$passwd = "passwd"; 
$yppasswd = "yppasswd";

$accounts = "accounts@mcs.anl.gov";             # Person who handles accounts

# Legal shells; This is a list of valid login shells
# If you add any new valid shells, this variable should
# be updated. The shells listed here _must_ exist on
# all machines on your network that use YP; otherwise,
# a user may not be able to log in to all of the machines.

@legal_shells = ( '/usr/local/bin/tcsh', '/usr/local/bin/zsh', '/bin/csh', '/bin/sh' );

# Below used for the prompter
$shell_prompt = join(' ', @legal_shells);


# Requirements

# Places to look for Perl include files; please change this to
# reflect where you have put "im_prompt2.pl" and "encrypt_passwd"
#
unshift(@INC, "/mcs/adm/lib/perl");
unshift(@INC, "/mcs/lib/perl");

require "encrypt_passwd";
require "im_prompt2.pl"; # prompting stuff
require "open2.pl"; 
require 'newgetopt.pl';  # to get the options

# Customizable items.
# Change these to reflect your local environment
#
$dictdir = "/mcs/adm/DICTIONARY";	# location of dictionaries
$bigdict = "$dictdir/mongodict.sorted"; # large list of words
$ypstuffdir = "/usr/local/adm/bin"; # location of ypstuff executable
$BADPATS = "$dictdir/badpats";       #location of added bad patterns

# edit the following to reflect the dictionaries you want to use
#@dictlist = ('abbr','biology','cartoon','etc-hosts','chinese','famous','female-names','german','male-names','movies','myths-legends','numbers','phrases','places','proper_names','reallyuniqwords','sf','shakespeare','sports','surname','tolkien','trek.words','web2','words','yiddish','words.slang');
# take all of the above and sort/uniq them into mongodict.base
# this yeilds a fix for some machines that do not allow yu to open many files.
@dictlist = ('mongodict.base');

# End configs
###############

foreach $dictname (@dictlist){
if (-f "$dictdir/$dictname") {
	push(@words,"$dictdir/$dictname");
	}
}
$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:/usr/bsd';
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

# I don't know if I can get away with this
# guess so, as they already have a salt
# @saltset = ('a' .. 'z', 'A' .. 'Z', '0' .. '9', '.', '/');

chop($host = `hostname`);

########################## ac #1 start
# Get the name of the command the user typed in to call this
# program (either "passwd" or "yppasswd") and chop off the
# path.
($program = $0) =~ s/.*\/(\w*)/\1/;
########################## ac #1 end

# So that messages speak truth about what is being changed.  --mwh
$what = "password";

# Define the usage statement  --mwh 8-26-92
$usage = "Usage: $0 [-f] [-s] [-a] [-r] [name]\n";
$usage .= "\t-f change the gecos information field.\n";
$usage .= "\t-s change the login shell.\n";
$usage .= "\t-a change without resetting password aging.  Unsupported.\n";
$usage .= "\t-r forgo the good password checks.  Root only.\n";
$usage .= "\n$Version\n";

# Get the options --mwh 8-26-92
if ( &NGetOpt( "f", "s", "a", "r") == 0 ) {
    die "$usage";
}

# Only one option is permitted at a time, so...
$total_opts = $opt_f + $opt_s + $opt_a + $opt_r; # total number of options
if ( $total_opts > 1 ) {
    die "Use only one of -f, -s, -a, -r, at a time.\n$usage\n";
}

# relax the password "goodness" checks?
$relax = 0;
if ( $opt_r ) {
    if ( $< != 0 ) {
	die "\nThe -r (relax) option is for root only.\n$usage";
    }
    $relax = $opt_r;
    print "\nWarning: Not checking if new password is \"good\"!\n.";
}

# changing shells
if ( $opt_s ) {
    $what = "shell";
}

# password aging
if ( $opt_a ) {
    die "\nThe aging option is not supported.\n$usage"
}

# Change the gecos field
if ( $opt_f ) {
    $what = "gcos";
}

# 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';


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

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

# Get passwd entry and remember all logins


############################# ac #3 start
# Changed this to deal with YP. It first looks in the YP
# database. If the entry exists, it uses that. Otherwise, it
#      1. Warns the user if the program was called as
#         "yppasswd" despite the fact that there is no
#         entry in the YP database.
#      2. Gets its info from the local password file
#
# Code to look for entry in local passwd file and yppasswd file
# has been moved to subroutines getpasswd and getyp, respectively.

$login = '';
$fromyp = 0;                    # Flag is nonzero if using YP
                                # initialize to 0, change if YP

# Case 1: Program is called as yppasswd
if ($program eq $yppasswd) {
    ($login,$opasswd,$uid,$gid,$ogcos,$home,$shell) =  &getyp($me);
	
    if ($login) {
	# Case 1.1: yp entry exists
	print "Changing $what entry for $me on yp server\n";
	if (&getpasswd($me)) {
	    warn "Note that you also have a local password entry.\n";
	    warn "To change your $what on $host, use passwd\n";
	}
	$fromyp = 1;
    }
    else {
	($login,$opasswd,$uid,$gid,$ogcos,$home,$shell) = &getpasswd($me);
	die "$me is not in any passwd file!\n" unless $login;
	# case 1.2: passwd entry exists
	warn "Warning: no entry for $me in YP database\n";
        warn "Changing $what entry on local host $host\n";
        warn "In the future, use passwd to change your $what,\n";
	warn "on the local machine, not yppasswd.\n\n";
	$fromyp = 0;
    }
}
# Case 2: Program called as passwd
#
elsif ($program eq $passwd) {
    ($login,$opasswd,$uid,$gid,$ogcos,$home,$shell) = &getpasswd($me);
    if ($login) {
	# Case 2.1: local entry exists
	print "Changing $what entry for $me on local host $host\n";
	($yplogin,$ypopasswd,$ypuid,$ypgid,$ypogcos,$yphome,$ypshell) =  &getyp($me);
	if ($ypuid ne "") {
	    warn "Note that you also have an entry in the yp database\n";
	    warn "To change your YP $what, use yppasswd.\n";
	}
	$fromyp = 0;
    }
    else {
	($login,$opasswd,$uid,$gid,$ogcos,$home,$shell) = &getyp($me);
	die "$me is not in any passwd file!\n" unless $login;
	# Case 2.2: yp entry exists
	print "Changing $what entry for $me on yp server\n";
	$fromyp = 1;
    }
}
# Case 3: Program is called as who knows what
else {
    die "Program is not configured to be called as $program! Help!\n";
}

# get rid of <cr> wherever it was acquired
chop( $shell );

# Check for shadow password file
# if using the local passwd file.
unless ($fromyp) {
    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);
    }
}

# The password history stuff was removed from this location 

# *** This is the stuff that used to be in the Perl passwd
#     reading routine
#
die "You aren't you! ($< $uid $me $x $login)\n"
    if $< && $< != $uid;      # Just being paranoid...
$salt = substr($opasswd,0,2);
# 
###### # added to save the original gcos
$gcos = $ogcos;
###### #
# 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 '';

#################################### ac #3 end

# 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.

# There appeared to be a "bug" here.  If you have an account that
# doesn't have a password, and you want to put one on it, you can't
# with the current code.  I'm changing the behavior to do the
# following at the "Old password: " prompt:
# 	If you have a password, and you only enter <CR>, it exits
#       If you do have a password, and you get it wrong, it says
#               "sorry" and exits.
# 	If you don't have a password, and you only enter <CR> it
#		takes it and continues.
#   --Mark Henderson 8-26-92


system 'stty', '-echo';

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

   if (length($pass0) > 8) {
            $passa = $pass0;
            $pass0 = substr($passa,0,8);
   }

    # Note: we shouldn't use die while echo is off.
    # Now it deals with "no password" accounts
    # do myexit(1) unless $pass0;

    if ( ! $pass0 ) {
	&myexit(1) if $opasswd;
    }

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

system 'stty', 'echo';

# This will get changed if in fact we are changing the password
$cryptpass = $opasswd;

# OK, now we believe they know who they are, what are we doing?
if ( $opt_s ) {
    &shell_game;
}

if ( $opt_f ) {
    &gecos_update;
}

if ( ! $opt_s && ! $opt_f ) {
    &get_new_pw;
    $cryptpass = &encrypt_passwd($login,$pass1);
}


######---Start major mods by gene

####### #
## $login   the login name
## $pass0   the original passwd
## $pass1   the new passwd to be encrypted and installed
## $uid     the old user id
## $gid     the group id
## $gcos    the gcos stuff to be installed
## $home    the home file system
## $shell   the shell the gets installed
######## # 
####### # Moved this section to above passwd file locking --Gene

######## #  Added to do the YP putback --Gene
if ( $fromyp ) {
    @pw = ("$login","$cryptpass","$uid","$gid","","",$gcos,"$home","$shell");

    chop($host = `ypwhich -m passwd`);

    if ( ! &open2(READ, WRITE, "$ypstuffdir/ypstuff $host"))
    {
        die "Open2 failed\n";
    }
    print "Opening $ypstuffdir/ypstuff $host\n" if $debug;    
    print "$pass0\n" if $debug;
    print WRITE "$pass0\n";

    print WRITE join("\n", @pw, "");
    print join("\n", @pw, "") if $debug;

    close(WRITE);
    
    $repl = <READ>;
    
    close(READ);
    
    if ($repl =~ /^SUCCESS\s*$/)
    {
        print "Success\n";
        die "\n Password entry updated on server.\n\n";
    }
    elsif ($repl =~ /^ERROR:\s+(.*)\s*$/)
    {
        die "\nPassword update on server not possible at this time. Failure: $1\nTry again later.\n";
    }
    else
    {
        print "Unknown reply <$repl>\n";
        die "\nPassword update on server failed. Failure: unknown\nTry again later.\n";
    }

}
######## #  End of - Added to do the YP putback --Gene

######## #  Here's where we modify the local password files... --Gene

# Now check for a lock on the passwd file.

if (-f 'ptmp') {
    print "Password file busy--waiting up to 2 minutes...\n";
    for ($i = 120; $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 ptmptmp$$  file.\n";
close PTMP;
$locked = link("ptmptmp$$",'ptmp');
unlink "ptmptmp$$";
#added trailing semi --Gene
$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";

# 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 ($opt_f){
	    $gcos = $new_gcos; #replace gcos with new info
	} elsif ($opt_s){
	    $shell = $new_shell; #change to new shell
	} elsif ($shadowing) {
	    $passwd = 'x';
	}
	else {
	    $passwd = $cryptpass;
	}

###### # Deleted the password aging stuff --Gene
    }
    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;
	    $fields[2] = int(time / 86400);
	}
	print STMP join(':',@fields), "\n";
    }
    close SHADOW;
    close STMP;
    chmod 0600, 'shadow';       # probably unnecessary
    rename('shadow','shadow.old');
    chmod 0600, 'stmp';
    rename('stmp','shadow');
}

####### # Added to build hash tables on 4.3 style machines --gene

# Release lock by renaming ptmp.
if (-f '/etc/mkpasswd') {
    `/etc/mkpasswd /etc/ptmp`;
    rename('passwd.dir','passwd.dir.old');
    rename('ptmp.dir','passwd.dir');
    rename('passwd.pag','passwd.pag.old');
    rename('ptmp.pag','passwd.pag');
}
####### # Added to build hash tables on 4.3 sytle machines --gene

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

exit 0;

######---End major mods by gene

###############################################################
#                                                             #
# 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 "Please don't use the null character in your password.\n";
	return 0;
    }

    if ($pass =~ /:/) {
	print "Please don't use the colon character in your password.  Some vendors have\n";
	print "a problem in changing passwds to something new when the old has a colon.\n";
	return 0;
    }

    # Do a little checking on the passwd for regex characters like * --Gene
    $tstring = $pass;
    $tstring =~ s/[\\()*.|\$^+\[\]]/\\$&/g;
    $tstring =~ s/[\\()?.|\$^+\[\]]/\\$&/g;
    print "$tstring is the new string comprared to $pass\n" if $debug;

    # Same password they just had?
    # This needs modified also to handle accounts that started with 
    # no password.   Without a salt from opasswd, crypt returns null, 
    # so don't test.   --Mark Henderson 8-26-92
    #     if (crypt($pass,$salt) eq $opasswd) {

    if ((crypt($pass,$salt) eq $opasswd) && ($opasswd)) {
	print "Please use a different password than you just had.\n";
	return 0;
    }
    
    # Password is a part of the gecos field?
    if( $gcos =~ /$tstring/i ) {
	print "Please don't use a part of your gcos entry.\n";
	return 0;
    }
	    
    # Password in .plan file?

    if(&checkfile("$home/.plan", $tstring)) {
         print "Please don't use a part of your .plan file!\n";
        return 0;
    }

    # Password in .project file?

    if(&checkfile("$home/.project", $tstring)) {    
	print "Please don't use a part of your .project file!\n";
       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 "That's too close to your old password.  Please try again.\n";
	    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;

     # run it through the pattern matcher..
       $foo = $pass;
       if ($response = do badpats($foo)) {
            print $response, "  Please try again.\n";
            return 0;
        }

    # Is it in one of the dictionaries?

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

	# 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 "Don't you use HER name that way!\n";
			}
			else {
			    print "That name is$also too popular.  Please try again.\n";
			    $also = ' also';
			}
		    }
		    else {
			print "Please avoid words in the dictionary$even.\n";
		    }
		    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 "One char $pre plus a word like $_ is too easy to guess.\n";
			    return 0;
			}

			print "Please avoid two-word combinations like $pre and $_. \n Suggestion: insert a random character in one of the words,\n or misspell one of them. \n";
			return 0;
		    }
		    elsif (length($key) == 1
		      && $pass =~ /^.[a-z]+.$/) {
			chop($pre = $cpass);
			$key = sprintf("^%c", ord($key)^64)
			    unless $key =~ /[ -~]/;
			print "A word like $pre plus one char $key is too easy to guess.\n";
			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 "Please don't use a Social Security Number!\n";
	    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;
	}
    }

# minor cleanup to get matched parens --gene
    if ($mo = ($pass =~ /^[ \d]*([a-zA-Z]{3,5})[ \d]*$/) &&
	($mo =~ /^(jan|feb|mar(ch)?|apr(il)?|may|june?|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 "Please don't use repeated sequences of $1.\n";
	return 0;
    }

    # Reversed patterns: abccba abcddcba

    if ( $pass =~ /^(.)(.)(.)\3\2\1/
      || $pass =~ /^(.)(.)(.)(.)\4\3\2\1/ ) {
	print "Please don't use palindromic sequences of $1$2$3$4.\n";
	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 "Please don't use your login id spelled backwards.\n";
	return 0;
    }

# Do the big crack file check
		if ( &bin_search($pass) ) { # Did we find in binary search?
		    return 0;
		}

    1;
}

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

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



# Bill's lookup routine starts here

########################### Beginning of script contribution - WKN 920810
# Look up a 8-character string in a big sorted list of words.  If it's there
# say so.

sub bin_search {
    local($candidate) = @_ ;	# The users password choice
    $string=unpack("a8",$candidate); 

    open(DICT,"<$bigdict") || die "Can't open $bigdict: $!\n";
    $top=(-s $bigdict);
    $btm=0;
    
    do {
	$ptr=($top+$btm)/2;
	seek(DICT,$ptr,0);     

	$_=<DICT>;
	$_=<DICT>; chop;	# Get the first full entry 

	printf "Checking out $_\n" if $debug;

	if ($_ gt $string) {
		$top=$ptr;
	} else {
		$btm=$ptr;
	}
    } until (($top-$btm) < 64);

    $btm-=20;

    if ($btm < 0) { $btm=0; }
    seek(DICT,$btm,0);
    $_=<DICT>;
    
    do {
	$_=<DICT>; chop;
	printf "Searching thru $_\n" if $debug;
	if ($_ eq $string) {
	    printf "We have a match!  Bad password.\n" if $debug;
		close(DICT);
		return 1;	# Meaning that the password was found
	}
	
    } while ($_ le $string  && !eof(DICT));
    close(DICT);
    return 0;			# Meaning that the password was not found
}
########################### End of script contribution wkn 920810
1;


# getyp($user): Accepts a text string (the username) as its argument.
#               Searches the yp database for this name.
#               Returns a list of all the fields of the passwd entry,
#               or null if the entry does not exist.
sub getyp {
	print "Inside getyp.\n" if $debug;
	local($user) = @_;
	print "Getting the user entry for $user.\n";
	if ( -f "$ypstuffdir/ypstuff" ){
	    $match = `ypcat passwd | grep ${user}:`;
	    @ypentry = split(/:/, `ypmatch $user passwd`) if($match);
	}
	print "The returned entry is @ypentry.\n" if $debug;
    return @ypentry;
}
1;

# getpasswd($usernam): Accepts a text string (the username) as its argument.
#                   Searches the local passwd file for this name.
#                   Returns a list of all the fields of the passwd entry,
#                   or null if the entry does not exist.
sub getpasswd {
    local($usernam) = @_;
    open(PASSWD,"passwd") || die "Can't open /etc/passwd";
    while ($line = <PASSWD>) {
	$line =~ /^([^:]+)/;
        if ($1 eq $usernam) {
	    @entry = split(/:/, $line);
        }
        ++$isalogin{$1} if length($1) >= 6; # 
    }
    close(PASSWD);
    return @entry;
}
1;


###########################
#  This part of the code was moved so that it was easier to understand
#  the flow after adding the -f and -s oprions.  --Mark Henderson
#############

sub get_new_pw {

system 'stty', '-echo';
# 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 ($goodenough eq 0) {
                print "Password is not acceptable, try again!\n";
        }

	# 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 "(Note that only the first 8 characters count.)\n";
	    }
	}
    };

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

system 'stty', 'echo';
}
1;

sub shell_game {
    # we have the original shell in $shell
    # offer the options ( This takes care of what is legal )
    $result = &im_prompt2("c", "Which shell would you like?", $shell_prompt,
                         $shell, @legal_shells);

    if($shell eq $result){
	print "\nLeaving shell unchanged.\n\n";
	exit(0);
    }

    $shell = $result; #leave here so debugging statement doesn't lie - KMS
    $new_shell = $result; #so that it really changes in non-yp passwd file -KMS
}
1;

sub gecos_update {
    local($name, $where, $office, $home);
    local($ngcos, $nname, $nwhere, $noffice, $nhome, $ok);
    # we have the gcos field from $gcos
    print "Current gcos is: $gcos\n" if $debug;
    ($name, $where, $office, $home) = split (",", $gcos);
    $ok = "no";
    while ( $ok eq 'no' ) {
	print"NOTICE: To deter silly names, changes to gecos field are logged.\n\n";
	$nname = &im_prompt2("x", "Please enter name:", "", $name);
	$nwhere = &im_prompt2("x", "Please enter Affiliation:", "", $where);
	$noffice = &im_prompt2("x", "Please enter Office phone:", "", $office);
	$nhome = &im_prompt2("x", "Please enter Home phone:", "", $home);
	print "\nName: $nname\nLocation: $nwhere\n";
	print "Office phone: $noffice\nHome phone: $nhome\n";
	$ok = &im_prompt2("i", "\nAre these values ok?", "Yes/no",
			  "Yes", "yes","no" );

	# safety check for ":" and <CR>'s in the password file.
	$ngcos = join(",", $nname, $nwhere, $noffice, $nhome);
	if ( $ngcos =~ /:/ || $ngcos =~ /\n/ ) {
	    $ok = "no";
	    print "Invalid gcos entry!  \":\" and <CR> are not allowed.\n";
	}
	elsif ( $gcos =~ /$tstring/i ) {
	    $ok = "no";
	    print "\nInvalid gcos entry!\n";
	    print "Please don't put your password in your gcos entry!\n\n";
	}
    }
    $subject = "$0: $me changing gecos field\n";
    $subject .= "Old: $gcos\n";
    $subject .= "New: $ngcos\n";
    `/usr/ucb/Mail -s "$subject"  $accounts &`;
    $gcos = $ngcos; #so the debugging statement tells the truth -KMS
    $new_gcos = $ngcos; #so the new value gets written to passwd file -KMS
}
1;

##################################################################
# checkfile(file, string): Searches a file for any occurances
# of the string specified. Matches are done in a case-insensitive
# manner.
# If an occurance exists, returns 1; otherwise, returns 0

sub checkfile {
    local($file, $string) = @_;
    local($line);
    if ( -f $file ) {
	open (FILE, "$file");
	while ($line = <FILE>) {
	    return 1 if( $line =~ /$string/i );
	}
    }
    return 0;
}
