Chapter 8

System Administration Applications


CONTENTS

Although most of this book is dedicated to applying Perl to CGI-based applications, it is also important to take notice of Perl as a network administration language. Originally, Perl was designed as a language to assist system administrators to format various reports concerning the system and the associated network. With most of an administrator's job being essentially text processing, Perl is a natural for this purpose.

The routine tasks that face a system administrator include moving around among directories, manipulating files and their contents, and checking passwords. To demonstrate how Perl can accomplish these things for you, each of these facets will be noted.

The largest script by far in this chapter, and perhaps in this book, is the security script that checks for bad passwords. This script includes many parameters for testing bad passwords, and also demonstrates how Perl can be used to create long, involved scripts to solve more complex, in-depth administrative programming problems.

Manipulating Directories

To be effective as an administration tool Perl must be able to navigate the various directories storing your files.

NOTE
Windows NT uses the NTFS file system (different than the FAT system that runs MS-DOS and Windows 95), which allows it to support long file names. If you are using NT in a network that includes MS-DOS or Windows 95 machines, you must remember that these computers will not be able to read these longer file names. Also keep in mind that you cannot use the following characters in your file names: ? * / \ < > | :

Windows NT file directories are controlled through the File Manager application. Any modifications that you need to make when writing your Perl scripts can be done with this application.

In MS-DOS, you use the command cd to change directories for the current directory to the new one. In Perl the chdir() system call operator acts in the same way-applying a single argument to evaluate the new directory name. The basic format for chdir() is

chdir("new\directory\");

and can be used in a Perl script, as in this example where the user is asked to supply the directory destination to <STDIN>:

#! user/bin/perl
print "Which directory?";
chop($newdirectory = <STDIN>);	
     if (chdir $newdirectory) {
          print 'dir'; # to show some results

where the new directory supplied by the user is put into $newdirectory, where it can be read by the chdir operator. When this script finishes, you don't end up in the new directory, you are deposited back into the directory that you were in when you executed the script. That's why the "dir" line is a good idea, to show that you actually did change directories at one point. You may have noticed that the parentheses are missing. Don't worry because they are optional when using the chdir operator.

Directory and File Control

Perl has several techniques to offer you for dealing with files and directories. You are already familiar with the Perl use of file handles to open a file for output. Perl also provides a way to remove a file-the unlink() operator.

By using the unlink() operator you can delete the name of a file. Sometimes files have more than one file name associated with them, so if the file name to be unlinked is also the last file name for a file, then the file itself will be deleted, too. It is rare that any of the files that Perl will be using will have more than one name, so using the unlink() operator will delete the specified file effectively. The unlink() operator would be used like this:

unlink ("filename"); # filename is deleted

where filename can be the name of any file to be deleted.

You also can have the user input a file to be deleted like so:

print "Which file is to be removed? ";
     chop ($filename = <STDIN>);
     unlink ($filename);

where $filename carries the file name put into <STDIN> by the user.

File Name Manipulation

When you consider file names, what you are really dealing with is another form of a string, which is made of text, so Perl is a natural tool to use here.

The best way to use Perl to manipulate files is to use the rename operator in conjunction with a regular expression that specifies the parameters that will be applied to the file names in question.

The format for the rename() operator is simple:

rename ("oldname","newname");

The original name of the file is oldname and the new name is newname.

If you need to specify a directory path name for a file, you can use the rename operator to do it like this:

rename ("filename","directory_name/filename");

where filename is given the specifed pathname directory_name.

As a quick review, the rename operator can work like this:

  1. Removing file extentions
    foreach $file (<*.txt>) {
    $newfile=$file;
    $newfile=~s/\.txt$//;
    rename($file, $newfile);
    }This strips off the file extension .txt from all the specified file names in the directory.
  2. Adding file extensions back on
    foreach $file (<*>) {
    $newfile=$file;
    $newfile.=".txt";
    rename($file, $newfile);
    }
    This restores the file extension .txt to the files in the current directory.
  3. Adding new file extensions
    foreach $file (<*>) {
    $newfile=$file;
    $newfile.=".htm";
    rename($file, $newfile);
    }
    This adds the .html file extension to the files in the current directory.
  4. Translating uppercase to lowercase
    foreach $file (<*>) {
    $newfile=$file;
    $newfile=~tr/A-Z/a-z/;
    rename($file, $newfile);
    }
    This changes the files specified in the current directory to all lowercase letters.

Checking Bad Passwords

Passwords should be used for both users of your network and users of your Web site. Good security procedure dictates that the system administrator should allow only good passwords to be used, "good" meaning not easily broken. A bad password can not only compromise your user's security, but also the security of your entire network or Web site.

Instead of designing a program that tries and figures out, or cracks, your users' passwords, it takes less time and memory to create a Perl script that searches out bad passwords based on a few rules that apply to bad-or weak-passwords. It does not make sense to define rules for good passwords, because this would give someone trying to infiltrate your system your recipe for success.

You can use regular expressions to search password files for matching against the weak password criteria. This Perl script checks new and changed passwords entered by users to prevent them from using bad ones. This script contains several features concerning system security, such as shadow password files, that are not covered in this book (shadow password files are password files that have been shadowed, a process often done to password files to increase their protection on UNIX systems).

Some of the tests you might be familiar with are testing new passwords against words found in the dictionary, calendar dates, or profane words. These different tests have been included to ensure that as many bases as possible are covered concerning password security. Not all of these tests may be necessary for your network's setup. For more information about system security, consult your system administrator.

When you find that this script gets a little rough, don't worry. This script is very UNIX oriented. That is because the most secure networks are UNIX-based. It would be quite a task for even an experienced Perl programmer to convert all the concepts in this script for use with a Windows NT server. Use this program to learn about the various aspects of security programming, and note the various examples of the kinds of things to look for, and procedures to try, in creating your own password checking program.

#! /usr/bin/perl
     # bad_password_check.pl
     $age = 6; 
     $exp = 1Ø; # these are the age of the password and 
     # expiry date in weeks.
     $bad_phrase = '/usr/etc/phrases'; # the location
     # of your file containing phrases which make bad
     # passwords.
$bad_words = '/usr/etc/words'; # the location of 
     # your file containing words which make bad
     # passwords.
     @words = $bad_words;
     if (-f '/usr/etc/dictionary_file') { # This is
     # a list of dictionaries for the script to search
     # through looking for bad passwords.
          push(@words,'/usr/etc/dictionary_file');
     }
     push(@words,'/usr/etc/another_dict');
     $x = 'dictaa.txt';
     foreach $dict (@words) {
          open($x,$dict) && push(@dicts, eval "*$x);
          $x++;
     }
     $ENV{'IFS'} = '' if $ENV{'IFS'};
     $ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin';
     umask(Ø22); # can't use umask in Winperl
     chdir '/etc' || die "Unable to find /etc.\n";
     die "bad_password_check.pl cannot run setiud to the root directory\n" if $>;
     @INC = $INC[$#INC - 1]; # This specifies the
# Perl library
     die "The Perl library is only writable.\n"
          if $< && -W $INC[Ø];
     die "look.pl is only writable.\n"
          if $< && -W "$INC[Ø]/look.pl";
     require "look.pl" # a call to the look.pl script in 
     # the standard Perl library
     $| = 1; # to buffer commands on STDOUT
     @chrset = ('a'..'z','A'..'Z','Ø'..'9','.','/');
     chop ($host = 'hostname.txt');
     $okay = shift if $ARGV[Ø] =~ /^-r/;
     $okay = Ø if $<; # for the administrator only
     if ($ARGV[Ø] =~ /^-a(.*)/) {
          $total_age = $1;
          $total_age = $age + 1 if $total_age <= Ø;
          $total_age = $exp = 1 if $total_age > $exp;
          shift;
     }
     ($user) = @ARGV;
     die "You are unable to change the password for  $user.\n" if $my_pswd && $<;
     $user = getlogin unless $user;
     $user = (getpwid($<))[Ø] unless $user;
     $SIG{'INT'} = 'CLEANUP';
     $SIG{'HUP'} = 'CLEANUP';
     $SIG{'QUIT'} = 'CLEANUP';
     $SIG{'PIPE'} = 'CLEANUP';
     $SIG{'ALRM'} = 'CLEANUP';
     # This traps the signals
     die "Password file is busy.\n" if -f 'ptmp';
     # This section checks to see if the user has 
     # already made an application for a password
     # to the system.
     open(FORMS,"forms") || die "Unable to open the password application file.";
     $informs = Ø;
     while (<FORMS>) {
          chop;
          if ($_ eq $user) {
               $informs = 1;
               last;
          }
     } 
     close(FORMS);
     die <<"EOM" unless $informs;
     There is no password application on file for $user, 
	 please contact the system administrator to make an application.
     EOM
     print "\nNow changing password for $user.\n";
     $login = ''; # This section takes in all password
     # entries and logins
     open(PASSWD,"passwd") || die "Can't open password file.";
     while (<PASSWD>) {
          /^([^:]+)/;
          if ($1 eq $user) {
               ($login,$openpasswd,$uid,$gid,$home,$shell) = split(/:/);
               die "Your data does not match. 
			   Please try again. ($< $uid $user $x $login)\n" 
			   if $< && $< != $uid; # security
     # double check on user and password
               $chr = substr($openpasswd,Ø,2);
     # These are a listing of names 
               $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 "Unable to find $user in password file.\n"; unless $login;
     if ($opasswd eq 'x' && -f 'etc/shadow') { 
     # checking for a shadow password file
          $shadow = 1;
          open(SHADOW,"shadow") || die "Unable to open shadow password file.";
          while (<SHADOW>) {
               /^([^:]+)/;
               if ($1 eq $user) {
                    ($login,$passwd) = split(/:/);
                    $chr = substr($opasswd,Ø,2);
                    last;
               }
          }
          close(SHADOW);
     }
     open(PASSHIST,"passhist"); # This section retrieves
     # old passwords
     while (<PASSHIST>) {
          /^([^:]+)/;
          if ($1 eq $user) {
               ($login,$oldpass,$when) = split(/:/);
               $oldpass{$oldpass} = $when;
          }
     }
     close PASSHIST;
     $check = 'sub badpass (local($_) = @_;study;'; 
     # this section uses the subroutine
     # BADPASS to match the new password against 
     # the bad password parameters
     open(BADPASS,$BADPASS);
     while (<BADPASS>) {
          ($badpwd,$maybe) = split(/[\n\t]+/);
          ($response = $maybe) =~ s/'/\\'/ if $maybe;
          $check .= "return '$response' if /$badpwd/;\n";
     }
     close BADPASS;
     $check .= 'return Ø;}';
     eval $check; # this will define subroutine BADPASS
     system 'stty', '-echo';
     # This section asks for the new password and checks
     # it against the bad password parameters before it
     # replaces the old.
     if ($<) {
           print"Your old password is: ";
          chop($passØ = <STDIN>);
          print "\n";
          do myexit(1) unless $passØ;
          if (crypt($passØ,$chr) ne $opasswd) {
               print "Cannot complete this function.\n";
               do myexit(1);
          }
     }
     for (;;) { # user chooses new password
          $good = Ø;
          until ($good) {
               print "Your new password is: ";
               chop($pass1 = <STDIN>);
               print "\n";
               do myexit(1) unless $pass1;
               print "Checking new password against bad password parameters.\n";
               $good = &good($pass1);
               if ($good && length($pass1) > 8 {
     # This stipulates to check only the first 8
     # characters of the new password
                    $pass8 = substr($pass1,Ø,8);
                    print "rechecking your first 8 characters.\n";
                    unless ($good = &good($pass8)) {
     # This will limit the check to only the first 8 characters
                         print << 'EOM';
                         EOM
                    }
               }
          };
          print "Please enter your new password again: ";
          chop($pass2 = <STDIN>);
          print "\n";
          last if ($pass1 eq $pass2); 
          print "Passwords don't match, please try again.\n";
     }
     system 'stty','echo';
     if (-f 'ptmp') { # this section checks for a lock on
     # the password file
          print "Unable to access the password file, will try again in 6Ø seconds...\n";
          for ($1 = 6Ø; $i > Ø; -$i) {
               sleep(1);
               print $i,'...';
               last unless -f 'ptmp.txt';
          }
     }
     die "\nThe password file is busy, please try again later.\n" if -f 'ptmp.txt';
     open(PTMP,">ptmptmp$$") || die "Unable to create a tempoary password file.\n"; \
     # this section locks the tempoary password file
     close PTMP;
     $lock = link("ptmptmp$$",'ptmp.txt');
     unlink "ptmptmp$$";
     $lock || die " The password file is busy, please try again later.\n";
     open(PASSWD,"passwd") || die "Unable to open password file.\n";
     open(PTMP,">ptmp") || die "Unable to copy password file.\n";
     $today = time; # this section erypts the passwords
     ($pert1,$pert2) = unpack("C2", $user);
     $week = $today / (6Ø*6Ø*24*7) + $pert1 + $pert2 - $total_age;
     $nsalt = $chrset[$today % 64];
     $cryptpass = crypt($pass1,$nsalt);
     while (<PASSWD>) { # this section builds the new 
     # password
          chop;
          ($login,$passwd,$uid,$gid,$gcos$,$home,$shell) = split(/:/);
          next if $login eq '';
          $passwd = '*' if $passwd eq '' && $login !~ /^\+/;
     # this disables any open accounts     
          if ($login eq $me) {
               if ($shadow) {
                    $passwd = 'x';
               } else {
                    $passwd = $cryptpass;
               }
     # this section introduces an aging element to 
     # the user's password by switching old passwords
     # to another shell. The choice of this shell changes
     # with each system
               if ($shell =~ /(exp|age)\.(.*)/) {
                    $shell = "/bin/$2";
               }
               if ($total_age >= $exp) { 
                    if ($shell =~ m|/bin/(.*)|) {
                         $sh = $1;
                         $sh = 'csh' if $sh eq '';
                         $shell = "/usr/etc/exp.$sh";
                    }
               } elsif ($total_age >= $age) {
                    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.txt' ; die "Unable to write ptmp: $!"; };
     }
     close PASSWD;
     close PTMP;
     ($dev,$ino,$omode,$nlink,$uid,$gid,$rdev,$osize) = stat('passwd');
     ($dev,$ino,$omode,$nlink,$uid,$gid,$rdev,$nsize) = stat('ptmp');
     if ($nsize < $osize - 2Ø || $uid) {
          unlink ('ptmp');
          die "Unable to write new password file. ($uid)\n";
     }
     chmod Ø644, 'ptmp.txt';
     if ($shadow) { # this section creates a shadow
     # password file
          open(SHADOW,"shadow") || die "Unable to open shadow file.\n";
          umask Ø77;
          open(STMP,"stmp") || die "Unable to copy shadow file.\n";
          while (<SHADOW>) { # builds new shadow file
               chop;
               @fields = split(/:/);
               if ($fields[Ø] eq $user) {
                    $fields[1] = $crypypass;
               }
               print STMP join(':',@fields), "/n";
          }
          close SHADOW;
          close STMP;
          chmod Ø6ØØ, 'shadow';
          rename('shadow','shadow_old');
          chmod Ø6ØØ, 'stmp';
          rename('stmp','shadow');
     }
     rename('passwd','passwd_old');
     rename('ptmp','passwd') || die "Unable to create new password file.: $!\n";
     $now = time;
     open(PASSHIST,">>passhist") || exit 1;
     print PASSHIST "$user:$opasswd:$now\n";
     close PASSHIST;
     exit Ø;
     # Now the subroutines
     sub good {
          return 1 if $okay;
          $pass = shift(@_);
          $mono = $pass !~ /^.+([A-Z].*[a-z].*[A-Z])/;
          $mono = Ø if $pass =~ /[a-zA-ZØ-9]/;
          $now = time;
          ($nsec,$nmin,$nhour,$nmday,$nmon,$nyear) = localtime($now);
          if ($pass =~ /\Ø/) {
               print <<"EOM";
         Do not use null characters in your passwords.
               EOM
               return Ø;
          }
     if (crypt($pass,$chr) eq $opasswd) {
          print <<"EOM";
          Do not use the same password as you had before.
          EOM
          return Ø;
     }
     if ($passØ && length($passØ) == length($pass)) {
          $diff = Ø;
          for ($i = length($pass)-1; $I >= Ø; -$i) {
               ++$diff
               if substr($pass,$i,1) ne substr($passØ,$i,1);
               }
               if ($diff <= 2) {
                    print <<"EOM";
     Please enter a new password signifigantly different than your old password.
                    EOM
                    return Ø;
                }
          }
          if (length($pass) < 6) {
               print "Please choose a password of at least six characters.\n";
          }
          return Ø;
     }
     $isaid = Ø;
     if ($pass =~ /^[a-zA-Z]/) {
          ($check = $pass) =~ y/A-Z/a-z/;
          if ($response = do badpats($check)) {
               print $response, " Please try again.\n";
               return Ø;
          }
          $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/;
          @tmp = @dicts; # check through dictionary
     # files for bad password
          while ($dict = shift(@tmp)) {
               local(*DICT) = $dict;
               &look($dict,$short,1,1);
          while (<DICT>) {
               ($cline = $_) =~ y/A-Z/a-z/;
          last if substr($cline,Ø,length($short)) ne $cshort;
               chop;
               ($_,$response) = split(/\t+/);
               if ($pass eq $_ ||
                    ($pass eq substr($_,Ø,8)) ||
                    ($pass =~ /^$_$/i && $mono) ||
                    $shorte eq $_ ||
                    ($shorte =~ /^_$/i && $mono) ||
                    $short eq $_ ||
                    ($short =~ /^_$/i && $mono)) {
                         if ($response) {
                              print $response,
                              " Please try again.\n.";
                         }
                         elsif (/^[A-Z]/) {
                              if (/a$|ie$|yn$|een$|is$/) {
                                   print <<"EOM";
     Improper use of word for a password.
                                   EOM
                              }
                              else {
                                   print <<"EOM";
     The word you have choosen is $alsovery popular. Try again.
                                   EOM
                                   $also = ' also'; 
                              }
                         }
                         else {
                              print <<"EOM";
      This word is found in the dictionary$even.
                              EOM
                         }
                         return Ø;
                    }
               }
          }
     }
     if ($pass =~ /^ .[a-zA-Z]/) { # this section screens
     # passwords for use of two word combinations
          %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,Ø,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,$_) == Ø) {
                              $key = substr($cpass,length($_),999);
                              next word if $key =~/\W/;
                              $others{$keys}++ 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,Ø,length($cpass) - length($key));
                              print <<"EOM";
     Your choice of password uses a two word combination, like "$pre" and "$_". Avoid this.
                              EOM
                              return Ø;
                         }
                         elsif (length($key) == 1 && $pass =~ /^.[a-z]+.$/) {
                              chop($pre = $cpass);
                              $key = sprintf("^%c", ord($key)^64)
                                   unless $key =~ /[ -~]/;
                              print <<"EOM";
     Using the word "$pre" with one character, "$key" is a bad password.
                              EOM
                              return Ø;
                         }
                    }
               }
          }
     }
     if ($pass =~ /(obscene|words|go|here)/i { # this 
     # section is for listing obscene words so they
     # cannot be used as passwords. Please fill in your 
     # list of these when the boss is not looking
          print qq#A common substring such as "$1" makes your#
          print " password an easy target.\n";
          return Ø;
     }
     if ($pass =~ m!^[-\d/]*$!) { # this section
     # tests the password against easily guessed
     # numbers and names
          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";
     Never use a social security number!
                    EOM
                    return Ø;
               }
               if ($pass =~ m!^\d*/\d*/\d*$! || $pass =~ m!^\d*-\d*-\d*$! || $pass =~ m!$nyear$!) {
                    print "Do not use dates for your password.\n";
                    return Ø;
               }
               if ($pass =~ m!^\d\d\d-?\d\d\d\d$!) {
                    print "Do not use a phone number for a password.\n";
                    return Ø;
               }
          }
          if ($mo = ($pas =~ /^[ \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 "Do not use a date for your password.\n";
               return Ø;
          }
          if ($pass =~ /$user/i) {
               print "Do not use your login id.\n";
               return Ø;
          } 
          if ($pass =~ /$mynames/i) {
               print "Do not use part of your own name.\n";
               return Ø;
          }
          if ($pass =~ /$host/i) {
               print "Do not use your host computer name./n";
               return Ø;
          }
          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 "Do not use the license plate number of a vehicle.\n";
               return Ø;
          }
          @ary = unpack('C',$pass);
          $fine = Ø;
          for ($i = Ø; $I < $#ary; ++$i) {
               $diff = $ary[$i+1] - $ary[$i];
               $fine = 1 if $diff > 1 || $diff < -1;
          }
          if (!$fine) {
               print "Don not use ASCII sequences.\n";
               return Ø;
          }
          ($check = $pass) =~ y/A-Z/a-z/;
          $check =~ y/qwertyuiop[]asdfghjkl;'zxcvbnm,.\//a-la-ka-j/;
          $check =~ y/!@#$%^&*()_+|~/abcdefghijklmn/;
          $check =~ y/-123456789Ø=\\'/kabcdefghijklmn/;
          @ary = unpack('C*',$check);
          $fine = Ø;
          for $i = Ø;$i < $#ary; ++$I) {
               $diff = $ary[$i+1] - $ary[$1];
               $fine = 1 if $diff > 1 || $diff < -1;
          }
          if (!$fine) {
               print "Do not use consecutive keys on the keyboard for your password./n";
               return Ø:
          }
          if ( $pass =~ /^(..)\1\1/ || $pass =~ /^(...)\1/ || $pass =~ /^(....)\1/ ) {
               print <<"EOM";
     Do not use any repeated sequences of "$1".
               EOM
               return Ø;
          }
          if ( $pass =~ /^(.)(.)(.)\3\2\1/ || $pass =~ /^(.)(.)(.)(.)\4\3\2\1/ ) {
               print <<"EOM";
     Do not use palindromic sequences like "$1$2$3$4".
               EOM
               return Ø;
          }
          if ($islogin{$pass}) {
               print "Do not use another user's login id./n";
               return Ø;
          }
          $reverse = reverse $user;
          if ($pass =~ /$reverse/i) {
               print <<"EOM";
     Do not use your login id in reverse.
               EOM
               return Ø;
          }
          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 += 19ØØ;
                         print "You have already used this password in $oyear.";
                    }
                    elsif ($omon != $nmon) { 
                         $omon = (January, February, March, April, May, 
			 June, July, August, September, October, November, December)[$omon];
                         print "You have already used this password in $omon.";
                    }
                    elsif ($omday != $nmday) {
                         $omday .= (Ø,'st','nd','rd')[$omday%1Ø]||'th';
                         print "You have already used this password on $omday.";
                    }
                    else {
                         print "You have already used this password today.";
                    }
                    print " Please choose another password.\n";
                    return Ø;
               }
          }
          1;     
     }          
     sub CLEANUP {
          system 'stty','echo';
          print "\n\nOperation aborted.\n";
          exit 1;
     }
     sub myexit {
          system 'stty','echo';
          exit shift(@_);
     }

This program is very involved, but this is the kind of detail that has to be observed for proper server security. You can decide which elements of the script apply to your server's situation and adapt them to your own password scripts for Windows NT.

Other System Administration Concerns

This chapter gives you only a taste of what Perl can do for a system administrator's workload. A more complete discussion of all the elements of Perl involved in system management is outside the scope of this book, and warrants a book of its own. To learn more about Perl and administering the NT server you can try this mailing list

webserver-nt@DELTA.PROCESS.COM

which is subscribed to by sending the message

subscribe webserver-nt

in the message body. This list deals with the many issues facing administrators of NT Web servers-from hardware and security to software and configuration.

The list is a good source of information regarding Perl and NT Web server concerns.