Cover V03, I04
Article
Figure 1
Listing 1
Sidebar 1
Table 1

jul94.tar


Listing 1: Sharing local software on a network

#!/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 "/opt/$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 "$fs/$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"
unless $opt_q};
} }; } };
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.