home *** CD-ROM | disk | FTP | other *** search
- #!/usr/bin/perl
-
- # Customizable items.
-
- $AGEWEEKS = 8;
- $EXPWEEKS = 12;
- $BADPATS = '/usr/etc/badpats';
- $BADWORDS = '/usr/etc/badwords';
-
- # 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:/usr/ucb';
- umask(022);
-
- chdir '/etc' || die "Can't find /etc.\n";
- die "passwd program isn't running setuid to root\n" if $>;
-
- @INC = $INC[$#INC - 1]; # Use only perl library.
- die "Perl library is writable by world!!!\n"
- if $< && -W $INC[0];
- die "look.pl is writable by world!!!\n"
- if $< && -W "$INC[0]/look.pl";
- require "look.pl";
-
- # Uncustomizable items.
-
- $| = 1; # command buffering on STDOUT
-
- @saltset = ('a' .. 'z', 'A' .. 'Z', '0' .. '9', '.', '/');
-
- chop($host = `hostname`);
-
- # Process the arguments.
-
- $relax = shift if $ARGV[0] =~ /^-r/;
- $relax = 0 if $<; # (superuser only)
-
- if ($ARGV[0] =~ /^-a(.*)/) {
- $AGE = $1;
- $AGE = $AGEWEEKS + 1 if $AGE <= 0;
- $AGE = $EXPWEEKS + 1 if $AGE > $EXPWEEKS;
- shift;
- }
-
- # Whose password are we changing, anyway?
-
- # (We use getlogin in preference to getpwuid($<)[0] in case
- # different accounts are sharing uids.)
-
- ($me) = @ARGV;
- die "You can't change the password for $me.\n" if $me && $<;
- $me = getlogin unless $me;
- $me = (getpwuid($<))[0] unless $me;
-
- # Trap these signals
-
- $SIG{'INT'} = 'CLEANUP';
- $SIG{'HUP'} = 'CLEANUP';
- $SIG{'QUIT'} = 'CLEANUP';
- $SIG{'PIPE'} = 'CLEANUP';
- $SIG{'ALRM'} = 'CLEANUP';
-
- # Check first before putting them through the wringer. (We'll
- # check again later.)
-
- die "/etc/passwd file busy--try again later.\n" if -f 'ptmp';
-
- # A check to see if they have an application form on file.
-
- open(FORMS,"forms") || die "Can't open /etc/forms";
- $informs = 0;
- while (<FORMS>) {
- chop;
- if ($_ eq $me) {
- $informs = 1;
- last;
- }
- }
- close(FORMS);
-
- die <<"EOM" unless $informs;
- No application on file for $me--contact system administration.
- EOM
-
- # Give them something to read so they don't get bored.
-
- print "\nChanging password for $me.\n";
-
- # Get passwd entry and remember all logins
-
- $login = '';
- open(PASSWD,"passwd") || die "Can't open /etc/passwd";
- while (<PASSWD>) {
- /^([^:]+)/;
- if ($1 eq $me) {
- ($login,$opasswd,$uid,$gid,$ogcos,$home,$shell)
- = split(/:/);
- die "You aren't you! ($< $uid $me $x $login)\n"
- if $< && $< != $uid; # Just being paranoid...
- $salt = substr($opasswd,0,2);
-
- # Canonicalize name.
-
- $ogcos =~ s/,.*//;
- $mynames = $ogcos;
- $mynames =~ s/\W+/ /;
- $mynames =~ s/^ //;
- $mynames =~ s/ $//;
- $mynames =~ s/ . / /g;
- $mynames =~ s/ . / /g;
- $mynames =~ s/^. //;
- $mynames =~ s/ .$//;
- $mynames =~ s/ /|/;
- $mynames = '^$' if $mynames eq '';
- }
- ++$isalogin{$1} if length($1) >= 6;
- }
- close(PASSWD);
- die "$me isn't in the passwd file.\n" unless $login;
-
- # Check for shadow password file.
-
- if ($opasswd eq 'x' && -f '/etc/shadow') {
- $shadowing = 1;
- open(SHADOW,"shadow") || die "Can't open /etc/shadow";
- while (<SHADOW>) {
- /^([^:]+)/;
- if ($1 eq $me) {
- ($login,$opasswd) = split(/:/);
- $salt = substr($opasswd,0,2);
- last;
- }
- }
- close(SHADOW);
- }
-
- # Fetch old passwords (the encrypted version).
-
- open(PASSHIST,"passhist");
- while (<PASSHIST>) {
- /^([^:]+)/;
- if ($1 eq $me) {
- ($login,$opass,$when) = split(/:/);
- $opass{$opass} = $when;
- }
- }
- close PASSHIST;
-
- # Build up a subroutine that does matching on bad passwords.
- # We'll use an eval to define the subroutine.
-
- $foo = 'sub badpats {local($_) = @_;study;';
- open(BADPATS,$BADPATS);
- while (<BADPATS>) {
- ($badpat,$maybe) = split(/[\n\t]+/);
- ($response = $maybe) =~ s/'/\\'/ if $maybe;
- $foo .= "return '$response' if /$badpat/;\n";
- }
- close BADPATS;
- $foo .= 'return 0;}';
- eval $foo; # Note: this defines sub badpats
-
- # Finally we can begin.
-
- system 'stty', '-echo';
-
- if ($<) {
- print "Old password: ";
- chop($pass0 = <STDIN>);
- print "\n";
-
- # Note: we shouldn't use die while echo is off.
-
- do myexit(1) unless $pass0;
- if (crypt($pass0,$salt) ne $opasswd) {
- print "Sorry.\n";
- do myexit(1);
- }
- }
-
- # Pick a password
-
- for (;;) {
- $goodenough = 0;
- until ($goodenough) {
- print "New password: ";
- chop($pass1 = <STDIN>);
- print "\n";
- do myexit(1) unless $pass1;
- print "(Checking for lousy passwords...)\n";
- $goodenough = &goodenough($pass1);
-
- # If longer than 8 chars, check first 8 chars alone.
-
- if ($goodenough && length($pass1) > 8) {
- $pass8 = substr($pass1,0,8);
- print "(Rechecking first 8 characters...)\n";
- unless ($goodenough = &goodenough($pass8)) {
- print <<'EOM';
- (Note that only the first 8 characters count.)
- EOM
- }
- }
- };
-
- print "Retype new passwd: ";
- chop($pass2 = <STDIN>);
- print "\n";
- last if ($pass1 eq $pass2);
- print "Password mismatch--try again.\n";
- }
-
- system 'stty', 'echo';
-
- # Now check again for a lock on the passwd file.
-
- if (-f 'ptmp') {
- print "Password file busy--waiting up to 60 seconds...\n";
- for ($i = 60; $i > 0; --$i) {
- sleep(1);
- print $i,'...';
- last unless -f 'ptmp';
- }
- }
- die "\n/etc/passwd file busy--try again later.\n" if -f 'ptmp';
-
- # Create the lock using link() for atomicity
-
- open(PTMP,">ptmptmp$$")
- || die "Can't create tmp passwd file.\n";
- close PTMP;
- $locked = link("ptmptmp$$",'ptmp');
- unlink "ptmptmp$$";
- $locked || die "/etc/passwd file busy--try again later.\n"
-
- open(PASSWD,"passwd") || die "Can't open passwd file.\n";
- open(PTMP,">ptmp") || die "Can't copy passwd file.\n";
-
- # Encrypt using salt that's fairly random but encodes weeks
- # since 1970, mod 64.
-
- # (We perturb the week using the first two chars of $me so
- # that if everyone changes their password the same week we
- # still get more than 64 possible salts.)
-
- $now = time;
- ($pert1, $pert2) = unpack("C2", $me);
- $week = $now / (60*60*24*7) + $pert1 + $pert2 - $AGE;
- $nsalt = $saltset[$week % 64] . $saltset[$now % 64];
- $cryptpass = crypt($pass1,$nsalt);
-
- # Now build new passwd file
-
- while (<PASSWD>) {
- chop;
- ($login,$passwd,$uid,$gid,$gcos,$home,$shell) = split(/:/);
- next if $login eq ''; # remove garbage entries
-
- # Disable open accounts. Login ids beginning with + are
- # NIS (aka YP) indirections and aren't a problem.
-
- $passwd = '*' if $passwd eq '' && $login !~ /^\+/;
-
- # Is this the line to change?
-
- if ($login eq $me) {
- if ($shadowing) {
- $passwd = 'x';
- }
- else {
- $passwd = $cryptpass;
- }
-
- # The following code implements a password aging scheme
- # by substituting a different shell for aged or expired
- # accounts. Ordinarily this is done by another script
- # running in the middle of the night. Unless someone
- # typed "passwd -a", this script always makes a new
- # password and unexpires the account.
-
- if ($shell =~ /(exp|age)\.(.*)/) {
- $shell = "/bin/$2";
- }
- if ($AGE >= $EXPWEEKS) {
- if ($shell =~ m|/bin/(.*)|) {
- $sh = $1;
- $sh = 'csh' if $sh eq '';
- $shell = "/usr/etc/exp.$sh";
- }
- }
- elsif ($AGE >= $AGEWEEKS) {
- if ($shell =~ m|/bin/(.*)|) {
- $sh = $1;
- $sh = 'csh' if $sh eq '';
- $shell = "/usr/etc/age.$sh";
- }
- }
- }
- print PTMP "$login:$passwd:$uid:$gid:$gcos:$home:$shell\n"
- || do { unlink 'ptmp'; die "Can't write ptmp: $!"; };
- }
- close PASSWD;
- close PTMP;
-
- # Sanity checks.
-
- ($dev,$ino,$omode,$nlink,$uid,$gid,$rdev,$osize)
- = stat('passwd');
- ($dev,$ino,$nmode,$nlink,$uid,$gid,$rdev,$nsize)
- = stat('ptmp');
- if ($nsize < $osize - 20 || $uid) {
- unlink 'ptmp';
- die "Can't write new passwd file! ($uid)\n";
- }
- chmod 0644, 'ptmp';
-
- # Do shadow password file while we still have ptmp lock.
-
- if ($shadowing) {
- open(SHADOW,"shadow") || die "Can't open shadow file.\n";
- umask 077;
- open(STMP,">stmp") || die "Can't copy shadow file.\n";
-
- # Now build new shadow file.
-
- while (<SHADOW>) {
- chop;
- @fields = split(/:/);
- if ($fields[0] eq $me) {
- $fields[1] = $cryptpass;
- }
- print STMP join(':',@fields), "\n";
- }
- close SHADOW;
- close STMP;
- chmod 0600, 'shadow'; # probably unnecessary
- rename('shadow','shadow.old');
- chmod 0600, 'stmp';
- rename('stmp','shadow');
- }
-
- # Release lock by renaming ptmp.
-
- rename('passwd','passwd.old');
- rename('ptmp','passwd')
- || die "Couldn't install new passwd file: $!\n";
-
- # Now remember the old password forever (in encrypted form).
-
- $now = time;
- open(PASSHIST,">>passhist") || exit 1;
- print PASSHIST "$me:$opasswd:$now\n";
- close PASSHIST;
- exit 0;
-
- ###############################################################
- # #
- # This subroutine is the whole reason for this program. It #
- # checks for many different kinds of bad password. We don't #
- # tell people what kind of pattern they MUST have, because #
- # that would reduce the search space unnecessarily. #
- # #
- # goodenough() returns 1 if password passes muster, else 0. #
- # #
- ###############################################################
-
- sub goodenough {
- return 1 if $relax; # Only root can bypass this.
- $pass = shift(@_);
- $mono = $pass !~ /^.+([A-Z].*[a-z]|[a-z].*[A-Z])/;
- $mono = 0 if $pass =~ /[^a-zA-Z0-9 ]/;
-
- $now = time;
- ($nsec,$nmin,$nhour,$nmday,$nmon,$nyear) = localtime($now);
-
- # Embedded null can spoof crypt routine.
-
- if ($pass =~ /\0/) {
- print <<"EOM";
- Please don't use the null character in your password.
- EOM
- return 0;
- }
-
- # 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(@_);
- }
-