#/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 () { # 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 () { /^([^:]+)/; 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 () { /^([^:]+)/; 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 () { /^([^:]+)/; 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 () { ($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 = ); 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 = ); 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 = ); 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 () { 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 () { 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 () { ($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 () { 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); $_ = ; 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(@_); }