#! /local/bin/perl

######################################################################
# $Header: /loc/adm/slink-1.0/src/slink-5.0/RCS/slink,v 5.0 1996/05/13 17:15:49 couch Exp $
#  SLINK the link manager: create virtual unions of filesystem subtrees. 
#  Revision 5.0
#  by 
#  Alva L. Couch, 			Greg Owen
#  Associate Prof. of EE/CS		Xerox Information Systems
#  Department of EE/CS			Peabody, MA 02146
#  Tufts University,			gowen@xis.xerox.com
#  Medford, Massachusetts, 02155.
#  couch@cs.tufts.edu
#
#  Slink-1.0 Copyright (C) 1995 by Alva L. Couch and Greg Owen
#  Slink-2.0 Copyright (C) 1995 by Alva L. Couch
#  Slink-3.0 Copyright (C) 1996 by Alva L. Couch
#  Slink-4.0 Copyright (C) 1996 by Alva L. Couch
#  Slink-5.0 Copyright (C) 1996 by Alva L. Couch
# 
#  This file is part of SLINK
#
#  SLINK is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2, or (at your option)
#  any later version.
#
#  SLINK is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with GNU CC; see the file COPYING.  If not, write to
#  the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
######################################################################
#  Slink the link manager manages creation of virtual symbolic images
#  of UNIX filesystem subtrees.  Each image is a union constructed from 
#  symbolic links. A configuration file has entries of the form: 
#  link <source-root> <image-root> [<image-root> ...]
#  where
#  <source-root> is what to add to the image, e.g., /loc/emacs-19
#  <image-root>  is where to make the first node appear in an image, 
#		 e.g., /local, /local/bin, etc.
#
#  Link requests can be undone with the configuration file line
#  unlink <source-root> <image-root> [<image-root> ...]
#
#  Example: the line
#  link /loc/emacs-19 /local
#  means to recursively make links from /local/file 
#  to /loc/emacs-19/file for every file in /loc/emacs-19/file, 
#
#  Entries in each column can be absolute or relative.
#  Relative addresses are prepended with absolute prefixes. 
#  Lines of the form: 
#  cd <cwd1> <cwd2> 
#  set the working directories for each column.
#
#  One may delegate commands to subfiles and include a file with the line
#  include <file> <cwd1> <cwd2>
#  where
#  a) <file> will be expanded relative to the current working directory
#     for the source column (#1). 
#  b) <cwd1>, <cwd2> are working directories to use INSIDE the file. 
#     (which will be restored to their old values upon coming back from it)
#  " in a directory position means to leave current setting alone.
######################################################################

use strict; 
require 5.001; 
require "getcwd.pl"; 
require "ctime.pl";
require "newgetopt.pl"; 
use Slink::TrueName(qw(truename absolute concat reduce)); 
use Slink::Config; 
use Slink::Logger; 
use Slink::Mapper; 
use Slink::Protector; 
use Slink::Duper; 

# You may disable instance locking of Slink by setting this to 1. 
# this will allow several instances of the main routine to run. 
$main::opt_nolock = 0; 

  ##################################################################
 ####                                                            ####
####            Part 0: Slink::Config options                     ####
 ####                                                            ####
  ##################################################################

# These are defined in Slink/Config.pm. 
# Change them there. Do not edit this. 

$main::cmd_ps      = $Slink::Config{'ps'}; 
$main::opt_root    = $Slink::Config{'root'}; 
$main::opt_confile = $Slink::Config{'confile'}; 
$main::opt_errfile = $Slink::Config{'errfile'}; 
$main::opt_logfile = $Slink::Config{'logfile'}; 
$main::opt_mapfile = $Slink::Config{'mapfile'}; 
$main::opt_modfile = $Slink::Config{'modfile'};
$main::opt_newfile = $Slink::Config{'newfile'}; 
$main::opt_lokfile = $Slink::Config{'lokfile'}; 
@main::opt_hosts   = @{$Slink::Config{'hosts'}}; 
$main::opt_umask   = $Slink::Config{'umask'}; 
$main::opt_dirmode = $Slink::Config{'dirmode'}; 

  ##################################################################
 ####                                                            ####
####            Part 1: Main SLINK Program                        ####
 ####                                                            ####
  ##################################################################

# You should not have to modify any further 
# lines in SLINK in normal usage. 

# these flags are set by various command line options. 

# commands determine function
$main::opt_update   = 0; 	# update filesystems according to database
$main::opt_link     = 0; 	# force a link not in the configuration file
$main::opt_unlink   = 0; 	# force an unlink not in the configuration file
$main::opt_copy     = 0; 	# force a copy not in the configuration file
$main::opt_uncopy   = 0; 	# force an uncopy not in the configuration file
$main::opt_destroy  = 0; 	# force a destroy not in the configuration file
$main::opt_clean    = 0; 	# delete links that point nowhere. 
$main::opt_condense = 0; 	# remove redundant directories. 
$main::opt_report   = 0; 	# print info about non-slink links and files. 

# options modify function
$main::opt_debug    = 0; 	# 1 to enable debugging writes
$main::opt_echo     = 0; 	# print logging messages on STDERR
$main::opt_verbose  = 0; 	# print verbose messages
$main::opt_remap    = 0; 	# don't read mapfile initially.
$main::opt_nomap    = 0; 	# don't use or update mapfile. 
$main::opt_quiet    = 0; 	# 1=don't write errors to controlling terminal. 
$main::opt_help     = 0; 	# print help and exit.

# default match keys for configuration file operations are empty
$main::opt_imagematch = ''; 	# match this pattern in link tree
$main::opt_sourcmatch = ''; 	# match this pattern in source tree

# mask to use when creating files
umask $main::opt_umask if defined $main::opt_umask; 

######################################################################
# process arguments and determine what to do during this invocation 
######################################################################

sub help {
    print STDERR "SLINK USAGE:\n"; 
    print STDERR "slink [-update] [options] [<source-pat> [<image-pat>]]\n";
    print STDERR "  makes links from configuration file matching the given patterns\n"; 
    print STDERR "slink -condense [options] [<source-pat> [<image-pat>]]\n";
    print STDERR "  Condense image tree by removing redundant directories\n"; 
    print STDERR "slink -link [options] <source-name> <image-name> [<image-name>...]\n"; 
    print STDERR "  Forces creation of a slink not in the configuration file\n"; 
    print STDERR "slink -unlink [options] <source-name> <image-name> [<image-name>...]\n"; 
    print STDERR "  Forces deletion of a slink not in the configuration file\n"; 
    print STDERR "slink -copy [options] <source-name> <image-name> [<image-name>...]\n"; 
    print STDERR "  Forces a copy not in the configuration file\n"; 
    print STDERR "slink -uncopy [options] <source-name> <image-name> [<image-name>...]\n"; 
    print STDERR "  Forces an uncopy not in the configuration file\n"; 
    print STDERR "slink -destroy [options] <image-name> [<image-name>...]\n"; 
    print STDERR "  Forces a destroy not in the configuration file\n"; 
    print STDERR "slink -clean [options] <image-name> [<image-name>...]\n"; 
    print STDERR "  Clean image tree by removing images to nonexistent nodes\n"; 
    print STDERR "slink -report [options] <image-name> [<image-name>...]\n"; 
    print STDERR "  report possible image tree corruption\n"; 
    print STDERR "slink -help\n"; 
    print STDERR "  print this message only\n"; 
    print STDERR "BEHAVIOR OPTIONS:\n"; 
    print STDERR "  -echo: echo action log on STDERR.\n"; 
    print STDERR "  -verbose: print verbose description of actions.\n"; 
    print STDERR "  -quiet: don't echo errors to controlling terminal.\n"; 
    print STDERR "  -debug: print debugging trace\n"; 
    print STDERR "  -nolock: don't lock out multiple instances\n"; 
    print STDERR "  -nomap: don't read or write mapfile\n"; 
    print STDERR "  -remap: don't read mapfile initially\n"; 
    print STDERR "FILENAME OPTIONS:\n"; 
    print STDERR "  -root <rootdirname>: specify a prefix for file names\n"; 
    print STDERR "  -confile <confilename>: specify a new configuration file.\n"; 
    print STDERR "  -errfile <errfilename>: specify a new error file.\n"; 
    print STDERR "  -logfile <logfilename>: specify a new log file.\n"; 
    print STDERR "  -lokfile <lokfilename>: specify a new lock file.\n"; 
    print STDERR "  -mapfile <mapfilename>: specify a new link map file.\n"; 
    print STDERR "  -modfile <modfilename>: specify a new protection file.\n"; 
    print STDERR "  -newfile <newfilename>: specify a new `new link' file.\n"; 
}

# get options as full names 
if (!&NGetOpt(
    '-',		# options start with -
    'clean',		# clean up non-existant links in specified trees
    'condense',		# condense image trees according to patterns
    'copy',		# copy a file or directory
    'debug',		# print debugging traces
    'destroy',		# destroy a node
    'echo',		# print action log on STDERR. 
    'help',		# print a help message
    'link',		# create a link not in the config file
    'nolock',		# don't use lockfile to lock out multiple instances.
    'nomap',		# don't use mapfile for read or write.
    'quiet',		# don't echo errors to the controlling terminal.
    'remap',		# don't read the mapfile before starting.
    'report', 		# check on corruption of link trees. 
    'uncopy',		# undo a copy operation
    'unlink',		# delete a link not in the config file
    'update',		# update filesystems according to config file. 
    'verbose',		# print a verbose log on stderr. 
    'root=s',		# define root file
    'confile=s', 	# configuration file
    'errfile=s',	# error file
    'logfile=s',	# log file
    'lokfile=s',	# lock file
    'mapfile=s',	# map file
    'modfile=s',	# protection file
    'newfile=s'		# new links
)) { &help; &shutdown; }

# get extra options from program name itself
$main::opt_prog = $0; 
if ($main::opt_prog =~ /\//) {
    my @name = split('/',$main::opt_prog); 
    shift @name while $name[0] eq ''; 
    $main::opt_prog = $name[$#name]; 
}
$main::opt_link     = 1 if ($main::opt_prog eq 'link');
$main::opt_unlink   = 1 if ($main::opt_prog eq 'unlink');
$main::opt_copy     = 1 if ($main::opt_prog eq 'copy');
$main::opt_uncopy   = 1 if ($main::opt_prog eq 'uncopy');
$main::opt_destroy  = 1 if ($main::opt_prog eq 'destroy');
$main::opt_condense = 1 if ($main::opt_prog eq 'condense');
$main::opt_update   = 1 if ($main::opt_prog eq 'update');
$main::opt_clean    = 1 if ($main::opt_prog eq 'clean');
$main::opt_report   = 1 if ($main::opt_prog eq 'report');

$main::opt_confile = &absolute($main::opt_confile,$main::opt_root); 
$main::opt_errfile = &absolute($main::opt_errfile,$main::opt_root); 
$main::opt_logfile = &absolute($main::opt_logfile,$main::opt_root); 
$main::opt_lokfile = &absolute($main::opt_lokfile,$main::opt_root); 
$main::opt_mapfile = &absolute($main::opt_mapfile,$main::opt_root); 
$main::opt_modfile = &absolute($main::opt_modfile,$main::opt_root); 
$main::opt_newfile = &absolute($main::opt_newfile,$main::opt_root); 

if ($main::opt_debug) {
    &log_opt('clean',   $main::opt_clean   ); 
    &log_opt('condense',$main::opt_condense); 
    &log_opt('copy',    $main::opt_copy    ); 
    &log_opt('debug',   $main::opt_debug   ); 
    &log_opt('destroy', $main::opt_destroy ); 
    &log_opt('echo',    $main::opt_echo    ); 
    &log_opt('help',    $main::opt_help    ); 
    &log_opt('link',    $main::opt_link    ); 
    &log_opt('nolock',  $main::opt_nolock  ); 
    &log_opt('nomap',   $main::opt_nomap   ); 
    &log_opt('quiet',   $main::opt_quiet   ); 
    &log_opt('remap',   $main::opt_remap   ); 
    &log_opt('report',  $main::opt_report  ); 
    &log_opt('uncopy',  $main::opt_uncopy  ); 
    &log_opt('update',  $main::opt_update  ); 
    &log_opt('verbose', $main::opt_verbose ); 
    &log_opt('root',    $main::opt_root    ); 
    &log_opt('confile', $main::opt_confile ); 
    &log_opt('errfile', $main::opt_errfile ); 
    &log_opt('logfile', $main::opt_logfile ); 
    &log_opt('lokfile', $main::opt_lokfile ); 
    &log_opt('mapfile', $main::opt_mapfile ); 
    &log_opt('modfile', $main::opt_modfile ); 
    &log_opt('newfile', $main::opt_newfile ); 
    my $argv = join(' ',@ARGV); 
    print STDERR "$main::opt_prog: ARGV=$argv\n"; 
}

# print a single option in human-readable form
sub log_opt {
   my($opt,$value)=@_; 
   $value = "[undefined]" if (! defined ($value)); 
   print STDERR "$main::opt_prog: $opt=$value\n"; 
}

######################################################################
# check options for obvious errors
######################################################################

# check for conflicts 
if ($main::opt_update 
  + $main::opt_report + $main::opt_clean   + $main::opt_condense 
  + $main::opt_link   + $main::opt_unlink  + $main::opt_copy 
  + $main::opt_uncopy + $main::opt_destroy + $main::opt_help > 1) {
    print STDERR "$main::opt_prog: conflicting actions specified!\n"; 
    &help; exit(1); 
}

# check that root directory is one. 
if (! -d $main::opt_root) {
    print STDERR "$main::opt_prog: $main::opt_root is not a directory!\n"; 
    &help; exit(1); 
}

# display help message and quit if asked. 
if ($main::opt_help) { &help; exit(1); } 

######################################################################
# don't let update or condense runs collide 
######################################################################

if ($main::opt_update || $main::opt_condense) {
    if (!&slinkhosts) {
	print STDERR "$main::opt_prog: please make configuration runs ONLY on hosts:\n";
	print STDERR "@main::opt_hosts\n"; 
	print STDERR "$main::opt_prog: exiting!\n"; 
	exit 1; 
    }
    # lock out other instances of slink  
    &lock_set if ! $main::opt_nolock; 
} else {
    $main::opt_nolock = 1; 
}

# register shutdown action to clear lockfiles. 
$SIG{'INT'} = 'shutdown'; 
$SIG{'QUIT'} = 'shutdown'; 

######################################################################
# initialize support libraries 
######################################################################

# start up logging in case later functions cause errors 
$main::logger = new Slink::Logger ({
    'label'  	=> $main::opt_prog,
    'logfile'	=> $main::opt_logfile, 
    'errfile'	=> $main::opt_errfile, 
    'verbose'	=> $main::opt_verbose,
    'echo'	=> $main::opt_echo,
    'debug'	=> $main::opt_debug,
    'quiet'  	=> $main::opt_quiet,
}); 

# start up mapper to record changes 
# must open logger first so there'll be a place to write errors
$main::mapper = new Slink::Mapper ({
    'filename'	=> $main::opt_mapfile,
    'logger'  	=> $main::logger,
    'readmap'  	=> ! $main::opt_remap && ! $main::opt_nomap,
    'writemap' 	=> ! $main::opt_nomap,
}); 

# read protection models
# must open logger first so there'll be a place to write errors
$main::protector = new Slink::Protector({
    'filename'  => $main::opt_modfile,
    'logger'    => $main::logger
}); 

# initialize duper to make filesystem changes 
# must have instances of mapper and protector and logger
# running so that the duper knows what it can do and 
# what logfiles and mapfiles to write

$main::duper = new Slink::Duper ({
    'protector' => $main::protector,
    'mapper'    => $main::mapper,
    'logger'    => $main::logger,
    'dirmode'   => $main::opt_dirmode 
});  

######################################################################
# dispatch an appropriate subtask
######################################################################

if    ($main::opt_link)     { &implement_link;     } 
elsif ($main::opt_unlink)   { &implement_unlink;   } 
elsif ($main::opt_copy)     { &implement_copy;     } 
elsif ($main::opt_uncopy)   { &implement_uncopy;   } 
elsif ($main::opt_destroy)  { &implement_destroy;  } 
elsif ($main::opt_report)   { &implement_report;   } 
elsif ($main::opt_clean)    { &implement_clean;    } 
elsif ($main::opt_condense) { &implement_condense; } 
else			    { &implement_update;   } 

# write out the map
$main::mapper->close if ! $main::opt_nomap; 

# clear lock at the end of execution 
if ($main::opt_update || $main::opt_condense) {
    &lock_clear if ! $main::opt_nolock; 
}

exit(0); 

  ##################################################################
 ####                                                            ####
####            Part 2: Main SLINK Subroutines                    ####
 ####                                                            ####
  ##################################################################

######################################################################
#  implement a configuration change
######################################################################

sub implement_update {
    if (@ARGV>3) {
	print STDERR "$main::opt_prog: expecting at most three arguments!\n"; 
	&help; 
	&shutdown; 
    }
    ($main::opt_sourcmatch,$main::opt_imagematch) = @ARGV; 
    (-r $main::opt_confile) || &shutdie ("cannot read $main::opt_confile"); 

    # initial working directories are / for link image, 
    #  prefix of configuration file for link source. 
    my @cwds = (&Slink::TrueName::prefix($main::opt_confile),'/'); 

    # if a clean link of the whole tree, warn user
    if ($main::opt_sourcmatch eq '' && $main::opt_imagematch eq '') {
    	print STDERR "$main::opt_prog: link whole tree. This will take awhile.\n"; 
    }

    &update_conf($main::opt_confile,@cwds,$main::protector->copy); 

}

######################################################################
#  implement a condensing operation on the configuration file. 
######################################################################

sub implement_condense {
    if (@ARGV>3) {
	print STDERR "$main::opt_prog: expecting at most three arguments!\n"; 
	&help; 
	&shutdown; 
    }
    ($main::opt_sourcmatch,$main::opt_imagematch) = @ARGV; 
    (-r $main::opt_confile) || &shutdie ("cannot read $main::opt_confile"); 

    # initial working directories are / for link image,
    #  prefix of configuration file for link source. 
    my @cwds = (&Slink::TrueName::prefix($main::opt_confile),'/'); 

    # if a clean link of the whole tree, warn user
    if ($main::opt_sourcmatch eq '' && $main::opt_imagematch eq '') {
    	print STDERR "$main::opt_prog: condense whole tree. This takes awhile.\n"; 
    }

    &condense_conf($main::opt_confile,@cwds,$main::protector->copy); 
}

######################################################################
#  implement a forced link not in the configuration file. 
######################################################################

sub implement_link {
    if (@ARGV<2) {
	print STDERR "$main::opt_prog: to force a link, you must specify\n";
	print STDERR "a sourcename and a linkname!\n";
	&help; 
	&shutdown; 
    }

    # first argument is link source, further arguments are images 
    my ($sourc,@images) = @ARGV; 
    my $cwd; 
    $sourc = &absolute($sourc,$cwd); 
    my $image; 
    foreach $image (@images) {
	$image = &absolute($image,$cwd); 
	$main::duper->link_node($sourc,$image);
    }

} 

######################################################################
#  implement a forced unlink not in the configuration file. 
######################################################################

sub implement_unlink {
    if (@ARGV<2) {
	print STDERR "$main::opt_prog: to force an unlink, you must specify\n";
	print STDERR "a sourcename and a linkname!\n";
	&help; 
	&shutdown; 
    }

    # first argument is link source, further arguments are images 
    my ($sourc,@images) = @ARGV; 
    my $cwd; 
    $sourc = &absolute($sourc,$cwd); 
    my $image; 
    foreach $image (@images) {
	$image = &absolute($image,$cwd); 
	$main::duper->unlink_node($sourc,$image);
    }

} 

######################################################################
#  implement a forced copy not in the configuration file. 
######################################################################

sub implement_copy {
    if (@ARGV<2) {
	print STDERR "$main::opt_prog: to force a copy, you must specify\n";
	print STDERR "a sourcename and a copyname!\n";
	&help; 
	&shutdown; 
    }

    # first argument is copy source, further arguments are images 
    my ($sourc,@images) = @ARGV; 
    my $cwd; 
    $sourc = &absolute($sourc,$cwd); 
    my $image; 
    foreach $image (@images) {
	$image = &absolute($image,$cwd); 
	$main::duper->copy_node($sourc,$image);
    }

} 

######################################################################
#  implement a forced uncopy not in the configuration file. 
######################################################################

sub implement_uncopy {
    if (@ARGV<2) {
	print STDERR "$main::opt_prog: to force an uncopy, you must specify\n";
	print STDERR "a sourcename and a copyname!\n";
	&help; 
	&shutdown; 
    }

    # first argument is copy source, further arguments are images 
    my ($sourc,@images) = @ARGV; 
    my $cwd; 
    $sourc = &absolute($sourc,$cwd); 
    my $image; 
    foreach $image (@images) {
	$image = &absolute($image,$cwd); 
	$main::duper->uncopy_node($sourc,$image);
    }

} 

######################################################################
#  implement a forced uncopy not in the configuration file. 
######################################################################

sub implement_destroy {
    if (@ARGV<1) {
	print STDERR "$main::opt_prog: to force a destroy, you must specify\n";
	print STDERR "a thing to destroy!\n";
	&help; 
	&shutdown; 
    }

    # arguments are images 
    my (@images) = @ARGV; 
    my $cwd; 
    my $image; 
    foreach $image (@images) {
	$image = &absolute($image,$cwd); 
	$main::duper->destroy_node($image);
    }

} 

######################################################################
#  implement a report of possible filesystem corruption 
######################################################################

sub implement_report {

    open (NEW, ">$main::opt_newfile") 
	|| &shutdie ("can't write to $main::opt_newfile: $!"); 
    my $tree; my $cwd; 
    foreach $tree (@ARGV) {
	$tree = &absolute($tree,$cwd); 
	$main::logger->verbose("scanning $tree..."); 
	$main::duper->report_node($tree); 
    }

}

######################################################################
#  clean a filesystem of invalid links that point nowhere
######################################################################

sub implement_clean {

    my $tree; my $cwd; 
    foreach $tree (@ARGV) {
	$tree = &absolute($tree,$cwd); 
	$main::logger->verbose("cleaning $tree..."); 
	$main::duper->clean_node($tree); 
    }
}

  ##################################################################
 ####                                                            ####
####            Part 3: forming and destroying slinks             ####
 ####                                                            ####
  ##################################################################

######################################################################
# Form slinks from a configuration file; 
# descend into subfiles as necessary. 
# Preconditions:
#  $main::opt_confile: name of a configuration file to  
#   be processed, which can be either relative 
#   or absolute				 
#  $sourccwd: prefix for relative sources:  	 
#   this is appended to relative addresses   
#   in the first (source) field of the 	 
#   included file. 				 
#  $imagecwd: prefix for relative image 	 
#   locations: this is appended to relative  
#   addresses in the second (image) field of  
#   the included file. 			 
#  Global variables that affect this include:  
#   $main::opt_sourcmatch: source match pattern	  
#   $main::opt_imagematch: image match pattern 	  
#   $main::duper: high-level filesystem operations
#   $main::logger: logging operations 
#   $main::mapper: current link structure. 
# Postconditions: 
# Either 
#  the configuration file exists, 
#  slinks specified in the files are implemented if feasible, 
#  structural changes and errors are noted using $main::logger,
#  $main::mapper is modified to reflect changes in link structure,
#  and the return value is 1. 
# Or 
#  the configuration file doesn't exist, 
#  and the return value is 0. 
######################################################################

sub update_conf {
    my($confile,$sourccwd,$imagecwd,$modtree) = @_; 
    $main::logger->debug("update_conf($confile,$sourccwd,$imagecwd,$modtree)"); 

    # subject high-level operations to appropriate protection
    $main::duper->set_protector($modtree); 

    $main::logger->debug("Forming slinks from file $confile");
    $main::logger->debug("Target working directory is $sourccwd"); 
    $main::logger->debug("Image  working directory is $imagecwd"); 

    if (! -e $confile) {
	return $main::logger->error("$confile doesn't exist -- ignoring!"); 
    } elsif (! -f $confile) {
	return $main::logger->error("$confile isn't a file -- ignoring!"); 
    } elsif (! -r $confile) {
	return $main::logger->error("$confile is unreadable -- ignoring!"); 
    }

    # open and read link file to determine what to do
    open(CONF,"<$confile") 
	|| return $main::logger->error("can't read configuration file $confile: $!"); 
    my (@conflines) = <CONF>; 

    # set up variables for configuration error logging
    $main::logger->options->{'confile'} = $confile; 
    $main::logger->options->{'confline'} = ''; 
    $main::logger->options->{'conflineno'} = 0; 

    # process each line in order
    my $confline = ''; 
    my $conflineno = 0; 
    foreach $confline (@conflines) {
	chomp $confline;  $main::logger->options->{'confline'} = $confline; 
	$conflineno++;    $main::logger->options->{'conflineno'} = $conflineno; 
	next if $confline =~ /^[ \t]*$/ 
	     || $confline =~ /^[ \t]*#/; 
	my (@confline) = split(/[ \t\n]+/,$confline); 
	shift @confline while $confline[0] eq ''; 

	if ($confline[0] eq 'link') {

	    if (@confline>2) {
		# normal link request, just link from the second pathname 
		# to the first pathname; resolve relative pathnames
		my ($dummy,$sourc,@images) = @confline; 
		$sourc = &absolute($sourc,$sourccwd);
		my $trusourc = &truename($sourc); 
		if (! defined $trusourc) {
		    $main::logger->cerror("$sourc doesn't exist -- ignoring line");
		} elsif ($trusourc eq '') {
		    $main::logger->cerror("$sourc is inaccessible -- ignoring line");
		} else {
		    if (index($sourc,$main::opt_sourcmatch)>=0) {
			my $image; 
			foreach $image (@images) {
			    $image = &absolute($image,$imagecwd) ; 
			    $main::duper->link_node($sourc,$image)
				if index($image,$main::opt_imagematch)>=0; 
			}
		    }
		}
	    } else {
		$main::logger->cerror("line doesn't do anything -- ignoring line"); 
	    }

	} elsif ($confline[0] eq 'unlink') {

	    if (@confline>2) {
		# link deletion request: this is like a link creation 
		# request except that it undoes rather than makes a link
		my ($dummy,$sourc,@images) = @confline; 
		$sourc = &absolute($sourc,$sourccwd) ;
		my $trusourc = &truename($sourc); 
		if (! defined $trusourc) {
		    $main::logger->cerror("$sourc doesn't exist -- ignoring line");
		} elsif ($trusourc eq '') {
		    $main::logger->cerror("$sourc is inaccessible -- ignoring line");
		} else {
		    if (index($sourc,$main::opt_sourcmatch)>=0) {
			my $image; 
			foreach $image (@images) {
			    $image = &absolute($image, $imagecwd) ; 
			    $main::duper->unlink_node($sourc,$image)
				if index($image,$main::opt_imagematch)>=0; 
			}
		    }
		}
	    } else {
		$main::logger->cerror("line doesn't do anything -- ignoring line"); 
	    }

	} elsif ($confline[0] eq 'copy') {

	    if (@confline>2) {
		# copy a file into a tree: this is like a link creation 
		# request except that it physically copies a file rather than 
		# linking to it. 
		my ($dummy,$sourc,@images) = @confline; 
		$sourc = &absolute($sourc,$sourccwd) ;
		my $trusourc = &truename($sourc); 
		if (! defined $trusourc) {
		    $main::logger->cerror("$sourc doesn't exist -- ignoring line");
		} elsif ($trusourc eq '') {
		    $main::logger->cerror("$sourc is inaccessible -- ignoring line");
		} else {
		    if (index($sourc,$main::opt_sourcmatch)>=0) {
			my $image; 
			foreach $image (@images) {
			    $image = &absolute($image, $imagecwd) ; 
			    $main::duper->copy_node($sourc,$image)
				if index($image,$main::opt_imagematch)>=0; 
			}
		    }
		}
	    } else {
		$main::logger->cerror("line doesn't do anything -- ignoring line"); 
	    }

	} elsif ($confline[0] eq 'uncopy') {

	    if (@confline>2) {
		# uncopy a file from a tree: this is like a copy 
		# request except that it undoes the effect of a copy. 
		my ($dummy,$sourc,@images) = @confline; 
		$sourc = &absolute($sourc, $sourccwd) ;
		my $trusourc = &truename($sourc); 
		if (! defined $trusourc) {
		    $main::logger->cerror("$sourc doesn't exist -- ignoring line");
		} elsif ($trusourc eq '') {
		    $main::logger->cerror("$sourc is inaccessible -- ignoring line");
		} else {
		    if (index($sourc,$main::opt_sourcmatch)>=0) {
			my $image; 
			foreach $image (@images) {
			    $image = &absolute($image,$imagecwd) ; 
			    $main::duper->uncopy_node($sourc,$image)
				if index($image,$main::opt_imagematch)>=0; 
			}
		    }
		}
	    } else {
		$main::logger->cerror("line doesn't do anything -- ignoring line"); 
	    }

	} elsif ($confline[0] eq 'destroy') {

	    if (@confline>1) {
		# destroy one or more nodes in a tree
		my ($dummy,@images) = @confline; 
		my $image; 
		foreach $image (@images) {
		    $image = &absolute($image, $imagecwd) ;
		    $main::duper->destroy_node($image)
			if index($image,$main::opt_imagematch)>=0; 
		}
	    } else {
		$main::logger->cerror("line doesn't do anything -- ignoring line"); 
	    }

	} elsif ($confline[0] eq 'cd' || $confline[0] eq 'chdir') {

	    if (@confline>1) {
		# change working directories
		my($dummy,$newsourccwd,$newimagecwd)=@confline;

		# get a new current directory list to manipulate
		if (! defined $newsourccwd || $newsourccwd eq '"') {
		    $newsourccwd = $sourccwd; 
		} else {				# relative to current
		    $newsourccwd = &absolute($newsourccwd,$sourccwd);
		}
		# warn user of possibly bogus references 
		if ($newsourccwd ne '' && $newsourccwd !~ /^\//) {
		    $main::logger->cerror("source prefix is RELATIVE $newsourccwd\n (so relative source nodes may be bogus)"); 
		}

		# get a new current directory list to manipulate
		if (! defined $newimagecwd || $newimagecwd eq '"') {
		    $newimagecwd = $imagecwd; 
		} else {				# relative to current
		    $newimagecwd = &absolute($newimagecwd,$imagecwd);
		}
		# warn user of possibly bogus references 
		if ($newimagecwd ne '' && $newimagecwd !~ /^\//) {
		    $main::logger->cerror("image prefix is RELATIVE $newimagecwd\n (so relative image nodes may be bogus)\n"); 
		}

		# relativize current directory settings with respect to listed 
		# directories WITHOUT including a file to do so
		($sourccwd,$imagecwd) = ($newsourccwd,$newimagecwd); 
	    } else {
		$main::logger->cerror("improper cd command -- ignoring line"); 
	    }

	} elsif ($confline[0] eq 'include') {

	    if (@confline>1 && @confline<=4) {
		# include another configuration file
		my($dummy,$newconf,$newsourccwd,$newimagecwd)=@confline;

		# if file is not absolute, then make absolute 
		$newconf = &absolute($newconf,$sourccwd); 

		# get a new current directory list to manipulate
		if (! defined $newsourccwd || $newsourccwd eq '"') {
		    $newsourccwd = $sourccwd; 
		} else {				# relative to current
		    $newsourccwd = &absolute($newsourccwd,$sourccwd);
		}
		# warn user of possibly bogus references 
		if ($newsourccwd ne '' && $newsourccwd !~ /^\//) {
		    $main::logger->cerror("source prefix is RELATIVE $newsourccwd\n (so relative source nodes may be bogus)"); 
		}

		# get a new current directory list to manipulate
		if (! defined $newimagecwd || $newimagecwd eq '"') {	
		    $newimagecwd = $imagecwd; 
		} else {				# relative to current
		    $newimagecwd = &absolute($newimagecwd,$imagecwd);
		}
		# warn user of possibly bogus references 
		if ($newimagecwd ne '' && $newimagecwd !~ /^\//) {
		    $main::logger->cerror("image prefix is RELATIVE $newimagecwd\n (so relative image nodes may be bogus)\n"); 
		}

		# everything's corrected -> recurse
		# make a copy of the model tree before recursing 
		if (! &update_conf($newconf,$newsourccwd,
				   $newimagecwd,$modtree->copy)) {
		    $main::logger->cerror("previous error(s) occurred during this delegation."); 
		} 

		# restore old main::logger state
		$main::duper->set_protector($modtree); 
	        $main::logger->options->{'confile'} = $confile; 
	        $main::logger->options->{'confline'} = $confline; 
	        $main::logger->options->{'conflineno'} = $conflineno; 
	    } else {
		$main::logger->cerror('improper include directive -- ignoring line'); 
	    }

	} else {
	    if (! $modtree->parse($imagecwd,@confline)) {
		$main::logger->cerror("unknown command $confline[0]"); 
	    }
	}
    }
    return 1; 	# found configuration file OK
}

  ##################################################################
 ####                                                            ####
####            Part 4: Condensing confluent structures           ####
 ####                                                            ####
  ##################################################################

######################################################################
# Condense links in a configuration file         
# Interpret a configuration file slink.conf and  
# descend into subfiles as necessary 		  
# Preconditions: arguments are 		  
#  $confile: name of a configuration file to   
#   be processed, which can be either relative 
#   or absolute				  
#  $sourccwd: prefix for relative sources:   	  
#   this is appended to relative addresses     
#   in the first (source) field of the 	  
#   included file. 				  
#  $imagecwd: prefix for relative image 	  
#   locations: this is appended to relative    
#   addresses in the second (image) field of   
#   the included file.  			  
#  Global variables that affect this include:   
#   $main::opt_sourcmatch: source match pattern	  
#   $main::opt_imagematch: image match pattern 	  
#   $main::duper: high-level filesystem operations
#   $main::logger: logging operations 
#   $main::mapper: current link structure. 
# Postconditions: 
# Either 
#  the configuration file exists, 
#  slinks specified in the files are condensed if feasible, 
#  structural changes and errors are noted using $main::logger. 
#  $main::mapper is modified to reflect changes in link structure,
#  and the return value is 1. 
# Or 
#  the configuration file doesn't exist, 
#  and the return value is 0. 
######################################################################

sub condense_conf {
    my($confile,$sourccwd,$imagecwd,$modtree) = @_; 
    $main::logger->debug("condense_conf($confile,$sourccwd,$imagecwd,$modtree)"); 

    # subject high-level operations to appropriate protection
    $main::duper->set_protector($modtree); 

    $main::logger->debug("Condensing slinks from file $confile");
    $main::logger->debug("Target working directory is $sourccwd"); 
    $main::logger->debug("Image  working directory is $imagecwd"); 

    if (! -e $confile) {
	return $main::logger->error("$confile doesn't exist -- ignoring!"); 
    } elsif (! -f $confile) {
	return $main::logger->error("$confile isn't a file -- ignoring!"); 
    } elsif (! -r $confile) {
	return $main::logger->error("$confile is unreadable -- ignoring!"); 
    }

    # open and read link file to determine what to do
    open(CONF,"<$confile") 
	|| return $main::logger->error("can't open configuration file $confile: $!"); 
    my (@conflines) = <CONF>; 

    # set up variables for configuration error logging
    $main::logger->options->{'confile'} = $confile; 
    $main::logger->options->{'confline'} = ''; 
    $main::logger->options->{'conflineno'} = 0; 

    # process each line in order
    my $confline = ''; 
    my $conflineno = 0; 
    foreach $confline (@conflines) {
	chomp $confline;  $main::logger->options->{'confline'} = $confline; 
	$conflineno++;    $main::logger->options->{'conflineno'} = $conflineno; 
	next if $confline =~ /^[ \t]*$/ 
	     || $confline =~ /^[ \t]*#/; 
	my (@confline) = split(/[ \t\n]+/,$confline); 
	shift @confline while $confline[0] eq ''; 

	if ($confline[0] eq 'link') {

	    if (@confline>2) {
		# normal link request, just link from the second pathname 
		# to the first pathname; resolve relative pathnames
		my ($dummy,$sourc,@images) = @confline; 
		$sourc = &absolute($sourc,$sourccwd) ;
		my $trusourc = &truename($sourc); 
		if (! defined $trusourc) {
		    $main::logger->cerror("$sourc doesn't exist -- ignoring line");
		} elsif ($trusourc eq '') {
		    $main::logger->cerror("$sourc is inaccessible -- ignoring line");
		} else {
		    if (index($sourc,$main::opt_sourcmatch)>=0) {
			my $image; 
			foreach $image (@images) {
			    $image = &absolute($image,$imagecwd) ;
			    $main::duper->condense_node($sourc,$image)
				if index($image,$main::opt_imagematch)>=0; 
			}
		    }
		}
	    } else {
		$main::logger->cerror("line doesn't do anything -- ignoring line"); 
	    }

	} elsif ($confline[0] eq 'unlink') {

	    if (@confline>2) {
		# link deletion request: this is like a link creation 
		# request except that it undoes rather than makes a link
		my ($dummy,$sourc,@images) = @confline; 
		$sourc = &absolute($sourc,$sourccwd) ;
		my $trusourc = &truename($sourc); 
		if (! defined $trusourc) {
		    $main::logger->cerror("$sourc doesn't exist -- ignoring line");
		} elsif ($trusourc eq '') {
		    $main::logger->cerror("$sourc is inaccessible -- ignoring line");
		} else {
		    if (index($sourc,$main::opt_sourcmatch)>=0) {
			my $image; 
			foreach $image (@images) {
			    $image = &absolute($image,$imagecwd) ;
			    $main::duper->unlink_node($sourc,$image)
				if index($image,$main::opt_imagematch)>=0; 
			}
		    }
		}
	    } else {
		$main::logger->cerror("line doesn't do anything -- ignoring line"); 
	    }

	} elsif ($confline[0] eq 'copy') {
	
	    if (@confline>2) {
		# don't do anything with copy requests during a condense
	    } else {
		$main::logger->cerror("line doesn't do anything -- ignoring line"); 
	    }

	} elsif ($confline[0] eq 'uncopy') {

	    if (@confline>2) {
		# uncopy a file from a tree: this is like a copy 
		# request except that it undoes the effect of a copy. 
		my ($dummy,$sourc,@images) = @confline; 
		$sourc = &absolute($sourc,$sourccwd) ;
		my $trusourc = &truename($sourc); 
		if (! defined $trusourc) {
		    $main::logger->cerror("$sourc doesn't exist -- ignoring line");
		} elsif ($trusourc eq '') {
		    $main::logger->cerror("$sourc is inaccessible -- ignoring line");
		} else {
		    if (index($sourc,$main::opt_sourcmatch)>=0) {
			my $image; 
			foreach $image (@images) {
			    $image = &absolute($image,$imagecwd) ; 
			    $main::duper->uncopy_node($sourc,$image)
				if index($image,$main::opt_imagematch)>=0; 
			}
		    }
		}
	    } else {
		$main::logger->cerror("line doesn't do anything -- ignoring line"); 
	    }

	} elsif ($confline[0] eq 'destroy') {

	    if (@confline>1) {
		# destroy one or more nodes in a tree
		my ($dummy,@images) = @confline; 
		my $image; 
		foreach $image (@images) {
		    $image = &absolute($image,$imagecwd) ;
		    $main::duper->destroy_node($image)
			if index($image,$main::opt_imagematch)>=0; 
		}
	    } else {
		$main::logger->cerror("line doesn't do anything -- ignoring line"); 
	    }

	} elsif ($confline[0] eq 'cd' || $confline[0] eq 'chdir') {

	    if (@confline>1) {
		# change working directories
		my($dummy,$newsourccwd,$newimagecwd)=@confline;

		# get a new current directory list to manipulate
		if (! defined $newsourccwd || $newsourccwd eq '"') {
		    $newsourccwd = $sourccwd; 
		} else {				# relative to current
		    $newsourccwd = &absolute($newsourccwd,$sourccwd);
		}
		# warn user of possibly bogus references 
		if ($newsourccwd ne '' && $newsourccwd !~ /^\//) {
		    $main::logger->cerror("source prefix is RELATIVE $newsourccwd\n (so relative source nodes may be bogus)"); 
		}

		# get a new current directory list to manipulate
		if (! defined $newimagecwd || $newimagecwd eq '"') {
		    $newimagecwd = $imagecwd; 
		} else {				# relative to current
		    $newimagecwd = &absolute($newimagecwd,$imagecwd);
		}
		# warn user of possibly bogus references 
		if ($newimagecwd ne '' && $newimagecwd !~ /^\//) {
		    $main::logger->cerror("image prefix is RELATIVE $newimagecwd\n (so relative image nodes may be bogus)"); 
		}

		# relativize current directory settings with respect to listed 
		# directories WITHOUT including a file to do so
		($sourccwd,$imagecwd) = ($newsourccwd,$newimagecwd); 
	    } else {
		$main::logger->cerror("improper cd command -- ignoring line"); 
	    }

	} elsif ($confline[0] eq 'include') {
	
	    if (@confline>1 && @confline<=4) {
		# include another configuration file
		my($dummy,$newconf,$newsourccwd,$newimagecwd)=@confline;

		# if file is not absolute, then make absolute 
		$newconf = &absolute($newconf,$sourccwd) ;

		# get a new current directory list to manipulate
		if (! defined $newsourccwd || $newsourccwd eq '"') {
		    $newsourccwd = $sourccwd; 
		} else {				# relative to current
		    $newsourccwd = &absolute($newsourccwd,$sourccwd);
		}
		# warn user of possibly bogus references 
		if ($newsourccwd ne '' && $newsourccwd !~ /^\//) {
		    $main::logger->cerror("source prefix is RELATIVE $newsourccwd\n (so relative source nodes may be bogus)"); 
		}

		# get a new current directory list to manipulate
		if (! defined $newimagecwd || $newimagecwd eq '"') {
		    $newimagecwd = $imagecwd; 
		} else {				# relative to current
		    $newimagecwd = &absolute($newimagecwd,$imagecwd);
		}
		# warn user of possibly bogus references 
		if ($newimagecwd ne '' && $newimagecwd !~ /^\//) {
		    $main::logger->cerror("image prefix is RELATIVE $newimagecwd\n (so relative image nodes may be bogus)\n"); 
		}

		# everything's corrected -> recurse
		if (! &condense_conf( $newconf,$newsourccwd,
				      $newimagecwd,$modtree->copy)) {
		    $main::logger->cerror("previous error(s) occurred during this delegation."); 
		}

		# restore old main::logger state
		$main::duper->set_protector($modtree); 
	        $main::logger->options->{'confile'} = $confile; 
	        $main::logger->options->{'confline'} = $confline; 
	        $main::logger->options->{'conflineno'} = $conflineno; 
	    } else {
		$main::logger->cerror('improper include directive -- ignoring line'); 
	    }

	} else {
	    if (! $modtree->parse($imagecwd,@confline)) {
		$main::logger->cerror("unknown command $confline[0]"); 
	    }
	}
    }
    return 1; 	# found configuration file OK
}

######################################################################
# locking mechanism keeps two major slink
# instances from running at the same time.
######################################################################

sub lock_set {
    if (-e $main::opt_lokfile) {
	open(PIDFILE, "<$main::opt_lokfile") 
	    || die "Can't write $main::opt_lokfile: $!\n";
	$_ = <PIDFILE>; chop $_; 
        close(PIDFILE); 
	my ($pid, $uid, $user, $predate) = split(/\t/, $_);
	my $pidcheck = system("$main::cmd_ps -p $pid 1> /dev/null 2>&1");
	if (!$pidcheck) { 
	    print STDERR 
		"slink: already running!";
	    print STDERR 
		"slink: $user ($uid) started slink at $predate (pid $pid)\n";
	    print STDERR 
		"slink: exiting!\n";
	    exit 1;
	} else {
	    print STDERR 
		"slink: $user ($uid) left old lock $main::opt_lokfile from $predate\n";
	    unlink($main::opt_lokfile) 
		|| die "can't remove dead lockfile $main::opt_lokfile: $!\n";
	}
    }

    open(PIDFILE, ">$main::opt_lokfile") 
	|| die "can't write $main::opt_lokfile: $!\n";
    my $date = &main::ctime(time); chop $date; 
    print PIDFILE "$$\t$<\t$ENV{'USER'}\t$date\n";
    close PIDFILE;
    chmod 0666,$main::opt_lokfile; 
}

# clear a previously set lock. 
sub lock_clear {
    if (-f $main::opt_lokfile) {
	unlink($main::opt_lokfile) 
	    || die "$main::opt_prog: cannot remove lockfile $main::opt_lokfile: $!"; 
    }
}

######################################################################
# determine whether it's OK to run or not. 
# return 1 if OK to run, 0 if not. 
######################################################################

sub slinkhosts {
    my($host) = $ENV{'HOST'}; 
    return 1 if @main::opt_hosts == 0 || ! defined $host; 
    my $allowed; 
    foreach $allowed (@main::opt_hosts) {
	return 1 if $host eq $allowed;
    }
    return 0;
}

# shut down perl and remove lock files
sub shutdown {
    print STDERR "$main::opt_prog: shutting down...\n"; 
    &lock_clear if ! $main::opt_nolock; 
    exit 1; 
}

# print message and shut down. 
sub shutdie {
    my ($message) = @_; 
    print STDERR "$main::opt_prog: $message\n"; 
    &shutdown; 
}

sub END {
    &lock_clear if ! $main::opt_nolock; 
}