*BSD News Article 12635


Return to BSD News archive

Path: sserve!newshost.anu.edu.au!munnari.oz.au!news.Hawaii.Edu!ames!sun-barr!cs.utexas.edu!geraldo.cc.utexas.edu!geraldo.cc.utexas.edu!usenet
From: vax@ccwf.cc.utexas.edu (Vax)
Newsgroups: comp.os.386bsd.apps
Subject: passwd replacement program (long)
Date: 12 Mar 1993 09:55:50 GMT
Organization: The University of Texas at Austin, Austin TX
Lines: 990
Message-ID: <1npmn6INNe6m@geraldo.cc.utexas.edu>
NNTP-Posting-Host: sylvester.cc.utexas.edu

Recompile perl with crypt (if you use it), and manually compile any
problem files by hand:
(I can compile these in 8MB if I kill some processes first)
cc -c -DTAINT teval.c
cc -c -DTAINT tutil.c
Don't quote me on that, try making perl first, see what it does.
alpga.gnu.ai.mit.edu has the perl-4.036 or whatever is relatively new,
I use it.  Thanks mycroft.

NOTE: This program was almost completely ripped from Larry Wall and
the Perl nutshell book.  I take no credit for the minor modifications I
have made, most of which don't work.  I know flock doesn't work, so fix
it first if you want to use it.  Oh yeah, use whatever technique
you need to to make it suid root, I haven't figured out how to yet.
I made taintperl SUID root, I'm not sure if you are supposed to or not.
Marking the script SUID doesn't seem to do anything.  I may be wrong.
NOTE: I do not claim to have good programming style.  And I put my
programs in funny places, like /usr/foreign/{bin,lib,src}.

----8<----cutting here would be bad for your monitor----8<---------

#!/usr/bin/perl

#                         ****  ATTENTION  ****
#
# MAKE A BACKUP COPY OF YOUR PASSWORD FILES BEFORE USING THIS PROGRAM.
# IF YOU DO NOT KNOW WHICH FILES THESE ARE, BACK UP YOUR WHOLE SYSTEM.
# THE AUTHOR DOES NOT CLAIM THAT THIS WILL WORK ON ANY SYSTEM, NOR FOR ANY
# PARTICULAR PURPOSE OR SITUATION.
# THE AUTHOR DOES NOT TAKE RESPONSIBILITY FOR ANY DAMAGE CAUSED BY THE USE OF
# THIS PROGRAM, EITHER DIRECTLY OR INDIRECTLY.
# BUGS IN THIS PROGRAM CAN CAUSE MAJOR SECURITY HOLES.
# YOU HAVE BEEN WARNED.
#

# Customizable items.

$LIBDIR = '/usr/foreign/lib/passwd';
$AGEWEEKS = 8;
$EXPWEEKS = 12;
$BADPATS = "$LIBDIR/badpats";
$BADWORDS = "$LIBDIR/badwords";
$MPW_FILE='/etc/master.passwd';
$PW_FILE='/etc/passwd';
$SPW_FILE='';
# undefine (set to 0) if you don't want to use flock
$FLOCK = 0;
# Used as temporary write/lock file.
$PW_TMP = '/etc/passtmp';
# set to null string if you don't have forms
$FORMS = '';
# password history file, if used
$PASSHIST = '/var/log/passhist';
# set to one if you want to encourage sysadmins to set passwords first..
$NULL_PW_ABORT = 1;
# define this if you use encryption.
$DES = 1;
# make this one if you want passwd to sanity check (somewhat) your file.
$PEDANTIC = 0;
# use this is you must make a database outta the pw file
$DATA_BASE='/usr/sbin/pwd_mkdb';

# Don't modify this, but tell me if you think of a cleaner way to code it
if ($MPW_FILE)
{
$MAIN_PW_FILE = $MPW_FILE;
}
else
{
$MAIN_PW_FILE = $PW_FILE;
}

# Make a list of dictionaries to search with &look

@words = $BADWORDS;
if (-f '/usr/dict/web2') {
    push(@words,'/usr/dict/web2');
}
push(@words,'/usr/dict/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';
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";
require "fcntl.ph";

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

if ($FORMS)
{
  # A check to see if they have an application form on file.
  open(FORMS) || die "Can't open $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; this seems like the hard way to
# me, since passwd(1) uses getpwname, but so be it...

$login = '';
&open_pw_file;

while (<PASSWD>) {
    # match pattern for login name; any char up to first colon
    /^([^:]+)/;
    if ($1 eq $me) {
        if ($MPW_FILE) {
($login,$passwd,$uid,$gid,$class,$change,$expire,$gcos,$home,$shell) = split(/:/);
        }
        else
        {
          ($login,$passwd,$uid,$gif,$gcos,$home,$shell) = split (/:/);
        }
  $ogcos = $gcos;
  $opasswd = $passwd;
	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' && $SPW_FILE && -f $SPW_FILE) {
    $shadowing = 1;
    open(SHADOW,$SPW_FILE) || die "Can't open $SPW_FILE";
    while (<SHADOW>) {
	/^([^:]+)/;
	if ($1 eq $me) {
	    ($login,$opasswd) = split(/:/);
	    $salt = substr($opasswd,0,2);
	    last;
	}
    }
    close(SHADOW);
}

if ($PASSHIST)
{
  # Fetch old passwords (the encrypted version).
  open(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

die "You cannot change a null password, mail root.\n" if ($NULL_PW_ABORT && ! $opasswd);

# 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 ($DES) {
      if (crypt($pass0,$salt) ne $opasswd) {
	print "Sorry.\n";
	do myexit(1);
      }
    }
    else 
    {
      if ($pass0 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 password: ";
    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.

&open_pw_file;

&pw_lock;

if ($DES) {
  # 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);
}
else
{
  $cryptpass = $pass1;
}

# Now build new passwd file

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

    if ($PEDANTIC) {
      # 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;
      }

      if ($AGING) {
      	# 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";
      	  }
      	}
      }
    }
    if ($MPW_FILE) 
    {
$_ = join(':',$login,$passwd,$uid,$gid,$class,$change,$expire,$gcos,$home,$shell);
    }
    else
    {
      $_ = join(':',$login,$passwd,$uid,$gif,$gcos,$home,$shell);
    }
    print "$_\n";
    print PTMP "$_\n" || do { unlink $PW_TMP; die "Can't write to passwd copy: $!"; };
}
close PASSWD;
close PTMP;

# Sanity checks.

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

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

if ($shadowing) {
    open(SHADOW,$SPW_FILE) || die "Can't open shadow file.\n";
    umask 077;
    open(STMP,'>' . $SPW_TMP) || 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, $SPW_FILE;       # probably unnecessary
    rename($SPW_FILE,$SPW_FILE . '.old');
    chmod 0600, $SPW_TMP;
    rename($SPW_TMP,$SPW_FILE);
}

# rebuild the password database
if ($DATA_BASE && -x $DATA_BASE)
{
if (0)
{
  FORK:{
    if ($pid = fork)
    {
      $pid = waitpid($pid,0);
      die "Fatal Error: no child processes $!" if ($pid = -1);
    }
    elsif (defined $pid)
    {
      exec '/usr/sbin/pwd_mkdb -p /etc/passtmp';
      die "Fatal Error: exec returned $!";
    }
    elsif ($! =~ /No more process/)
    {
      sleep 5;
      redo FORK;
    }
    else
    {
      die "Can't fork: $!\n";
    }
  }
}
else
{
  system "$DATA_BASE -p $PW_TMP" || die "Couldn't run $DATA_BASE ";
  unlink $PW_TMP;
}
}
else
{
  rename($MAIN_PW_FILE,$MAIN_PW_FILE . '.old');
  rename($PW_TMP,$MAIN_PW_FILE) || 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;
    }

    # 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(@_);
}

sub pw_lock
{
# requires that a PASSWD fd is open
  if ($FLOCK)
  {
    flock(PASSWD,$LOCK_EX|$LOCK_NB) || die "Password file busy--try again later.\n";
    die "Error - $PW_TMP file exists (should not happen)" if (-f $PW_TMP);
    open(PTMP,'>' . $PW_TMP) || die "Can't create passwd copy file.\n";
  }
  else
  {
  if (-f $PW_TMP) {
    print "Password file busy--waiting up to 60 seconds...\n";
    for ($i = 60; $i > 0; --$i) {
      sleep(1);
      print $i,'...';
      last unless -f $PW_TMP;
    }
  }
  die "\nPassword file busy--try again later.\n" if -f $PW_TMP;

  # Create the lock using link() for atomicity

  $REALLY_TEMP="ptmptmp$$";
  open(PTMP,'>' . $REALLY_TEMP) || die "Can't create tmp passwd file.\n";
  close PTMP;
  $locked = link($REALLY_TEMP,$PW_TMP);
  print "linking to file $REALLY_TEMP from $PW_TMP\n";
  unlink $REALLY_TEMP;
  $locked || die "Password file busy--try again later.\n";
  open(PTMP,'>' . $PW_TMP ) || die "Can't open copy of passwd file.\n";
  }
  1;
}

sub getpass
{
  system 'stty', '-echo';
  chop($_ = <STDIN>);
  system 'stty', 'echo';
  return $_;
}

sub open_pw_file
{
if ($MPW_FILE)
{
  open(PASSWD,"$MPW_FILE") || die "Can't open $MPW_FILE";
}
else
{
  open(PASSWD,"<$PW_FILE") || die "Can't open $PW_FILE";
}
}
-- 
Protect our endangered bandwidth - reply by email.  NO BIG SIGS!
VaX#n8 vax@ccwf.cc.utexas.edu - finger for more info if you even care.