#!/opt/perl/bin/perl -w

#
# repln -- Replicate links
#
# W. M. Richards, NiEstu, Phoenix AZ, June 1997
#
# This software is made freely available under the provisions of the Perl
# "Artistic" license:  http://language.perl.com/misc/Artistic.html
#

#
# Replicates symbolic links; intended to be used to propagate our /opt
# structure, mostly net-supported packages, across our internal network
#
# Syntax:
#
#    repln  [options]  source-dir  ...
#

use Getopt::Long;

#
# Policy values
$opt_mstr    = 'mstr';  # name of "master" /opt link
@opt_subdirs = qw( bin etc lib info share
                   man/man1 man/man2 man/man3 man/man4 man/man5 man/man6 man/man7 man/man8 man/man9 man/mann
                   lib/X11/app-defaults );
$dirmode = 0775;  # creation mode for directories

#
# Constants
$false = 0;
$true  = 1;
$all   = 2;  # for Getopt ignore case

#
# Option defaults
$opt {'app'}       = $false;
$opt {'dev'}       = $false;
$opt {'force'}     = $false;
$opt {'from'}      = '';
$opt {'help'}      = $false;
$opt {'links'}     = $true;
$opt {'mkdirs'}    = $false;
$opt {'linkdirs'}  = $false;
$opt {'files'}     = $false;
$opt {'opt'}       = $false;
$opt {'parent'}    = '';
$opt {'quiet'}     = $false;
$opt {'recursive'} = $false;
$opt {'refresh'}   = $false;
$opt {'remove'}    = $false;
$opt {'sub'}       = '';
$opt {'to'}        = '.';
$opt {'verbose'}   = $false;
$opt {'view'}      = $false;

#
# Process command-line
@opts = qw( from|f=s to|t=s parent|p=s
            app opt master|mstr dev|d
            links|l! files! linkdirs|ld! sub|s=s mkdirs|m refresh remove|rm
            quiet|q help|h view|v force recursive verbose );
$Getopt::Long::bundling = $true;  # perl 5.003 and earlier will complain about this
$Getopt::Long::ignorecase = $all;
GetOptions (\%opt, @opts);
if ($opt {'help'})
{
   &syntax_message ();
   exit (1);
}

#
# Verify required options are present, and other checks
if ($opt {'parent'})
{
   if ($opt {'from'})  # these two are mutually exclusive
   {
      &syntax_message ();
      exit (1);
   }
}
elsif (! $opt {'from'})  # need --from or --parent
{
   if (defined ($ARGV [0]))  # but the 'from' arg can be positional
   {
      $opt {'from'} = $ARGV [0];
   }
   else
   {
      &syntax_message ();
      exit (1);
   }
}
if ((! $opt {'files'}) && (! $opt {'links'}))
{
   &syntax_message ();
   exit (1);
}
if ($opt {'dev'})
{
   push (@opt_subdirs, 'include');
}
if ($opt {'master'})
{
   $opt {'sub'} = 's+/mstr++';
}
if ($opt {'remove'} && ($opt {'mkdirs'} || $opt {'refresh'} || (! $opt {'links'})))
{
   &syntax_message ();
   exit (1);
}

#
# Trim extra slashes from directory names
$opt {'parent'} =~ s+/*$++;
$opt {'from'}   =~ s+/*$++;
$opt {'to'}     =~ s+/*$++;

#
# Check for "--opt" option--implement local /opt policy
if ($opt {'opt'})
{
   &replicate_opt_structure ($opt {'from'}, $opt {'to'});
}

#
# Check for "--app" option--propagate links to application files to
# convenience directories
elsif ($opt {'app'})
{
   $opt {'files'} = $true;  # implied
   &replicate_app_structure ($opt {'from'}, $opt {'to'});
}

#
# If parent dir given, cycle through each listed subdir
elsif ($opt {'parent'})
{
   $opt {'parent'} =~ s+/$++;  # trim trailing slash if present
   foreach $subdir (@ARGV)
   {
      &replicate ($opt {'parent'} . "/$subdir", $opt {'to'} . "/$subdir");
   }
}

#
# No parent, so just replicate single directory
else
{
   &replicate ($opt {'from'}, $opt {'to'});
}

#
# All done
print "\n" unless ($opt {'quiet'});
exit (0);



##############################################################################
#####  Subroutines
##############################################################################


#
# The main deed-doing routine; replicates/creates/removes links in target dir from
# source dir
sub replicate
{
   my ($from, $to) = @_;
   my ($action, $what, $header, $name, $fpath, $tpath, $tpath_exists, $linkval, $oldval, @names);

#
# Report what we are about to do
   if ($opt {'links'} && $opt {'files'})
   {
      $what = 'links and files';
   }
   elsif ($opt {'links'})
   {
      $what = 'links';
   }
   elsif ($opt {'files'})
   {
      $what = 'files';
   }
   else
   {
      die "This cannot happen here--neither links nor files selected\n";
   }
   if ($opt {'remove'})
   {
      $action = 'removal';
   }
   else
   {
      $action = 'replication';
   }
   if ($opt {'view'})
   {
      $header = "Proposed $action of";
   }
   else
   {
      $header = ucfirst ($action). ' of';
   }
   print "\n$header $what from $from to $to\n" unless $opt {'quiet'};

#
# Actually do it--open the directory
   if (! opendir (DIR, $from))
   {
      print STDERR  "Unable to read directory \"$from\" during replication--skipped\n";
      return;
   }

#
# Make new target dir if --mkdirs and doesn't already exist
   if ($opt {'mkdirs'})
   {
      lstat ($to);
      if (! -d _)
      {
         if ($opt {'view'})
         {
            $action = 'Proposing to create';
         }
         else
         {
            $action = 'Creating';
         }
         print "$action new directory \"$to\"\n" if ($opt {'verbose'});
         &mkdir_hier ($to, $dirmode) unless ($opt {'view'});
      }
   }

#
# Gather names in the dir so we can sort them before processing them
   while (defined ($name = readdir (DIR)))
   {
      next if ($name eq '.' || $name eq '..');  # skip specials
      push (@names, $name);
   }
   closedir (DIR);

#
# For each name listed in the directory
   foreach $name (sort @names)
   {
      $fpath = "$from/$name";
      $tpath = "$to/$name";
      $tpath_exists = -l $tpath;

#
# Check what sort of thing our source object is
      lstat ($fpath);
      if (-d _)                                 # skip directories unless linking them or recursive
      {
         if ($opt {'recursive'})
         {
            &replicate ($fpath, $tpath);
         }
         elsif ($opt {'linkdirs'})
         {
            &make_new_link ($fpath, $tpath, $tpath_exists, '-*->');
         }
      }
      elsif (-f _)                              # normal files
      {
         next unless ($opt {'files'});
         &make_new_link ($fpath, $tpath, $tpath_exists, '-+->');
      }
      elsif (-l _)                              # sym. links
      {
         next unless ($opt {'links'});
         if ($opt {'remove'})
         {
            if ($tpath_exists)
            {
               $oldval = readlink ($tpath);
               $oldval = '???' unless defined ($oldval);
               $linkval = readlink ($fpath);
               $linkval = '???' unless defined ($linkval);
               $oldval .= "($linkval?)" if ($oldval ne $linkval);  # just flag this--they should be equal
               print "$tpath ---> $oldval\n" unless ($opt {'quiet'});
               if ((! $opt {'view'}) && unlink ($tpath) < 1)
               {
                  print STDERR  "Cannot remove $tpath ---> $linkval ($!)\n";
               }
            }
            else
            {
               print "Not removing non-existent link $tpath\n" if ($opt {'verbose'});
               next;
            }
         }
         else
         {
            if (defined ($linkval = readlink ($fpath)))
            {
               eval ("\$linkval =~ " . $opt {'sub'}) if ($opt {'sub'});
               if ($opt {'refresh'} && $tpath_exists)
               {
                  print "Skipping existing $tpath\n" if ($opt {'verbose'});
                  next;
               }
               if ($opt {'force'} && $tpath_exists)
               {
                  if ($opt {'view'})
                  {
                     $action = 'Proposing to remove';
                  }
                  else
                  {
                     $action = 'Removing';
                  }
                  if ($opt {'verbose'})
                  {
                     $oldval = readlink ($tpath);
                     $oldval = '???' unless defined ($oldval);
                     print "$action old link \"$tpath ---> $oldval\"\n";
                  }
                  unlink ($tpath) unless ($opt {'view'});
               }
               print "$tpath ---> $linkval\n" unless ($opt {'quiet'});
               if ((! $opt {'view'}) && symlink ($linkval, $tpath) == 0)
               {
                  print STDERR  "Cannot create $tpath ---> $linkval ($!)\n";
               }
            }
            else
            {
               print STDERR  "Cannot read link value for \"$fpath\"--skipped\n";
            }
         }
      }
   }
}


#
# Implements local /opt directory structure policy; takes links in "--from"
# directory and replicates them into /opt
sub replicate_opt_structure
{
   my ($from, $to) = @_;
   my ($action, $linkval, $fpath, $tpath, $tpath_exists, $oldval, $subdir, @names);

#
# Report what we are about to do
   if ($opt {'view'})
   {
      $action = 'Proposed replication of';
   }
   else
   {
      $action = 'Replication of';
   }
   print "\n$action /opt structure from $from to $to\n" unless $opt {'quiet'};

#
# Make sure the master link exists
   $tpath = "$to/$opt_mstr";
   if (defined ($linkval = readlink ($tpath)))
   {
      if ($linkval eq $from)
      {
         print "Master link is already correct:  $tpath ---> $linkval\n" if ($opt {'verbose'});
      }
      else
      {
         print "Master link is wrong:  $tpath ---> $linkval\n" if ($opt {'verbose'});
         if ($opt {'force'})
         {
            if ($opt {'view'})
            {
               $action = 'Proposing to remove';
            }
            else
            {
               $action = 'Removing';
            }
            print "$action old master link \"$tpath ---> $linkval\"\n" if ($opt {'verbose'});
            unlink ("$tpath") unless ($opt {'view'});
            if ($opt {'view'})
            {
               $action = 'Proposing to create';
            }
            else
            {
               $action = 'Creating';
            }
            print "$action master link $tpath ---> $from\n" if ($opt {'verbose'});
            symlink ($from, "$tpath") unless ($opt {'view'});
         }
      }
   }
   else
   {
      if ($opt {'view'})
      {
         $action = 'Proposing to create';
      }
      else
      {
         $action = 'Creating';
      }
      print "$action master link $tpath ---> $from\n" if ($opt {'verbose'});
      symlink ($from, "$tpath") unless ($opt {'view'});
   }

#
# Actually do it--open the directory
   if (! opendir (DIR, $from))
   {
      print STDERR  "Unable to read directory \"$from\" during replication\n";
      return;
   }

#
# For each name listed in the originating /opt directory
   while (defined ($name = readdir (DIR)))
   {
      next if ($name eq '.' || $name eq '..');  # skip specials
      push (@names, $name);
   }
   closedir (DIR);
   foreach $name (sort @names)
   {
      $fpath = "$opt_mstr/$name";
      $tpath = "$to/$name";
      $tpath_exists = -l $tpath;
      lstat ("$from/$name");
      next if (-d _);                           # skip directories
      if (-l _)                                 # sym. links
      {
         eval ("\$fpath =~ " . $opt {'sub'}) if ($opt {'sub'});
         if ($opt {'refresh'} && $tpath_exists)
         {
            print "Skipping existing $tpath\n" if ($opt {'verbose'});
            next;
         }
         if ($opt {'force'} && $tpath_exists)
         {
            if ($opt {'view'})
            {
               $action = 'Proposing to remove';
            }
            else
            {
               $action = 'Removing';
            }
            if ($opt {'verbose'})
            {
               $oldval = readlink ($tpath);
               $oldval = '???' unless defined ($oldval);
               print "$action old link \"$tpath ---> $oldval\"\n";
            }
            unlink ($tpath) unless ($opt {'view'});
         }
         print "$tpath ---> $fpath\n" unless ($opt {'quiet'});
         if ((! $opt {'view'}) && symlink ($fpath, $tpath) == 0)
         {
            print STDERR  "Cannot create $tpath ---> $fpath ($!)\n";
         }
      }
   }

#
# For each of the supported subdirectories, if it's there, replicate it
   foreach $subdir (@opt_subdirs)
   {
      if (-d "$from/$subdir")
      {
         if (! -d "$to/$subdir")
         {
            if ($opt {'view'})
            {
               $action = 'Proposing to create';
            }
            else
            {
               $action = 'Creating';
            }
            print "\n$action new directory \"$to/$subdir\"\n" if ($opt {'verbose'});
            &mkdir_hier ("$to/$subdir", $dirmode) unless ($opt {'view'});
         }
         else
         {
            print "\nDirectory $to/$subdir is already there, good\n" if ($opt {'verbose'});
         }
         &replicate ("$from/$subdir", "$to/$subdir");
      }
      else
      {
         print "\nSkipping sub-directory $subdir, since it's not present (which is okay)\n" if ($opt {'verbose'});
      }
   }
}


#
# Propagate an application's "important" subdirectories
sub replicate_app_structure
{
   my ($from, $to) = @_;
   my ($action, $fpath, $tpath, $subdir, @names);

#
# Report what we are about to do
   if ($opt {'view'})
   {
      $action = 'Proposed replication of';
   }
   else
   {
      $action = 'Replication of';
   }
   print "\n$action application structure from $from to $to\n" unless $opt {'quiet'};

#
# For each of the supported subdirectories, if it's there, replicate it
   foreach $subdir (@opt_subdirs)
   {
      if (-d "$from/$subdir")
      {
         &replicate ("$from/$subdir", "$to/$subdir");
      }
      else
      {
         print "\nSkipping sub-directory $subdir, since it's not present (which is okay)\n" if ($opt {'verbose'});
      }
   }
}


#
# Do the equivalent of a "mkdir -p", making intervening dirs if needed
sub mkdir_hier
{
   my ($dirpath, $mode) = @_;
   my (@dirs, $dir, $prefix);

   @dirs = split ('/', $dirpath);
   $prefix = '';
   foreach $dir (@dirs)
   {
      if ("${prefix}${dir}" && (! -d "${prefix}${dir}"))
      {
         mkdir ("${prefix}${dir}", $mode);
      }
      $prefix = "${prefix}${dir}/";
   }
}


#
# Make a new (or delete an old) link that points to a real object
sub make_new_link
{
   my ($fpath, $tpath, $tpath_exists, $label) = @_;
   my ($linkval, $oldval, $action);

   if ($opt {'remove'})
   {
      if ($tpath_exists)
      {
         $linkval = readlink ($tpath);
         if (defined ($linkval))
         {
            $linkval .= "($fpath?)" if ($linkval ne $fpath);  # just flag this--they should be equal
         }
         else
         {
            $linkval = '???';
         }
         print "$tpath $label $linkval\n" unless ($opt {'quiet'});
         if ((! $opt {'view'}) && unlink ($tpath) < 1)
         {
            print STDERR  "Cannot remove $tpath $label $linkval ($!)\n";
         }
      }
      else
      {
         print "Not removing non-existant link $tpath\n" if ($opt {'verbose'});
      }
   }
   else
   {
      eval ("\$fpath =~ " . $opt {'sub'}) if ($opt {'sub'});
      if ($opt {'refresh'} && $tpath_exists)
      {
         print "Skipping existing $tpath\n" if ($opt {'verbose'});
         return;
      }
      if ($opt {'force'} && $tpath_exists)
      {
         if ($opt {'verbose'})
         {
            if ($opt {'view'})
            {
               $action = 'Proposing to remove';
            }
            else
            {
               $action = 'Removing';
            }
            $oldval = readlink ($tpath);
            $oldval = '???' unless defined ($oldval);
            print "$action old link \"$tpath ---> $oldval\"\n";
         }
         unlink ($tpath) unless ($opt {'view'});
      }
      print "$tpath $label $fpath\n" unless ($opt {'quiet'});
      if ((! $opt {'view'}) && symlink ($fpath, $tpath) == 0)
      {
         print STDERR  "Cannot create $tpath $label $fpath ($!)\n";
      }
   }
}


#
# Print syntax message
sub syntax_message
{
   my ($progname);

   chomp ($progname = `basename $0`);
   print STDERR  qq
Syntax:

   $progname  [ options ]  [ from-directory ]  ...

Where 'options' are:

   --opt
       Propagate standard /opt directory structure; ignores these other
       options: (no)files, (no)links, to, parent
   --app
       Create "convenience" links from an /opt/<appname> directory\'s standard
       subdirectories into /opt/bin, /opt/lib, etc.; ignores these other
       options: (no)links, parent; implies "--files"
   -d, --dev
       Do a "developer" replication, including "include" subdir (only for
       --opt and --app)
   --master, --mstr
       Initial install of an app in a "master" /opt directory remotely; is
       actually just shorthand for "--sub=s+/mstr++", but when used with
       "--from=/opt/mstr/appname --to=/opt/mstr", works really cool

   --remove, --rm
       Remove links instead of creating them; useful for "uninstalling"
       applications
   --files
       Also create links to real files found in "from" directories
   --nofiles
       Do not create links to real files--replicate symlinks only (default)
   -l, --links
       Replicate symbolic links (default)
   --nolinks
       Do not replicate symbolic links
   --linkdirs, --ld
       Make symlinks to first-level subdirectories, too
   --nolinkdirs
       Do not make symlinks to subdirectories (default)
   -m, --mkdirs
       Make new target directories if they do not exist (especially useful
       when the "--recursive" option is used)
   --recursive
       Traverse any subdirectories found, and perform requested operation in
       them, too.  Often more useful if the "--mkdirs" option is also given.
   -s cmd, --sub=cmd
       Perform a perl substitute command on link contents before creating the
       link (eg. "--sub=s/pkg/mstr/", or "-s s+/mstr++")

   -q, --quiet
       Quiet mode--don\'t show the rename commands as they are executed
   --verbose
       Verbose mode--show more info about operation
   -v, --view
       View-only mode; show links which would be created, but don\'t actually
       create them
   --force
       Replace existing links (otherwise they\'re skipped)
   --refresh
       Skip items which already have a target link
   -h, --help
       Print this help message

   -f dir, --from=dir
       Set "from" directory, eg. "-f /net/tks01/_c/opt.10"
   -t dir, --to=dir
       Set "to" directory, into which links will be created (default current
       working directory)
   -p dir, --parent=dir
       Set "parent" directory; in this case, listed directory names are
       subordinate to this parent directory

Note that the "--parent" and "--from" options are mutually exclusive.  To
include the parent directory itself when using "--parent", add "." to the list
of subdirectories.  Also, "--nofiles" and "--nolinks" are mutually exclusive;
since "--nofiles" is the default, this means that "--nolinks" must be
accompanied by "--files".  The "--remove" option cannot be combined with
"--refresh", "--nolinks", or "--mkdirs".  The "--linkdirs" option cannot
be combined with "--mkdirs" or "--recursive", for semi-obvious reasons.

In the output, a "--->" marker denotes a replicated symbolic link.  A "-+->"
marker denotes a new link, created to point to a real file.  The "-*->" marker
denotes a new link, created to point to a directory.


EXAMPLES
--------

After a new app is created in /opt/mstr, to install convenience links on the
master machine itself:

   $progname  --app  --from=/opt/mstr/appname  --to=/opt/mstr  --master

After one or more new apps have been installed, to propagate links to another
host:

   $progname  --opt  --from=/opt/mstr  --to=/net/hostname/opt  --refresh

To replicate a set of links from one directory to another:

   $progname  --from=fromdir  --to=todir

It is ALWAYS recommended that you try a command with the "--view" option
first, before you actually make the links.  Remember that the "--from=" and
"--to=" options can be abbreviated as "-f" and "-t" respectively.  All the
options are summarized above.

;
}
