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.