listing - Sharing local software on a network - Lees

#!/opt/bin/perl
#                         setup
$version = '30-mar-94';
#
# Maintain the "Honda Normal Form" software packages
# on local disks, as adapted to the Solaris 2 package
# management scheme.
#
# The basic philosophy here is that no error checking
# is done during setup. The weekly "setup -c" and
# "setup -v" runs catch problems.
#
# See the accompanying Texinfo file for more details.
#
# Conversion to Solaris by John Lees, February 1993.
# Original perl coding by John Lees, October 1992.
# After a sh script written by Honda Shing, glorious
# inventor of Honda Normal Form.
#-----------------------------------------------------
# John Lees, Systems Analyst & Lab Manager,
# Pattern Recognition & Image Processing Laboratory
# Department of Computer Science, A714 Wells Hall,
# East Lansing, Michigan 48824-1027  USA
# lees@cps.msu.edu, lees@msuegr.bitnet, CIS 74106,1324
#  M i c h i g a n   S t a t e   U n i v e r s i t y
#-----------------------------------------------------
# Copyright 1994 by the Board of Trustees of Michigan
# State University and made available according to the
# provisions of the Free Software Foundation's GNU
# General Public License. The GPL is available by
# anonymous ftp from prep.ai.mit.edu in the file
# /pub/gnu/COPYING-2.0, or from ftp.cps.msu.edu in
# the file /pub/prip/lees/sysadmin/GPL.
#-----------------------------------------------------
umask(0);       # All permissions set explicitly.

### Globals.
#
$circular = '/opt/bin /opt/doc /opt/info /opt/include
   /opt/lib /opt/man';

$nonpackage =
   '. .. bin doc info include man lib lost+found';

# All the directories and subdirectories that exist
# under /opt:
@all_dir =
  ('bin', 'doc', 'include', 'info', 'man', 'lib',
  'man/man1', 'man/man2', 'man/man3', 'man/man4',
  'man/man5', 'man/man6', 'man/man7', 'man/man8',
  'man/manl', 'man/mann', 'man/cat1', 'man/cat2',
  'man/cat3', 'man/cat4', 'man/cat5', 'man/cat6',
  'man/cat7', 'man/cat8', 'man/catl', 'man/catn');

# The directories in which to look when verifying
# correctness or doing an unsetup:
@std_dir = ('bin', 'doc', 'include', 'info', 'lib',
  'man/man1', 'man/man2', 'man/man3', 'man/man4',
  'man/man5', 'man/man6', 'man/man7', 'man/man8',
  'man/manl', 'man/mann', 'man/cat1', 'man/cat2',
  'man/cat3', 'man/cat4', 'man/cat5', 'man/cat6',
  'man/cat7', 'man/cat8', 'man/catl', 'man/catn');

$help = '
 Usage: setup [-c] [-f] [-h] [-p] [-q] [-r] [-s]
      [-u] [-v] [-x] -lHOST/DIR PACKAGE...

 -c   Check the /opt tree for UFOs.
 -f   Fast! Suppresses unlinking the old pointers
      for a package. Do not do this unless you are
      certain everything is okay!
 -h   Display usage.
 -l   Local directory, e.g.,
      "-lserver/l00", "-lserver/l42/gnu", "-l.."
 -p   Package links only (override existing links).
 -q   Quiet, do not display links made.
 -r   Check for UFOs and remove them. Same as "-cr".
 -s   Skip any package which is already setup.
 -u   Unsetup ALL the packages specified.
 -v   Verify. Look at all the packages already setup
      for collisions and correctness.
 -x   Do not actually do the setup or unsetup (useful
      to find collisions with a new package).
';

# Process all the "-" arguments.
# What remains should be packages.
require 'getopts.pl';
do Getopts('cfhl:pqrstuvx');

print "MSU CPS setup utility, version $version\n"
   unless $opt_q;

# Display help?
if ($opt_h) {
   print $help;
   exit 0;
   }

# Option combinations okay?
# ARGC at this point is the number of packages specified.

# Only check and verify do not need specific packages.
if (!($opt_c || $opt_r || $opt_v)) {
   if (@ARGV < 1) {
      die "You must specify at least one package.\n";
   } }

# Check, unsetup, and verify do not need -l option.
if (!($opt_c || $opt_r || $opt_v || $opt_u) && !$opt_l) {
   die "The -l option is required.\n";
   }

# No packages allowed with check and verify.
if ($opt_c || $opt_r || $opt_v) {
   if (@ARGV > 0) {
      die "No packages allowed with check/verify.\n";
   } }

# Check out -l option. Set $fs with true path from /.
if ($opt_l) {
   if (substr($opt_l,0,1) eq '.') {
      chop($here = `pwd`);
      chdir($opt_l) ||
         die "Arghh! Cannot chdir to \"$opt_l\"!\n";
      chop($fs = `pwd`);
      chdir($here) ||
         die "Arghh! Cannot get back to \"$fs\"!\n";
      }
   else {
      $fs = "/home/".$opt_l;
      }
   stat($fs) ||
      die "Bad -l option. Cannot stat \"$fs\"!\n";
   }

#
### Check option. This option looks at the entire
### /opt tree for anything that should not be there.
### If -r was specified, the bogus stuff is removed.
#
if ($opt_c || $opt_r) {
   print "Beginning check . . .\n";
   do check('/opt');

   printf("%d symbolic, %d UFO, and %d empty links.\n",
      $count_links, $count_huh, $count_empty);

   if ($opt_r) {
      printf("UFO and empty links have been REMOVED!\n");
      printf("Rerunning check to verify removals.\n");
      $opt_r = 0;
      do check('/opt');
      }
   } # End of check.

#
### Verify option. This option looks at all the installed
### packages for name collisions. Also check a number of
### requirements for how each package is installed.
#
if ($opt_v) {
   print "\nBeginning verify . . .\n";

   foreach $dir (@std_dir) {
      print "Verify collisions for $dir . . .\n";

      %bb = (); # Zap the blackboard array.
      opendir(OPT, '/opt');

      # Check to see if an object is in more than one
      # package, e.g., there is a "foobar" in both
      # package1/bin and package2/bin.
      foreach $package (readdir(OPT)) {
         if (index($nonpackage, $package) < 0) {
            do find($package, "/opt/$package/$dir");
            } }
      close(OPT);
      } # foreach dir (blackboard scan).
      print "\n";

      opendir(OPT, '/opt');
      foreach $package (readdir(OPT)) {
        if (index($nonpackage, $package) < 0) {
         print "Verify correctness for $package . . .\n";

         # Readme.local is required.
         if (! ((-s "/opt/$package/README.local")
            || (-s "$fs/$package/Readme.local")) ) {
            print "   No Readme.local!\n";
            }

         # See if catman has been run.
         do checkman("/opt", $package);

         # Iff a package has package/etc then
         # /etc/opt/package must be a link.
         if (-d "/opt/$package/etc") {
            $link = readlink("/etc/opt/$package");
            if (defined($link)){
               # Must be a link of the form
               # "/opt/$package/etc".
               if ($link ne "/opt/$package/etc") {
                  print "   ungood link for "
                     ."\"$package/etc\": \"$link\"\n";
                  } }
            else {
               print "   $package/etc but no "
                  ."/etc/opt/$package!\n";
               } }
         elsif (-e "/etc/opt/$package") {
            print
               "   /etc/opt/$package should not exist!\n";
            }
                
         # /var/opt/$package should be a link if there
         # is a $package/var, but it is okay for there
         # to be a /var/opt/$package that is not a link.
         # There MUST be a /var/opt/$package.
         if (-d "/opt/$package/var") {
            if (! -d "/var/opt/$package") {
               print "   $package/var but no link to "
                  ."/var/opt/$package!\n";
               }
            if ((-d "/var/opt/$package")
               && (! -l "/var/opt/$package")) {
               print
                  "   $package/var but /var/opt/$package "
                  ."is not a link!\n";
               } }
         if (! -d "/var/opt/$package") {
            print "   no /var/opt/$package!\n";
            } }
      close(OPT);
      } # foreach dir (correctness scan).
   } #--- End of verify.

#
### If we did check or verify, it's time to leave.
#
if ($opt_c || $opt_r || $opt_v) {
        exit 0;
        }

#
### Setup. #######################################
#
print "Base directory is \"$fs\"\n"
   unless ! $opt_l || $opt_q;
if ($opt_x) {
   print "### -x, no changes will be made! ###\n";
   }
#
### First make sure the minimum /opt directory
# structure exists.
#
if (! $opt_u) {
   # /opt itself.
   if (! -e '/opt') {
      mkdir('/opt', 0755)
         unless $opt_x;
      print("Created /opt\n")
         unless $opt_q;
      }
   # All the standard directories.
   foreach $dir (@all_dir) {
      if (! -e "/opt/$dir") {
         mkdir("/opt/$dir", 0755)
            unless $opt_x;
         print("Created /opt/$dir\n")
            unless $opt_q;
         } } }

#
### Now do each package.
#
loop:
foreach $package (@ARGV) {
   split(/\//, $package);
   $package = pop(@_);
   if (! $opt_u  &&  ! -d "$fs/$package") {
      print "WARNING: $package is not a directory. "
         ."Skipping!\n"
         unless $opt_q;
      next loop;
      }

   # See if catman has been run.
   do checkman($fs, $package)
      unless $opt_p;

   # Readme.local is required.
   if (! ($opt_u || $opt_p)
      && ! ((-s "$fs/$package/README.local")
            || (-s "/opt/$package/Readme.local")) ) {
      print "   No Readme.local file.";
      print " Skipping \"$package\"!\n";
      next loop;
      }

   # Normally do an unsetup on the package before
   # doing a setup.
   do {
      print "Removing links for $package:\n"
         unless $opt_q;
      do unsetup($package);
      } unless $opt_f || $opt_p || $opt_x;

   # Unsetup only?
   if ($opt_u) {
      next loop;
      }

   print "Linking package $package:\n"
      unless $opt_q;

   # The package itself.
   if (-e "/opt/$package") {
      if ($opt_s) {
         next loop;     # Already setup.
         }
      print "WARNING: /opt/$package ALREADY LINKED!\n"
         unless $opt_q || $opt_p;
      }
   # The symlink call does not replace an existing
   # link, so with -p we have to remove the link first.
   if ($opt_p && ! $opt_x) {
        unlink("/opt/$package") ||
           print "   UNLINK FAILED!\n";
        }
   symlink("$fs/$package", "/opt/$package")
      unless $opt_x;

   # With the -p option, we skip all the rest.
   if ($opt_p) {
      next loop;
      }

   # Create /etc/opt/package link only if there is
   # a package/etc directory.
   if ((-e "$fs/$package/etc")
      && (! -e "/etc/opt/$package")) {
      symlink("/opt/$package/etc", "/etc/opt/$package")
         unless $opt_x;
      print("Created link to /etc/opt/$package\n")
         unless $opt_q;
      }

   # Always create /var/opt/package, as a link or a dir.
   if (-e "$fs/$package/var") {
      symlink("/opt/$package/etc", "/var/opt/$package")
         unless $opt_x;
      print("Created link to /var/opt/$package\n")
         unless $opt_q;
      }
   else {
      mkdir("/var/opt/$package", 01777)
         unless $opt_x;
      # With perl-4.036 under Solaris 2.1, the mkdir
      # was not setting the permissions correctly. The
      # explicit chmod was needed.
      chmod(01777, "/var/opt/$package")
         unless $opt_x;
      print("Created /var/opt/$package directory.\n")
         unless $opt_q;
      }
   #
   ### Now do the links for each of the standard
   ### package directories. These are all optional.
   #
   @pkgdir = ('bin', 'info', 'include', 'lib');
   foreach $dir (@pkgdir) {
   PKGDIR: {
   chdir("$fs/$package/$dir") && do {
      print "   /$dir\n"
         unless $opt_q;
      # Sometimes we play weird games, so prevent
      # making a link loop.
      if (-l "$fs/$package/$dir" &&
         index($circular,
            readlink("$fs/$package/$dir")) >= 0) {
         printf "      SKIPPING: link to \"%s\"\n",
            readlink("$fs/$package/$dir")
            unless $opt_q;
         next;
         }
      opendir(DIR, '.');
      foreach $obj (readdir(DIR)) {
         if ($obj ne '.'  &&  $obj ne '..') {
            print "      $obj\n"
               unless $opt_q;
            symlink("../$package/$dir/$obj",
               "/opt/$dir/$obj")
               unless $opt_x;
            } }
      closedir(DIR);
      }; } } # foreach PKGDIR

   # The doc directory is a little different.
   if (-d "$fs/$package/doc") {
      print "   /doc\n"
         unless $opt_q;
      symlink("../$package/doc", "/opt/doc/$package")
         unless $opt_x;
      } # doc

   # The man hierarchy.
   chdir("$fs/$package/man") && do {
      print "   /man\n"
         unless $opt_q;
      opendir(DIR, '.');
      foreach $man (readdir(DIR)) {
         if ($man ne '.'  &&  $man ne '..'
            &&  $man ne 'whatis') {
            chdir("$fs/$package/man/$man");
            opendir(MAN, '.');
            foreach $obj (readdir(MAN)) {
               if ($obj ne '.'  &&  $obj ne '..') {
                  print "      $man/$obj\n"
                     unless $opt_q;
                  symlink("../../$package/man/$man/$obj",
                     "/opt/man/$man/$obj")
                     unless $opt_x;
                  } }
            closedir(MAN);
            }
         closedir(DIR);
         } }; # man
   } # foreach package
exit 0;
# End of setup "main program".

#----------------------------------------------------
# unsetup. Remove all links to a particular package.
#----------------------------------------------------
sub unsetup {
local($package) = @_;
local($link, $obj, $whatsit);

# Funny business to precompile the pattern.
$_ = "../$package/";
/\.\.\/$package\//;

foreach $whatsit (@std_dir) {
   chdir("/opt/$whatsit") && opendir(HERE, '.') && do {
      print "   $whatsit\n"
         unless $opt_q;
      foreach $obj (readdir(HERE)) {
         # Will fail on '.' and '..'
         ($link = readlink($obj)) && do {
            if ($link =~ //) {
            unlink($obj);
            do { print "      $obj  REMOVED\n";
               } }; } };
   closedir(HERE);
   }

if (-l "/opt/$package") {
   unlink("/opt/$package") &&
      do { print "/opt/$package  REMOVED\n"
         unless $opt_q};
   }

if (-l "/etc/opt/$package") {
   unlink("/etc/opt/$package") &&
      do { print "/etc/opt/$package  REMOVED\n"
         unless $opt_q};
   }

if (-l "/var/opt/$package") {
   unlink("/var/opt/$package") &&
      do { print "/var/opt/$package  REMOVED\n"
         unless $opt_q};
   }
elsif (-d "/var/opt/$package") {
   system("/bin/rm -rf /var/opt/$package") &&
      do { print "/var/opt/$package  REMOVED\n"
         unless $opt_q};
   } } # End of routine "unsetup".

#-----------------------------------------------------
# check. Descend into the directory passed as argument
# $_[0]. @dirhandle is a global array used to hold the
# handles for open directories, indexed by the global
# variable $n. This routine is called recursively.
# The -x and -q options do not apply here.
#-----------------------------------------------------
sub check {
   local ($obj); # $_ is implicitly local.
   chdir($_[0]);
   print `pwd`;
   opendir(@dirhandle[++$n], '.');
   foreach $obj (readdir(@dirhandle[$n])) {
      case: {

         # Descend into anything that is real directory.
         (-d $obj  && (! -l $obj)  &&  $obj ne '.'
            &&  $obj ne '..'  &&  $obj ne 'lost+found')
            &&  do {
            if (-x $obj) {
               do check("$obj");
               }
            else {
               print "Cannot access \"$obj\"!\n";
               }
            last case;
            };

         # Count symbolic links.
         (-l $obj)  &&  do {
            $count_links++;
            if (! -e readlink($obj)) {
               print "  Empty link or cannot access: ",
                  readlink($obj);
               if ($opt_r) {
                  unlink($obj) && print " REMOVED\n";
                  }
               else {
                  print "\n";
                  }
               $count_empty++;
               }
            last case;
            };

         # Not a link, not a directory!
         ($obj ne '.'  &&  $obj ne '..'
            &&  $obj ne 'lost+found')  &&  do {
            $f = `ls -Fdl \\$obj`;
            chop($f);
            print "  Non-link: $f";
            if ($opt_r) {
               unlink($obj) && print " REMOVED\n";
               }
            else {
               print "\n";
               }
            $count_huh++;
            last case;
            };

         } # end of case
      }
   closedir(@dirhandle[$n--]);
   chdir('..');
   print `pwd`;
   } # End of subroutine check.

#-----------------------------------------------------
# find. Fill up a big associative array with objects
# in the directory. Report collisions.
#----------------------------------------------------
sub find {
local($package, $directory) = @_;
local($obj);

if (-l $directory && index($circular,
   readlink($directory)) >= 0) {
   printf "WARNING: \"$directory\" is a link to \"%s\"\n",
      readlink($directory);
   return;
   }
opendir(HERE, $directory) || return;

foreach $obj (readdir(HERE)) {
   if ($obj ne '.' && $obj ne '..') {
      if ($bb{$obj} ne "") {
         printf "   $obj in $package and $bb{$obj}\n";
         }
      else {
         $bb{$obj} = $package;
         } } }

closedir(HERE);
} # End of routine "find".

#------------------------------------------------------
# catman. See if catman has been run.
#-----------------------------------------------------
sub checkman {
local($path, $package) = @_;
local($mandir, $catdir, $manpage);
   opendir(MAN, "$path/$package/man");
   foreach $mandir (readdir(MAN)) {
      if ($mandir =~ /man/) {
         $catdir = $mandir;
         $catdir =~ s/man/cat/;
         opendir(MANX, "$path/$package/man/$mandir");
         foreach $manpage (readdir(MANX)) {
            if ($manpage ne '.' && $manpage ne '..') {
               if (! -f
                   "$path/$package/man/$catdir/$manpage") {
                  print "   No $catdir page for $manpage\n"
                     unless $opt_q;
                  } } }
         closedir(MANX);
         } }
   closedir(MAN);
   } # End of routine "checkman".
### End of the setup program.
