#!/usr/local/perl
#
# Version 0.0
#
# This is the "artificially intelligent" install script written in perl. It
# acts like either an AT&T SYSV or a BSD install script (depending on the
# arguments passed).
#
# How it works: It pretends it is a BSD install scripts and checks the
# arguments for feasibility, then it pretends it is an AT&T SYSV install
# script and checks its arguments again for feasibility. If only one set of
# arguments turns out to be feasible, it then proceeds to act like that
# flavor script. If both look feasible, it throws up its hands and prints an
# error message (well, if it *had* hands, it would throw them up :-).
#
# (Unfortunately, due to the SYSV use of built-in search paths, arguments
# are unlikely to ever mean the exact same thing to both flavor scripts, so
# it can't just go ahead and do the install if both the SYSV and BSD
# interpretation makes sense).
#
# Comparison of SYSV and BSD options and features:
#
#      SYSV                                 BSD
#      ----------------------------------   ----------------------------------
# -c   arg is directory name                no arg, means use cp rather than mv
# -o   no arg, means save OLD file          arg is owner to install as
# -s   no arg, means be silent              no arg, means strip installed prog
# -f   arg is directory name                N/A
# -g   arg is group to install as           arg is group to install as
# -i   no arg, means ignore default dirs    N/A
# -m   arg is mode to install file as       arg is mode to install file as
# -n   arg is directory name                N/A
# -r   no arg, no obvious meaning           N/A
# -u   arg is owner to install as           N/A
# file 1st arg is file to install           1st arg is file to install
# dirs list of directories to search        N/A
# dest N/A                                  directory or file destination
#
# SYSV description:
#
# The SYSV install script searches for the file being installed in various
# directories and tries to install the new version in the same place as the
# old version. The -c option names the specific directory to install a new
# file (will refuse to overwrite an existing file). The -f option is like
# -c, but is willing to replace an existing file. The -n option also names a
# directory, but it is the place to install a file if no existing version of
# it is found.
#
# BSD description:
#
# The BSD install script is much less elaborate (and therefore less prone to
# error). It acts pretty much exactly like the 'mv' (or 'cp' with the -c
# option) command, but the -g, -m, and -o options may also modify the group,
# mode, and owner as the file is installed.
#
# Extra options:
#
# Since I am already going to all this effort, I am adding a few options of
# my own:
#
# -p   Paranoid option - print what you would do, but don't do it.
# -a   Is not recognized by the BSD flavor, so it forces AT&T SYSV flavor
# -b   Is not recognized by the SYSV flavor, so it forces BSD flavor
#
# Differences:
#
# I am not sure if this exactly emulates the SYSV or BSD install scripts
# in all details (or even if it should). Some things which might be different
# include:
#
# SYSV: * This script allows non-root users to use the -g and -u options.
#
#       * This script always attempts to preserve the old owner group and
#         mode when replacing an existing file (unless you override with the
#         -g, -u, and -m options, of course). The AT&T script I looked at
#         was very confused and did not appear to always preserve all 3 of
#         these attributes on every possible path.
#
#       * This script ignores the -r option. The AT&T source I looked at
#         recognizes the -r option, and appears to use it to force the
#         script to go through a different execution path which accomplishes
#         the same thing it would have done without the -r option. (I assume
#         -r stands for "Rube Goldberg" :-).
#
#       * I am not sure the 'sticky' mode bit is treated correctly. The
#         script I examined looked as if it removed the sticky bit on the
#         old program, then ran it. Running an arbitrary program seemed like
#         a fairly dangerous and gratuitous thing to do, so I didn't
#         duplicate that code.
#
#       * This script always works by copying to a temp name in the dest
#         directory, then shuffling the names using moves. The AT&T script I
#         looked at would often copy on top of an existing file. The temp
#         file technique seemed safer since I can recover if something goes
#         wrong half way through the install.
#
#       * I use 555 as the default mode, not 755.
#
#       * I don't print the exact same error messages as the AT&T script.
#
# BSD:  * I do the same temp file gimmick described above. Other than that,
#         I think most BSD behavior should be identical.
#
#       * I use 555 as the default mode, not 755.
#
#       * I don't print the exact same error messages as the BSD script.
#
# Configuration stuff:
#
# Set the appropriate definitions for your site (you could check something
# like /bin/cp to see what owner and group it has if you are unsure). The
# path needs to include mv, cp, rm, chmod, chgrp, chown.
#
$default_owner="bin"; # BSD systems apparently use "root".
$default_group="bin"; # BSD systems apparently use "staff".
$ENV{"PATH"}='/bin:/usr/bin:/usr/ucb:/etc';

# Make sure anything we print comes out right away.
#
select(STDERR);
$|=1;
select(STDOUT);
$|=1;

# The Testopts routine is adapted from the standard perl Getopts routine.
# It does *not* modify the @ARGV array and it defines the options in the
# %options associative array (rather than by defining variables) and leaves
# the positional parameters in the @positional array. It also does not print
# errors, but instead stores an error message in $opterr.
#
sub Testopts {
    local($argumentative) = @_;
    local(@args,$_,$first,$rest);
    local($errs) = 0;
    local($[) = 0;

    undef %options;
    undef @positional;
    undef $opterr;

    foreach $_ (@ARGV) {
       push(@positional, $_);
    }

    @args = split( / */, $argumentative );
    while(@positional && ($_ = $positional[0]) =~ /^-(.)(.*)/) {
	($first,$rest) = ($1,$2);
	$pos = index($argumentative,$first);
	if($pos >= $[) {
	    if($args[$pos+1] eq ':') {
		shift(@positional);
		if($rest eq '') {
		    $rest = shift(@positional);
		}
		$options{$first} = $rest;
	    }
	    else {
		$options{$first} = 1;
		if($rest eq '') {
		    shift(@positional);
		}
		else {
		    $positional[0] = "-$rest";
		}
	    }
	}
	else {
	    $opterr = "Unknown option: \"$first\"";
	    ++$errs;
	    if($rest ne '') {
		$positional[0] = "-$rest";
	    }
	    else {
		shift(@positional);
	    }
	    last;
	}
    }
    $errs == 0;
}

# The find routines are used by the ATT flavor install to search directories
# for an existing copy of a file. They have been adapted from the perl
# library find.pl, but the find stops as soon as it finds the first match.
# (It also does NOT change directories and it simply ignores any unreadable
# dirs rather than printing an error message).
#
sub find {
    foreach $topdir (@_) {
        (($topdev,$topino,$topmode,$topnlink) = stat($topdir)) || next;
        if (-d _) {
            $topdir =~ s,/+$,, ;
            $topdir = '/' if ($topdir eq '');
            &finddir($topdir,$topnlink);
            last if (defined($ATT_destdir));
        }
    }
}

sub finddir {
    local($dir,$nlink) = @_;
    local($dev,$ino,$mode,$subcount);
    local($name);
    local(@filenames);

    # Get the list of files in the current directory.

    if (opendir(DIR,$dir)) {
       @filenames = readdir(DIR);
       closedir(DIR);
    }

    if ($nlink == 2) {        # This dir has no subdirectories.
        for (@filenames) {
            next if $_ eq '.';
            next if $_ eq '..';
            if ($_ eq $ATT_destbase) {
               $ATT_destdir = $dir;
               last;
            }
        }
    }
    else {                    # This dir has subdirectories.
        $subcount = $nlink - 2;
        for (@filenames) {
            next if $_ eq '.';
            next if $_ eq '..';
            $nlink = 0;
            if ($_ eq $ATT_destbase) {
               $ATT_destdir = $dir;
               last;
            }
            $name = "$dir/$_";
            if ($subcount > 0) {    # Seen all the subdirs?

                # Get link count and check for directoriness.

                ($dev,$ino,$mode,$nlink) = lstat($name) unless $nlink;
                
                if (-d _) {

                    # It really is a directory, so do it recursively.

                    &finddir($name,$nlink);
                    last if (defined($ATT_destdir));
                    --$subcount;
                }
            }
        }
    }
}

# runcmd prints a command then runs it (unless we are in print-only mode)
# This is not a general purpose run routine, it knows how to recover from
# errors specific to this script...
#
$runok=1;
$printok=1;
sub runcmd {
   local($stat)=0;
   if ($printok) {
      print "@_\n";
   }
   if ($runok) {
      $stat = system @_;
   }
   if ($stat != 0) {
      print STDERR "Command failed with status $stat: @_\n";
      system "rm","-f",$tempdest;
      if ($attputback) {
         print STDERR "Restoring old version.\n";
         print "mv $ATT_savedest $ATT_finaldest\n";
         system "mv",$ATT_savedest,$ATT_finaldest;
      }
      exit(2);
   }
}

# Assume AT&T and BSD flavors both work, then try to prove one of the
# assumptions wrong.
#
$attok=1;
$bsdok=1;

# Start by analyzing the arguments under the assumption this is a BSD flavor
# installation. Make sure all arguments make sense and check the positional
# parameters to insure they actually are the appropriate kinds of files or
# directories...
#
$BSDoptions="scm:o:g:pb";
if (&Testopts($BSDoptions)) {
   if ($#positional == 1) {
      if (defined($options{"p"})) {
         $BSD_p = $options{"p"};
      }
      if (defined($options{"s"})) {
         $BSD_s = $options{"s"};
      }
      if (defined($options{"c"})) {
         $BSD_c = $options{"c"};
      }
      if (defined($options{"m"})) {
         $BSD_m = $options{"m"};
      }
      if (defined($options{"o"})) {
         $BSD_o = $options{"o"};
      }
      if (defined($options{"g"})) {
         $BSD_g = $options{"g"};
      }
      $BSD_source=$positional[0];
      if (-f $BSD_source) {
         if ($BSD_source=~/^.*\/([^\/]+)$/) {
            $BSD_destbase=$1;
         } else {
            $BSD_destbase=$BSD_source;
         }
      } else {
         $bsdok=0;
         $bsderr=$BSD_source . " is not a file.";
      }
      $BSD_dest=$positional[1];
      $BSD_dest =~ s,/+$,, ;
      $BSD_dest = '/' if ($BSD_dest eq '');
      if (-d $BSD_dest) {
         # If dest is a directory name just use base name from source file.
         $BSD_destdir=$BSD_dest;
      } elsif ($BSD_dest=~/^(.*)\/([^\/]+)$/) {
         # Dest is a full file name, extract the directory part
         $BSD_destdir=$1;
         if ($BSD_destdir eq '') {
            $BSD_destdir='/';
         }
         $BSD_destbase=$2;
         # Make sure the directory really exists
         if ($bsdok && (! -d $BSD_destdir)) {
            $bsdok=0;
            $bsderr=$BSD_destdir . " is not a directory.";
         }
      } else {
         # Dest is a file in the current directory, default dirname to '.'
         $BSD_destdir='.';
         $BSD_destbase=$BSD_dest;
      }
      if ($bsdok) {
         # Generate full path name of final destination file
         if ($BSD_destdir eq '/') {
            $BSD_dest=$BSD_destdir . $BSD_destbase;
         } else {
            $BSD_dest=$BSD_destdir . '/' . $BSD_destbase;
         }
      }
   } elsif ($#positional < 0) {
      $bsdok=0;
      $bsderr="Missing source file.";
   } elsif ($#positional == 0) {
      $bsdok=0;
      $bsderr="Missing destination file or directory.";
   } else {
      $bsdok=0;
      $bsderr="Too many arguments.";
   }
} else {
   $bsdok=0;
   $bsderr=$opterr;
}

# Now do a similar analysis for the more complicated ATT flavor arguments.
#
$ATToptions="iorsc:f:g:m:n:u:pa";
if (&Testopts($ATToptions)) {
   if ($#positional >= 0) {
      if (defined($options{"i"})) {
         $ATT_i = $options{"i"};
      }
      if (defined($options{"p"})) {
         $ATT_p = $options{"p"};
      }
      if (defined($options{"o"})) {
         $ATT_o = $options{"o"};
      }
      if (defined($options{"r"})) {
         $ATT_r = $options{"r"};
      }
      if (defined($options{"s"})) {
         $ATT_s = $options{"s"};
      }
      if (defined($options{"c"})) {
         $ATT_c = $options{"c"};
         $ATT_c =~ s,/+$,, ;
         $ATT_c = '/' if ($ATT_c eq '');
         if ($attok && (! -d $ATT_c)) {
            $attok=0;
            $atterr=$ATT_c . " is not a directory.";
         }
         if ($attok && defined($ATT_i)) {
            $attok=0;
            $atterr="The -c and -i options may not be used together.";
         }
         if ($attok && defined($ATT_o)) {
            $attok=0;
            $atterr="The -c and -o options may not be used together.";
         }
      }
      if (defined($options{"f"})) {
         $ATT_f = $options{"f"};
         $ATT_f =~ s,/+$,, ;
         $ATT_f = '/' if ($ATT_f eq '');
         if ($attok && (! -d $ATT_f)) {
            $attok=0;
            $atterr=$ATT_f . " is not a directory.";
         }
         if ($attok && defined($ATT_i)) {
            $attok=0;
            $atterr="The -f and -i options may not be used together.";
         }
         if ($attok && defined($ATT_c)) {
            $attok=0;
            $atterr="The -f and -c options may not be used together.";
         }
      }
      if (defined($options{"g"})) {
         $ATT_g = $options{"g"};
      }
      if (defined($options{"m"})) {
         $ATT_m = $options{"m"};
      }
      if (defined($options{"n"})) {
         $ATT_n = $options{"n"};
         $ATT_n =~ s,/+$,, ;
         $ATT_n = '/' if ($ATT_n eq '');
         if ($attok && (! -d $ATT_n)) {
            $attok=0;
            $atterr=$ATT_n . " is not a directory.";
         }
         if ($attok && defined($ATT_c)) {
            $attok=0;
            $atterr="The -n and -c options may not be used together.";
         }
         if ($attok && defined($ATT_f)) {
            $attok=0;
            $atterr="The -n and -f options may not be used together.";
         }
      }
      if (defined($options{"u"})) {
         $ATT_u = $options{"u"};
      }
      $ATT_source=shift @positional;
      if (-f $ATT_source) {
         if ($ATT_source=~/^.*\/([^\/]+)$/) {
            $ATT_destbase=$1;
         } else {
            $ATT_destbase=$ATT_source;
         }
      } else {
         $attok=0;
         $atterr=$ATT_source . " is not a file.";
      }
      if (defined($ATT_c)) {
         $ATT_destdir=$ATT_c;
         if ($ATT_destdir eq '/') {
            $temp = $ATT_destdir . $ATT_destbase;
         } else {
            $temp = $ATT_destdir . '/' . $ATT_destbase;
         }
         if (-e $temp) {
            $attok = 0;
            $atterr = $temp . " already exists, will not overwrite.";
         }
      } elsif (defined($ATT_f)) {
         $ATT_destdir=$ATT_f;
      } else {
         $ROOT=$ENV{"ROOT"};
         if ($attok && (! $ATT_i)) {
            # If the -i options was not given search the following directories
            push(@ATT_default,($ROOT . "/bin", $ROOT . "/usr/bin",
                               $ROOT . "/etc", $ROOT . "/lib",
                               $ROOT . "/usr/lib"));
         }
         foreach $_ (@positional) {
            $_ =~ s,/+$,, ;
            $_ = '/' if ($_ eq '');
            if (-d $_) {
               push(@ATT_dest, $_);
            } elsif ($attok) {
               $attok=0;
               $atterr=$_ . " is not a directory.";
               last;
            }
         }
         if ($attok) {
            $ATT_syslist = $ROOT . "/etc/syslist";
            if (! -r $ATT_syslist) {
               undef $ATT_syslist;
            }
         }
         if (defined($ATT_n)) {
            $ATT_fallback=$ATT_n;
         }
      }
   } else {
      $attok=0;
      $atterr="Missing source file.";
   }
} else {
   $attok=0;
   $atterr=$opterr;
}

# If we still believe this is a SYSV style install, see if we can locate the
# ultimate destination directory (if it has not already been set explicitly
# by the -f or -c option).
#
if ($attok) {
   # First search the directories given as arguments.
   #
   if ((! defined($ATT_destdir)) && (defined(@ATT_dest))) {
      &find(@ATT_dest);
   }
   # Then search the /etc/syslist file.
   #
   if ((! defined($ATT_destdir)) && (defined($ATT_syslist))) {
      if (open(SYSLIST, "<$ATT_syslist")) {
         while (<SYSLIST>) {
            chop;
            if (/^(.*)\/([^\/]+)$/) {
               if ($2 eq $ATT_destbase) {
                  $ATT_destdir=$1;
                  last;
               }
            }
         }
         close(SYSLIST);
      }
   }
   # Then search the built in default directory list.
   #
   if ((! defined($ATT_destdir)) && (defined(@ATT_default))) {
      &find(@ATT_default);
   }
   # Then use the directory given in the -n option.
   #
   if ((! defined($ATT_destdir)) && (defined($ATT_fallback))) {
      $ATT_destdir=$ATT_fallback;
   }
   # Finally, give up.
   #
   if (! defined($ATT_destdir)) {
      $atterr = "No place to install " . $ATT_source;
      $attok = 0;
   }
}

if ($attok && $bsdok) {
   # Gack!, wasn't able to tell which kind of install this was. Tell the
   # poor user he is out of luck.
   #
   # NOTE: You could easily change this to arbitrarily pick one of the BSD
   # or SYSV flavor installs by simply setting one of $attok or $bsdok to
   # zero instead of printing an error and exiting.
   #
   print STDERR
"I was unable to determine if this is a SYSV or BSD flavor install request.
Therefore I am not installing anything (sorry).\n";
   exit(2);
}

if ((! $attok) && (! $bsdok)) {
   if ($atterr eq $bsderr) {
      print STDERR "$0: $bsderr\n";
      exit(2);
   } else {
      print STDERR
"No interpretation of the arguments makes sense for either the BSD or the
SYSV flavor install script.\n";
      print STDERR "BSD $0: $bsderr\n";
      print STDERR "SYSV $0: $atterr\n";
      exit(2);
   }
}

if ($bsdok) {
   # This was really a BSD flavor install, go ahead and do the install
   # as though we were BSD.
   if ($BSD_p) {
      $runok=0;
   }
   $printok=1;
   if (-e $BSD_dest) {
      ($destdev,$destino)=stat(_);
      ($srcdev,$srcino)=stat($BSD_source);
      if (($srcino == $destino) && ($srcdev == $destdev)) {
         print STDERR "$BSD_source and $BSD_dest are the same file!\n";
         exit(2);
      }
      $removeold=1;
   }
   if ($BSD_destdir eq '/') {
      $tempdest=$BSD_destdir . "i$$.tmp";
   } else {
      $tempdest=$BSD_destdir . "/i$$.tmp";
   }
   if ($BSD_c) {
      &runcmd("cp",$BSD_source,$tempdest);
      if ($BSD_s) {
         &runcmd("strip",$tempdest);
      }
   } else {
      if ($BSD_s) {
         &runcmd("strip",$BSD_source);
      }
      &runcmd("mv",$BSD_source,$tempdest);
   }
   if ($BSD_o) {
      $default_owner=$BSD_o;
   }
   if ($BSD_g) {
      $default_group=$BSD_g;
   }
   if ($BSD_m) {
      &runcmd("chmod",$BSD_m,$tempdest);
   }
   &runcmd("chgrp",$default_group,$tempdest);
   &runcmd("chown",$default_owner,$tempdest);
   if ($removeold) {
      &runcmd("rm","-f",$BSD_dest);
   }
   &runcmd("mv",$tempdest,$BSD_dest);
   if ($BSD_p) {
      print "\nThis was only a test, no installation was done.\n";
   } else {
      print "$BSD_source installed as $BSD_dest\n";
   }
} elsif ($attok) {
   # This was really a SYSV flavor install, go ahead and do the install
   # as though we were SYSV
   if ($ATT_s) {
      $printok=0;
   }
   if ($ATT_p) {
      $runok=0;
      $printok=1;
   }
   if ($ATT_destdir eq '/') {
      $tempdest=$ATT_destdir . "i$$.tmp";
      $ATT_finaldest = $ATT_destdir . $ATT_destbase;
      $ATT_savedest = $ATT_destdir . "OLD$ATT_destbase";
   } else {
      $tempdest=$ATT_destdir . "/i$$.tmp";
      $ATT_finaldest = $ATT_destdir . "/$ATT_destbase";
      $ATT_savedest = $ATT_destdir . "/OLD$ATT_destbase";
   }
   if (-e $ATT_finaldest) {
      ($dev,$ino,$mode,$nlink,$uid,$gid) = stat(_);
      ($srcdev, $srcino) = stat($ATT_source);
      if (($srcino == $ino) && ($srcdev == $dev)) {
         print "$ATT_source and $ATT_finaldest are the same file!\n";
         exit(2);
      }
      $default_owner=$uid;
      $default_group=$gid;
      $mode &= 07777;      # May not be portable. Is last 12 bits always mode?
      $removeold=1;
   } else {
      $mode = 0555;
   }
   if ($ATT_u) {
      $default_owner=$ATT_u;
   }
   if ($ATT_g) {
      $default_group=$ATT_g;
   }
   if (! defined($ATT_m)) {
      $ATT_m = sprintf("%04o",$mode);
   }
   &runcmd("cp",$ATT_source,$tempdest);
   &runcmd("chmod",$ATT_m,$tempdest);
   &runcmd("chgrp",$default_group,$tempdest);
   &runcmd("chown",$default_owner,$tempdest);
   if ($removeold) {
      if ($ATT_o) {
         if (-e $ATT_savedest) {
            &runcmd("rm","-f",$ATT_savedest);
         }
         &runcmd("mv",$ATT_finaldest,$ATT_savedest);
         $attputback=1;
      } else {
         &runcmd("rm","-f",$ATT_finaldest);
      }
   }
   &runcmd("mv",$tempdest,$ATT_finaldest);
   if (! $ATT_s) {
      if ($ATT_p) {
         print "\nThis was only a test, no installation was done.\n";
      } else {
         print "\n$ATT_source installed as $ATT_finaldest\n";
      }
   }
}