#!/usr/bin/perl
# Make local directories mirror images of a remote sites
# By Lee McLoughlin <lmjm@doc.ic.ac.uk>
#  You can do what you like with this except claim that you wrote it or
#  give copies with changes not approved by Lee.  Neither Lee nor any other
#  organisation can be held liable for any problems caused by the use or
#  storage of this package.
#
# $Header: /a/swan/home/swan/staff/csg/lmjm/src/perl/mirror/RCS/mirror.pl,v 1.32 1992/03/20 21:01:07 lmjm Exp lmjm $
# $Log: mirror.pl,v $
# Revision 1.32  1992/03/20  21:01:07  lmjm
# Cleaned up disconnect on error code.
# Allow for uncompressing listing files.
# Black magic the mail_prog variable to allow for more meaningful subject lines.
# Added the TEMPORARY flag really_do_delete
# Added proxy code from Edwards Reed.
# Added flags_recursive and flags_nonrecursive.
# Added delete_source
# Added disconnect - force close at end of package even next package at same site
# Allow variables to be read from a file if first char is a <
#
# Revision 1.31  1992/02/06  23:25:58  lmjm
# Use /usr/bin/perl.
# Added -L option.
# Use new ftp.pl routines
#
# Revision 1.30  1992/01/14  11:02:55  lmjm
# Corrected '-s arg' in mail_prog.
# Added local_ls_lR_file - useful when first copying a large remote package
# Corrected set_assoc_from_array.
#
# Revision 1.29  1991/12/18  16:58:04  lmjm
# Just have a mail_prog variable with the '-s subject' as part of it.
# Start on new -M option, load the mirror.defaults file and scan
#  packages dir.
# Added -Rpackage - like -p but restarts a full-pull from that package.
# Get the chdir in the right place so <> doesn't bomb.
#
# Revision 1.28  1991/12/06  18:13:48  lmjm
# DONT use if( $path ) as a test to see if path is there.  Fails if path
# is the pathname "0" !!!
#
# Revision 1.27  1991/12/03  15:00:47  lmjm
# Moved boolean_values and packages into an associative array, for speed.
#
# Revision 1.26  1991/12/03  13:52:54  lmjm
# Added a chdir to make sure that <> works ok.
# Added in patches from Amos to speed up the greps and fix splits.
# Made the error prints for split's more helpful.
#
# Revision 1.25  1991/11/27  22:06:01  lmjm
# Allow the associative arrays to be held in files - for very large directories.
# Allow files to be split up.
# Added 'a' to ls options.
# Don't use filensames in printf format strings! (may contain a %)
# Prod the remote server every nce and a while to keep the connection open.
#
# Revision 1.24  1991/10/23  22:42:26  lmjm
# Upped the timeout.
# Turned buffering back on again.  I was mistaken in what effect it was having.
# Call chat'close where necessary.
# Added ls_lR_file option.
# Try and allow for time zone changes when comparing dates.
#
# Revision 1.23  1991/10/07  18:30:39  lmjm
# Added restarts.
# Some more patches from Amos Shapira to correct somewhat dumb confile file loop.
# Also now uses the value not the default value in key+value operations.
# Neatened up error messages
#
# Revision 1.22  1991/10/02  14:48:49  lmjm
# Corrected escaping of values.
# Corrected use of ftp'restart (patch from Amos Shapira)
# Corrected $user and $group resetting and arguments to chgrp.
#
# Revision 1.21  1991/09/24  01:21:20  lmjm
# Look at the right var to decide if there is mail to send.
#
# Revision 1.20  1991/09/20  22:31:19  lmjm
# Make the output look prettier!
# Corrected some typos.
#
# Revision 1.19  1991/09/20  21:13:09  lmjm
# Gave -U a default.
#
# Revision 1.18  1991/09/20  20:55:34  lmjm
# Added an -Ufile option just to record uploads.
#
# Revision 1.17  1991/09/17  22:53:18  lmjm
# Avoid the CHMOD check unless necessary
# More playing with debug levels.
# Added back in the timestamp code.
#
# Revision 1.16  1991/09/12  22:40:27  lmjm
# Changed arguments over to be more compatible with the original.
# Don't mirror a remote site if it is really the local host!
# Added deletion code.
# Made prompt for password more meaningful.
#
# Revision 1.15  1991/09/06  19:53:54  lmjm
# Merged in considerable changes by Alan Martllo for sending files,
# plus command line work, plus internal changes to work as a series of steps...
# Changed debug printing to be a little more appropriate.
#
# Revision 1.14  1991/09/04  14:17:02  lmjm
# Made debug level 1 more useful.
# Print site:remote_dir (not local_dir) in messages.
#
# Revision 1.13  1991/08/29  16:23:53  lmjm
# Added some new keywords.
# Stay connected to the site when done in case next entry is from the same
# site.
# Only die on really fatal errors.
# Treat symlinks more like files when checking it.
#
# Revision 1.12  1991/08/21  10:45:58  lmjm
# Allow for line continuation (& at end of line)
# Don't create local dirs or symlinks when -n turned on.
#
# Revision 1.11  1991/08/20  11:51:52  lmjm
# added more detail to the log and mail messages.
# Correct the timestamp code.
#
# Revision 1.10  1991/08/19  09:53:41  lmjm
# Corrected -p, was pushing wrong variable
#
# Revision 1.9  1991/08/16  22:30:06  lmjm
# Added -v option to print the version.
#
# Revision 1.8  1991/08/16  22:17:45  lmjm
# Added the -T option to re-timestamp the local archive.
# Check the argument to the -p flag.
# Added the update_local option.
# Allow key+value
# Tried to make the logging messages more meaningful.
#
# Revision 1.7  1991/08/14  21:02:47  lmjm
# Implement mail_to, update_log, compress_patt and compress_excl
# Local directory scaned by direct perl.
# Allow for unreadable files.
#
# Revision 1.6  1991/08/14  17:50:14  lmjm
# Short circuit mkdirs if the path already exists.
# Added in the compression code.
#
# Revision 1.5  1991/08/09  22:31:01  lmjm
# Added a simple name_mappings (it can be a single s/// expression)
# get_file via a temp file
# Corrected (YET AGAIN) the max_age code.
# Made mkdirs more sensible.
#
# Revision 1.4  1991/08/09  21:35:02  lmjm
# Parse args rather than use -s.
# Added -pPackage arg to limit packages looked at.
# Reset all the logging levels.
#
# Revision 1.3  1991/08/09  20:10:15  lmjm
# Now use the package keyword to name entries.
# Don't recurse by setting a suitable exclude_patt
# Corrected age checking and null directory creation.
#
# Revision 1.2  1991/08/09  18:06:56  lmjm
# Call chown/chgrp if necessary.
# Quit remote site correctly
# Compared time the wrong way around
# Create dirs/symlinks locally.
# Set file/dir modes
#
# Revision 1.1  1991/08/08  20:19:27  lmjm
# Initial revision
#

$defaults_file = 'mirror.defaults';

# Define $chowngrp if your chown takes user.group as an arg
$chowngrp = '/usr/etc/chown';
$chown = '/usr/etc/chown';
$chgrp = '/usr/bin/chgrp';
$compress_prog = '/usr/ucb/compress';
$uncompress_prog = '/usr/ucb/uncompress';

# A mail program that can be called as: "$mail_prog person_list'
# Can be overridden with the mail_prog keyword.
# SPECIAL NOTE: This line is eval'd, so DONT put double-quotes (") in it.
# You can get local variables to appear as in the second example:
$mail_prog = '/usr/bin/mail -s \'mirror update\'';
# $mail_prog = '/usr/bin/mail -s \'mirror update of $package\'';

# Used to remove directory heirarchies
$rm_prog = "/bin/rm -rf ";

# Generate checksums
$sum_prog = "/usr/bin/sum";

# When scanning the local directory how often to prod the remote
# system to keep the connection alive
$prod_interval = 90;

# Make sure that your PERLLIB environment variable can get you
# all these
require 'getopts.pl';
require 'ftp.pl';
require 'chat2.pl';
require 'lsparse.pl';
require 'dateconv.pl';
require 'socket.ph';

# Find some local details
chop( $home = `pwd` );
chop( $hostname = `hostname` );
if( $hn = (gethostbyname( "$hostname" ))[ 0 ] ){
	$hostname = $hn;
}
$me = $ENV{ 'USER' };

$retry_pause = 60;		# Pause before retrying
$squished = '\.[zZ]$';		# Files matching this pattern are usually compressed

# If connected to a site then this holds the site name.
$connected = '';

# If mirroring a VERY large directory then it is best to put the assoc
# arrays in files
$use_files = 0;
$tmp = "/tmp";
@assocs = ( 'local_time', 'local_size', 'local_type', 'local_mode',
	    'remote_time', 'remote_size', 'remote_type', 'remote_mode' );

# Create a reasonable set of defaults
$default{ 'package' } = '';	# should be a unique handle for the "lump" to be mirrored
$default{ 'comment' } = '';	# General comment used in report
$default{ 'skip' } = '';	# If set then skip this entry giving value as reason
$default{ 'site' } = '';	# site to connect to
$default{ 'remote_dir' } = '';	# remote directory to mirror
$default{ 'local_dir' } = '';	# local directory to copy into
$default{ 'remote_user' } = 'anonymous';  # the remote guest account name
$default{ 'remote_password' } = "$me@$hostname";
$default{ 'get_patt' } = ".";	# regex of pathnames to retrieve
$default{ 'exclude_patt' } = ''; # regex of pathnames to ignore
$default{ 'update_local' } = 0;	# Don't just update local dirs
$default{ 'local_ignore' } = ''; # regex of local pathnames to totally ingnore
$default{ 'do_deletes' } = 0;	# delete local files if not in remote
$default{ 'really_do_deletes' } = 0; # actually do deletions!
$default{ 'delete_excl' } = ''; # regex of local pathnames to ignore when deleting
$default{ 'max_days' } = 0;	# Ignore age of file
$default{ 'split_max' } = 0;	# Files > this size can be split up.
$default{ 'split_patt' } = '';  # Files must match this pattern to be split
$default{ 'split_chunk' } = 100 * 1024; # Size of split-up chunks
$default{ 'ls_lR_file' } = '';	# remote file containing ls-lR - else use remote ls
$default{ 'local_ls_lR_file' } = '';	# local file containing ls-lR - useful when first copying a large remote package
$default{ 'name_mappings' } = '';# remote to local pathname mappings (eg s:old:new)
$default{ 'get_newer' } = 1;	# get the remote file if its date is newer than local
$default{ 'get_size_change' } = 1; # get the file if size if different than local
$default{ 'compress_patt' } = ''; # compress files matching this pattern
$default{ 'compress_excl' } = $squished; # dont compress regexp
$default{ 'force_times' } = 1;	# Force local file times to match the original
$default{ 'retry_call' } = 1;	# Retry the call if it fails first time
$default{ 'update_log' } = '';	# Filename where an update report is to be kept
$default{ 'mail_to' } = '';	# Mail a report to these addresses
$default{ 'user' } = '';	# UID/user name to give to local pathnames
$default{ 'group' } = '';	# GID/group name to give to local pathnames
$default{ 'file_mode' } = 0444;	# Mode to give files created locally
$default{ 'dir_mode' } = 0755;	# mode to give directories created locally
$default{ 'timeout' } = 40;	# timeout ftp requests after this many seconds
$default{ 'ftp_port' } = 21;	# port number of remote ftp daemon
$default{ 'proxy' } = 0;	# normally use regular ftp
$default{ 'proxy_ftp_port' } = 4514; # default from Sun
$default{ 'proxy_gateway' } = $ENV{ 'INTERNET_HOST' };	# used if($proxy) 
$default{ 'recursive' } = 1;	# flag indicating if we need to do recursive processing
$default{ 'flags_recursive' } = '-lRat'; # Flags passed to remote dir
$default{ 'flags_nonrecursive' } = '-lat'; # Flags passed to remote dir
$default{ 'mode_copy' } = 0;	# flag indicating if we need to copy the mode bits
$default{ 'interactive' } = 0;	# noninteractive copy default
$default{ 'text_mode' } = 0;	# transfer in binary mode by default
$default{ 'force' } = 0;	# don't force by default
$default{ 'get_file' } = 1;	# perform get, not put by default
$default{ 'verbose' } = 0;	# Verbose messages
$default{ 'remote_fs' } = 'unix'; # Remote filestore
$default{ 'mail_prog' } = $mail_prog; # the mail programme (see $mail_prog)
$default{ 'delete_source' } = 0;# delete source after xfer (default = NO!!!)
$default{ 'disconnect' } = 0;	# Force close at end of package EVEN if
				# next package is to the same site

@boolean_values = ( 'get_newer', 'get_size_change', 'do_deletes', 'update_local',
	'force_times', 'retry_call', 'recursive', 'mode_copy', 'disconnect',
	'interactive', 'text_mode', 'force', 'get_file', 'verbose', 'proxy',
	'delete_source', 'really_do_deletes' );
%boolean_values = ();
&set_assoc_from_array( *boolean_values );

@regexp_values = ( 'get_patt', 'exclude_patt', 'local_ignore',
		  'delete_excl', 'split_patt',
		  'compress_patt', 'compress_excl' );

#
#  -cconfig_file
#  -m 		(same as "-kmode_copy=true"
#  -sSITENAME	(same as "-ksite=SITENAME) 
#  -uUSERNAME	(same as "-kremote_user=USERNAME", prompts for remote_password)
#  -t 		(same as "-ktext_mode=true")
#  -P 		(same as "-kget_file=false -kinteractive=true")
#  -G		(same as "-kget_file=true -kinteractive=true")
#  -f		(same as "-kforce=true")
#  -r		(same as "-krecursive=false")
while( $ARGV[ 0 ] =~ /^-/ ){
	local( $arg ) = shift;

	if( $arg eq '-M' ){
		# Use a master config file - still in progress
		if( ! -r $defaults_file ){
			die "No file: $defaults_file";
		}
		push( @config_files, $defaults_file );
		
		# Add all the config files from the configs directories
		&add_all_files( 'packages' );
		next;
	}

        if( $arg eq '-L' ){
                # Generate a pretty list of what is being mirrored
                $pretty_print = 1;
                next;
        }

	if( $arg eq '-d' ){
# Hack: everything works a LOT more reliably with buffering turned off.
		$| = 1;

		$debug++;
		next;
	}
	if( $arg =~ /-v/ ){
		print '$Id: mirror.pl,v 1.32 1992/03/20 21:01:07 lmjm Exp lmjm $' . "\n";
		exit;
	}

	if( $arg eq '-F' ){
		# Use files for the dir listings assoc lookups
		$use_files = 1;
		next;
	}
	if( $arg eq '-T' ){
		# Don't actually get any files but just force
		# local timestamps to be the same on the remote system
		$timestamp++;
		$command_line{ 'force' } = 'true';
		next;
	}
	if( $arg eq '-n' ){
		# Do nothing - use with debugging to show what would be
		# done
		$dont_do = 1;
		$debug = 2;
		$| = 1;
		next;
	}
	if( $arg =~ /^-(p)(.*)/ || $arg =~ /^-(R)(.*)/ ){
		local( $flag, $p ) = ($1, $2);
		if( $flag eq 'R' ){
			# Skip all packages till a match is made
			# then process ALL further packages
			$skip_till = 1;
		}
		if( $p !~ /[a-zA-Z0-9]/ ){
			die "Invalid package name to -p of: $p\n";
			next;
		}
		# Only mirror the named packages
		$do_packages{ $p } = 1;
		$limit_packages = 1;
		next;
	}
	if( $arg =~ /^-C(.*)/ ){
		# specify the config file
		local( $c ) = $1;
		if( $c !~ /./ ){
			die "Must give config file name -Cname ($arg)\n";
		}
		# Only mirror the named packages
	        push( @config_files, $c);
		next;
	}
        if( $arg eq '-m' ) {
                # propogate the mode
		$command_line{ 'mode_copy' } = 'true';
		next;
        }
        if( $arg eq '-P' ) {
                # put files
		$command_line{ 'get_file' } = 'false';
		$command_line{ 'interactive' } = 'true';
		next;
        }
        if( $arg eq '-G' ) {
                # get files
		$command_line{ 'get_file' } = 'true';
		$command_line{ 'interactive' } = 'true';
		next;
        }
        if( $arg eq '-t' ) {
                # set the file mode to text
		$command_line{ 'text_mode' } = 'true';
		next;
        }
        if( $arg eq '-f' ) {
                # set force mode
		$command_line{ 'force' } = 'true';
		next;
        }
	if( $arg =~ /^-s(.*)/ ){
		# override the site name
		$command_line{ 'site' } = $1;
		next;
	}
	if( $arg eq "-r" ){
		# no recursive copy
		$command_line{ 'recursive' } = 0;
		next;
	}
	if( $arg =~ /^-k(.*)=(.*)/ ) {
	 	# set the keyword = value
		if( !defined( $default{ "$1" } ) ) {
			print "Invalid keyword $1\n";
		} else {
			$command_line{ "$1" } = $2;
		}
		next;
	}
	if( $arg =~ /^-u(.*)/ ){
		local( $pass );

		# override the user name
	        $command_line{ 'remote_user' } = $1;
		# and ask for a password
		$command_line{ 'remote_password' } = &get_passwd( $1 );
		next;
	}
	if( $arg =~ /^-U(.*)/ ){
		$upload_log = $1;
		if( $upload_log eq '' ){
			local($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) 
				= gmtime(time);
			$mon++;
			$upload_log = "$home/upload_log.$mday.$mon.$year";
		}
			
		next;
	}
	print "Unknown arg $arg, skipping\n";
}

# Handl multi-line buffers in a sane way
$* = 1;

$interactive = $command_line{ 'interactive' };

if( ! $interactive ){
	local( $c );

	# The remainder of ARGV are package names
	foreach $c ( @ARGV ){
		push( @config_files, $c );
	}
}


if( $interactive && $limit_packages){
	die "Can not mix -p and interactive";
}

&set_defaults();

&interpret_config_files();

# Shut down any remaining ftp session
&disconnect();

print "All done, Exiting\n" if $debug;
exit( 0 );



$key = ''; # The current keyword
$value = ''; # the value for the keyword

sub interpret_config_files
{
	local( $fname );

	if( $command_line{ 'interactive' } ){
		# No config file to read
		&do_mirror();
		$value{ 'package' } = 'interactive';
		return;
	}

	# if no configuration files were specified then read the standard input
	@ARGV = @config_files;
	&interpret_config();
}

sub interpret_config
{
	while( <> ){
		# Ignore comment and blank lines
		next if( /^\s*#/ || /^\s*$/ );
		
		&parse_line();
		
		# Is this a new package?
		if( $value{ 'package' } && $key eq 'package' ){
			# mirror the existing package
			&do_mirror();
			
			# reset
			&set_defaults();

			# Make sure I'm at the right place for <> to work!
			chdir $home;
		}
		
		if( $debug > 3 ){
			print "$key \"$value\"\n";
		}

		$value{ $key } = $value;

		# do an explicit close for each file so $. gets reset
		if( eof( ARGV ) ){
			if( $debug > 3 ){
				print "-- end of config file \"$ARGV\"\n";
			}
			close( ARGV );
		}
	}

	# Mirror the last package in the file
	if( $value{ 'package' } ){
		&do_mirror();
	}
}

# parse each line for keyword=value
sub parse_line
{
	local( $eqpl );
	local( $cont ) = '&';

	chop;
	if( /^\s*([^\s=+]+)\s*([=+])(.*)?$/ ){
		($key, $eqpl, $value) = ($1, $2, $3);
		# If the value ends in the continuation character then
		# tag the next line on the end (ignoring any leading ws).
		while( $value =~ /^(.*)$cont$/ && !eof ){
			$_ = <>;
			local( $v ) = $1;
			if( /^\s*(.*)$/ ){
				$value = $v . $1;
			}
		}
		if( $debug > 3 ){
			print "read: $key$eqpl$value\n";
		}
	}
	else {
		print "unknown input in \"$ARGV\" line $. of: $_\n";
	}
	if( ! defined( $default{ "$key" } ) ){
		die "unknown keyword in \"$ARGV\" line $. of: $key\n";
	}
	if( $eqpl eq '+' ){
		$value = $value{ $key } . $value;
	}
}

# Initialise the key values to the default settings
sub set_defaults
{
	%value = %default;
}

# Override the current settings with command line values
sub command_line_override
{
	local( $key, $val, $overrides );

	while( ($key, $val) = each %command_line ){
		$overrides++;
		if( $boolean_values{ $key } ){
			# a boolean value
			$value{ $key } = &istrue( $val );
		} else {
			# not a boolean value
			$value{ $key } = $val;
		}
	}

	if( $debug > 2 ){
		if( $overrides ){
			&pr_keywords( "keywords after command line override\n" );
		}
		else {
			print "No command line overrides\n";
		}
	}
}

# set each variable $key = $value{ $key }
sub set_variables
{
	local( $key, $val );

	while( ($key, $val) = each %value ){
		# for things like passwords it is nice to have the
		# real value in a file
		if( $value =~ /^\<(.*)$/ ){
			local( $val_name ) = $1;
			open( VAL_FILE, $val_name ) ||
				die "can't open value file $val_name\n";
			$value = <VAL_FILE>;
			close( VAL_FILE );
			chop $value if ( $value =~ /\n$/ );
		}

		if( $boolean_values{ $key } ){
			# a boolean value
			eval "\$$key = &istrue( $val )";
		}
		else {
			# not a boolan value
			# Change all \ to \\ since \'s will be escaped in
			# the following string used in the eval.
			$val =~ s/([^\\])(')/$1\\$2/g;
			eval "\$$key = '$val'";
		}
	}
}

sub pr_keywords
{
	local( $msg ) = @_;
	local( $nle ) = 4;
	local( $out ) = $nle;
	local( $key, $val );

	print $msg;
	print "package=$package  $site:$remote_dir\n\t";

	while( ($key, $val) = each %value ){
		next if( $key eq 'package' ||
			$key eq 'site' ||
			$key eq 'remote_dir' ||
			# Don't show passwords when interactive
			($interactive && $key eq 'remote_password') );
		print "$key=\"$val\" ";
		$out --;
		if( $out == 0 ){
			$out = $nle;
			print "\n\t";
		}
	}
	print "\n";
}

# Mirror the package
sub do_mirror
{
	$package = $value{ 'package' };
	
	if( $package eq 'defaults' ){
		# This isn't a real site - just a way
		# to change the defaults
		
		%default = %value;

		return;
	}
	
	# Only do this package if given by a -Ppack argument
	if( $limit_packages && ! $do_packages{ $package } ){
		return;
	}

	if( $skip_till ){
		# Found a package so process all packages from now on
		$skip_till = $limit_packages = 0;
	}

	# set things from the command line arguments
	&command_line_override();

	# set each variable $key = $value{ $key }
	&set_variables();

	if( $debug == 1 && $package ){
		print "\npackage=$package $site:$remote_dir\n";
	}
	elsif( $debug > 1 ){
		&pr_keywords( "\n" );
	}

	# Check out the regexps
	local( $t ) = 'x';
	foreach $r ( @regexp_values ){
		local( $val ) = $value{ $r };
		next if( ! $val );
		eval '$t =~ /$val/';
		if( $@ ){
			local( $err );
			chop( $err = $@ );
			print "Problem with regexp $r ($err), skipping package\n";
			return;
		}
	}

	# Don't bother if tryying to mirror here!
	if( !$interactive && !$force && ((gethostbyname( $site ))[0] eq $hostname) ){
		print "Skipping $site as it is really here!\n";
		return;
	}

	chdir $home;

	$max_age = 0;
	if( $value{ 'max_days' } ne '0' ){
		$max_age = time - ($value{ 'max_days' } * 24 * 60 * 60);
		print "max_age = $max_age\n" if( $debug > 1);
	}

	if( $debug ){
		# Keep the ftp debugging lower than the rest.
		&ftp'debug( $debug - 1);
	}
	else {
		&ftp'debug( $verbose );
	}

	&ftp'set_timeout( $timeout );

	# Useful string in prints
	$XFER = $get_file ? "get" : "put";

	# create the list of items to copy
	@transfer_list = ();
	if( $interactive ){
		# copy the remainder of items from argv to the transfer list
		while (@ARGV) {
			# copy the local directory
			if( @ARGV ){
				push( @transfer_list, shift( @ARGV ) );
			} 
	
			# copy the remote directory
			if( @ARGV ){
				push( @transfer_list, shift( @ARGV ) );
			}
			else {
				die "remote directory must be specified\n";
			}
	
			# copy the pattern, if available
			if( @ARGV ){
				push( @transfer_list, shift( @ARGV ) );
			} else {
				push( @transfer_list, $default{ 'get_patt' } );
			}
		}
	
		if( $debug > 1 ){
			local( $t );
			@t  = @transfer_list;
	
			while( @t ){
				printf( "local_dir=%s remote_dir=%s patt=%s\n",
					shift( @t ), shift( @t ), shift( @t ) );
			}
		}
	}
	else {
		push( @transfer_list, $local_dir );
		push( @transfer_list, $remote_dir );
		push( @transfer_list, $get_patt );
        }
		

	if( $update_local && $get_patt ){
		if( $get_patt ne $default{ 'get_patt' } ){
			print "Cannot mix get_patt and update_local.  get_patt ignored\n";
		}
		$get_patt = '';
	}
		
	
	if( !$site || (!$interactive && (!$local_dir || !$remote_dir)) ){
		print "Insufficient details for package to be fetched\n";
		print "Must give at least, site, remote_user, remote_dir and local_dir\n";
		return;
	}

        if( $pretty_print ){
                # Don't actually mirror just print a pretty list
                # of what would be mirrored.  This is for mailing to
                # people
		if( $skip ){
			return;
		}
                print "$package  \"$comment\"\n";
                print "  $site:$remote_dir  -->  $local_dir\n\n";
                return;
        }

	if( $skip ){
		print "Skipping package $package because $skip\n";
		return;
	}

	if( $split_max && $split_max <= $split_chunk ){
		print "split_max ($split_max) <= split_chunk ($split_chunk), this is senseless - skipping package\n";
		return;
	}

	if( $split_chunk && ($split_chunk & 511) ){
		print "split_chunk ($split_chunk) must be a multiple of 512 bytes - skipping package\n";
		return;
	}

	local( $con ) = &connect();
	if( $con <= 0 ){
		print "Cannot connect, skipping package\n";
		&disconnect();
		return;
	}

	if( $con == 1 ){
		print "login as $remote_user\n";
		$curr_remote_user = $remote_user;
		if( ! &ftp'login( $remote_user, $remote_password ) ){
			print "Cannot login, skipping package\n";
			&disconnect();
			return;
		}
	
		$can_restart = (&ftp'restart(0) == 1);
		if( $debug > 1 ){
			printf "Can %sdo restarts\n", $can_restart ? '' : "not ";
		}
	
		if( ! &ftp'type( $text_mode ? 'A' : 'I' ) ){
			print "Cannot set type\n";
		}
	}
	else {
		# Already connected to this site - so no need to login again
		print "Already connected to site $site\n" if( $debug );
	}

	if( ! $get_file ){
		local( @rhelp ) = &ftp'site_commands();
		$remote_has_chmod = grep( $_ eq 'CHMOD', @rhelp);
		if( $debug > 2 ){
			print "remote site " . ($remote_has_chmod ? "has" : "hasn't") . " got chmod\n";
		}
	}

	@log = ();

	while( @transfer_list ) {
		# get files
		$local_dir = shift( @transfer_list );
		$remote_dir = shift( @transfer_list );
		$get_patt = shift( @transfer_list );

		# Clear all details
		@xfer_dest = @xfer_src = @xfer_attribs = @things_to_make = ();
	

		if( $use_files ){
			&create_assocs();
		}

		if( !&get_local_directory_details() ){
			print "Cannot get local directory details ($local_dir)\n";
			&disconnect();
			return;
		}

		# Create a get_patt from the contents of the local directory
		if( $update_local && $#get_top >= 0 ){
			$get_patt = '^' . join( '|^', @get_top );
			$get_patt =~ s/\.Z\b//g;
			print "get_patt = $get_patt\n" if( $debug );
		}
	
		if( !&get_remote_directory_details() ){
			print "Cannot get remote direcory details ($remote_dir)\n";
			&disconnect();
			return;
		}
	
		if( $get_file ){
			&compare_dirs(
				*remote_sorted, *remote_time,
 				 *remote_size, *remote_type,
				*local_sorted, *local_time,
 				 *local_size, *local_type );
		} else {
			&compare_dirs(
				*local_sorted, *local_time,
				 *local_size, *local_type,
				*remote_sorted, *remote_time,
				 *remote_size, *remote_type );
		}

		if( $timestamp ){
			&set_timestamps();
			next;
		}

		# Do things!
		if( $do_deletes ){
			if( $get_file ){
				&compare_dirs_for_deletes(
					*local_sorted, *local_type,
					*remote_sorted, *remote_type );
			}
			else {
				&compare_dirs_for_deletes(
					*remote_sorted, *remote_type,
					*local_sorted, *local_type );
			}
			&do_deletes();
		}

		&make_things();
		&do_all_transfers();

		# No more transfers if the connection has died.
		last if( ! $connected );
	}

	# Should I force a disconnect now?
	if( $connected && $disconnect ){
		&disconnect();
	}

	if( $dont_do || $timestamp ){
		# Don't generate logs/email
		return;
	}

	local( $now );
	chop( $now = `date` );
	if( $update_log ){
		if( ! open( logg, ">>$update_log" ) ){
			print "Cannot append to $update_log\n";
			return;
		}
		print logg "mirroring $package ($site:$remote_dir) completed successfully @ $now\n";
		print logg @log;
		close( logg );
	}

	if( $#log >= 0 && $mail_to =~ /./ ){
		local( $com );
		eval "\$com = \"|$mail_prog $mail_to\"";
		if( ! open( mail, $com ) ){
			print "Cannot run: $com\n";
			return;
		}
		print mail "Mirrored $package ($site:$remote_dir) $comment @ $now\n";
		print mail @log;
		close( mail );
	}
}

sub disconnect
{
	if( $connected ){
		print "disconnecting from $connected\n" if( $debug );
		if( ! $ftp'fatalerror ){
			&ftp'quit();
		}
	}
	&chat'close();
	$connected = '';

	if( $use_files ){
		# Close and zap.
		&delete_assocs();
	}
}

# Connect to the site
# Return 0 on a fail,
# 1 if a connection was successfully made,
# 2 if already connected to the site
sub connect
{
	local( $attempts ) = 1; # Only retry ONCE! Be friendly.
	local( $res );

	if( $connected eq $site && $curr_remote_user eq $remote_user ){
		# Already connected to this site!
		return 2;
	}

	# Clear out any session I may still be in
	&disconnect();

	$res = &ftp'open( $site, $ftp_port, $retry_call, $attempts );
	if( $res == 1 ){
		# Connected
		$connected = $site;
	}
	return $res;
}	

# This just prods the remote ftpd to prevent time-outs
sub prod
{
	if( $debug > 2 ){
		print " prodding remote ftpd\n";
	}
	&ftp'pwd();
}

sub get_local_directory_details
{
	local( @dirs, $dir );
	local( $last_prodded ) = time; # when I last prodded the remote ftpd

	undef( @local_sorted );
	if( ! $use_files ){
		undef( %local_time, %local_size, %local_type, %local_mode );
	}

	@get_top = ();

	print "Scanning local directory $local_dir\n";
	
	if( ! -d $local_dir ){
		if( $dont_do || $timestamp ){
			return 1;
		}
		print "$local_dir no such directory - creating it\n";
		if( &mkdirs( $local_dir ) ){
			push( @log, "Created dir $local_dir\n" );
		}
	}
	if( !chdir( $local_dir ) ){
		print "Cannot change directory to $local_dir\n";
		return 0;
	}

	if( $local_dir =~ m,^/, ){
		$cwd = $local_dir;
	}
	else {
		chop( $cwd = `pwd` );
	}

	# @dirs is the list of all directories to scan
	# As subdirs are found they are added to the end of the list
	# and as 
	@dirs = ( "." );
	local( $dir_level ) = 0;
	while( defined( $dir = shift( @dirs ) ) ){
		local( $path, $time, $size, $type, $mode );

		# Prod the remote system from time to time
		# To prevent time outs
		if( time > ($last_prodded + $prod_interval) ){
			$last_prodded = time;
			&prod();
		}

		if( !opendir( dir, $dir ) ){
			print "Cannot open local directory $dir, skipping it\n";
			next;
		}

		local( $name );
		while( defined( $name = readdir( dir ) ) ){
			local( $linkname );
			local( $isdir );

			next if( $name eq '.' || $name eq '..' ||
				($local_ignore && $name =~ /$local_ignore/) );

			$path = "$dir/$name";
			$path =~ s,(^|/)\./,,;
			if( -l $path ){
				local( $value ) = readlink( $path );
				local( $dev,$ino,$fmode,$nlink,$uid,$gid,$rdev,$ssize,
				      $atime,$mtime,$ctime,$blksize,$blocks ) =
					lstat( _ );
				$size = $ssize;
				$time = $mtime;
				$type = "l $value";
				$mode = $fmode;
			}
			elsif( ($isdir = (-d $path)) || -f $path ){
				local( $dev,$ino,$fmode,$nlink,$uid,$gid,$rdev,$ssize,
				      $atime,$mtime,$ctime,$blksize,$blocks ) =
					stat( _ );
				$size = $ssize;
				$time = $mtime;
				$mode = $fmode;
				if( $isdir ){
					push( @dirs, $path );
					$path .= '/';
					$type = 'd';
				}
				else {
					$type = 'f';
				}
				if( $dir_level == 0 && $update_local ){
					push( @get_top, $path );
				}
			}
			else {
				print "unknown file type $path, skipping\n";
				next;
			}
			# I can only really cope with the permissions bits.
			$mode &= 0777;
			if( $debug > 2){
				printf "local: %s %s %s %s 0%o\n",
					$path, $size, $time, $type, $mode;
			}
			push( @local_sorted, $path );
			$local_time{ $path } = $time;
			$local_size{ $path } = $size;
			$local_type{ $path } = $type;
			$local_mode{ $path } = $mode;
		}
		closedir( dir );
		$dir_level++;

		if( ! $recursive ){
			last;
		}
	}
	return 1;
}

sub get_remote_directory_details
{
	print "Scanning remote directory $remote_dir\n";
	
	undef( @remote_sorted );
	if( ! $use_files ){
		undef( %remote_time, %remote_size, %remote_type, %remote_mode );
	}

	if( ! &ftp'cwd( $remote_dir ) ){
		if( $get_file ){
			# no files to get
			return 0;
		}

		print "Failed to change to remote directory ($remote_dir) trying to create it\n";
		&mkdirs( $remote_dir );

		if( ! &ftp'cwd( $remote_dir ) ){
			print "Cannot change to remote directory ($remote_dir) because: $ftp'response\n";
			return 0;
		}
	}

	local( $rls );

	if( $local_ls_lR_file ){
		print " Using local file $local_ls_lR_file for remote dir listing\n";
		if( ! open( dirtmp, $local_ls_lR_file ) ){
			print "Cannot open $local_ls_lR_file\n";
			return 0;
		}
		$rls = "main'dirtmp";
	}
	elsif( $ls_lR_file ){
		local( $dirtmp );

		$dirtmp = "/tmp/.dir$$";
		if( $ls_lR_file = /\.Z$/ ){
			$dirtmp .= '.Z';
		}

		print " Getting directory listing from remote file $ls_lR_file\n";
		if( ! &ftp'get( $ls_lR_file, $dirtmp, 0 ) ){
			print "Cannot get dir listing file\n";
			return 0;
		}
		if( $dirtmp =~ /\.Z$/ ){
			local( $f ) = $dirtmp;
			$f =~ s/'/\\'/g;
			&sys( "$uncompress_prog '$f'" );
			$dirtmp = ~s/\.Z$//;
		}

		open( dirtmp, $dirtmp ) || die "Cannot open $dirtmp";
		$rls = "main'dirtmp";
	}
	else {
		if( ! &ftp'type( 'A' ) ){
			print "Cannot set type to ascii for dir listing\n";
		}

	 	if( !&ftp'dir_open( $recursive ? $flags_recursive : $flags_nonrecursive ) ){
			print "Cannot get remote directory listing because: $ftp'response\n";
			return 0;
		}
		$rls = "ftp'NS";
	}
	
	$lsparse'fstype = $remote_fs;
	$lsparse'name = $package;
	&lsparse'reset( '' );
	while( !eof( $rls ) ){
		local( $path, $size, $time, $type, $mode ) = &lsparse'line( $rls );
		last if( !$path );
		if( $debug > 2 ){
			printf "remote: %s %s %s %s 0%o\n",
 				$path, $size, $time, $type, $mode;
		}
		push( @remote_sorted, $path );
		$remote_time{ $path } = $time;
		$remote_size{ $path } = $size;
		$remote_type{ $path } = $type;
		$remote_mode{ $path } = $mode;
	}
	
	if( $local_ls_lR_file ){
		close( dirtmp );
	}
	elsif( $ls_lR_file ){
		close( dirtmp );
		unlink( $dirtmp );
	}
	else {
		&ftp'dir_close();
		# Could optimise this out - but it makes sure that
		# the other end gets a command straight after a possibly
		# long dir listing.
		if( ! &ftp'type( $text_mode ? 'A' : 'I' ) ){
			print "Cannot reset type after dir listing\n";
		}
	}
	
	return 1;
}

sub compare_dirs
{
	local( *src_paths, *src_time, *src_size, *src_type, 
		*dest_paths, *dest_time, *dest_size, *dest_type ) = @_;
	local( $src_path, $dest_path, $dest_index, $i );
	local( $last_prodded ) = time; # when I last prodded the remote ftpd

	print "compare directories for xfer\n";

	for( $i = 0; $i <= $#src_paths; $i++ ){
		$dest_path = $src_path = $src_paths[ $i ];

		# Prod the remote system from time to time
		# To prevent time outs.  Only look once every 50 files
		# to save on unnecessary systems calls.
		if( ($i % 50 == 0) && time > ($last_prodded + $prod_interval) ){
			$last_prodded = time;
			&prod();
		}

		if( $debug > 2 ){
			print "Compare src $src_path: $src_time{ $src_path }";
			print " $src_size{ $src_path } $src_type{ $src_path }\n";
		}

		# Should I compress this file?
		local( $compress ) = 0;
		if( $src_type{ $src_path } eq 'f' &&
		   $compress_patt && $src_path =~ /$compress_patt/ &&
		   !($compress_excl && $src_path =~ /$compress_excl/) ){
			if( $dest_path !~ /$squished/ ){
				if( $src_type{ "$src_path.Z" } eq 'f' ){
					# There is a compessed version
					# too!  Skip the uncompress one
					print "   do not xfer, compressed version exists: $src_path\n" if( $debug > 1 );
					next;
				}

				if( ! $get_file ){
					print "   compression on sending files not yet available\n";
				}
				else {
					$compress = 1;
					$dest_path .= '.Z';
				}
			}
		}

		# Should I split it up?
		local( $split ) = 0;
		local( $dest_path_real );
		if( $split_max &&
		   $src_type{ $src_path } eq 'f' &&
		   $src_size{ $src_path } > $split_max &&
		   $split_patt && $src_path =~ /$split_patt/ ){
			$split = 1;
			$dest_path_real = $dest_path;
			$dest_path .= "-split/part01";
		}

		if( $debug > 2 ){
			print "       dest $dest_path: $dest_time{ $dest_path }";
			print " $dest_size{ $dest_path } $dest_type{ $dest_path }";
#			print " (compress)" if( $compress );
#			print " (split)" if( $split );
			print "\n";
		}
		
		if( $name_mappings ){
			local( $old_dest_path ) = $dest_path;
			eval "\$dest_path =~ $name_mappings";
			if( $dest_path ne $old_dest_path && $debug > 2 ){
				print "   Mapped name is $dest_path\n";
			}
		}

		if( $get_patt && $src_path !~ /$get_patt/ ){
			print "   do not xfer: $src_path\n" if( $debug > 1 );
			next;
		}

		if( $exclude_patt && $src_path =~ /$exclude_patt/ ){
			print "   exclude: $src_path\n" if( $debug > 1 );
			next;
		}

		# Just create any needed directories (the timestamps
		# should be ignored)
		if( $src_type{ $src_path } eq 'd' ){
			if( $dest_type{ $dest_path } ne 'd' ){
				push( @things_to_make, "d $dest_path" );
				print "   need to mkdir $dest_path\n" if( $debug > 1 );
			}
			next;
		}

		# Well that just leaves files and symlinks.
		# Do various checks on them.

		if( $max_age && $src_time{ $src_path } < $max_age ){
			print "   too old: $src_path\n" if( $debug > 1 );
			next;
		}

		local( $update ) = 0;

		if( $force || ! $dest_type{ $dest_path } ){
			# Either I'm forcing xfers or the file doesn't exist
			# either way I should update
			$update = 1;
		}
		else {
			# Maybe the src is newer?
			if( $get_newer &&
			   &compare_times( $src_time{ $src_path }, $dest_time{ $dest_path } ) ){
				print "   src is newer, xfer it\n" if( $debug > 2 );
				$update = 1;
			}
			# or maybe its size has changed?
			# don't bother if file was compressed or split as the
			# size will have changed anyway
			if( !$compress && !$split &&
			   $get_size_change &&
			   ($src_size{ $src_path } != $dest_size{ $dest_path }) ){
				print "   src is different size, xfer it\n" if( $debug > 2 );
				$update = 1;
			}
		}

		if( ! $update ){
			next;
		}

		if( $src_type{ $src_path } =~ /^l (.*)/ ){
			# DONT FORGET TO NAME MAP!!!!
			local( $existing_path ) = $1;

			push( @things_to_make, "l $dest_path -> $existing_path" );
			print "   need to symlink $dest_path -> $existing_path\n" if( $debug > 2 );
			next;
		}

		# Now that the tests are complete use the real dest.
		if( defined( $dest_path_real ) ){
			$dest_path = $dest_path_real;
		}

		print "$XFER file $src_path as $dest_path" .
			($compress ? " (compress)" : "") .
			($split ? " (split)" : "") . "\n" if( $debug > 1 );
		push( @xfer_dest, $dest_path );
		push( @xfer_src, $src_path );

		# If xfers can be restarted AND
		# a temporary file exists from a previous attempt at a
		# transfer  AND
		# the timestamps of the exising temp file and the original
		# src file match then flag a restart.
		local( $tmp ) = &filename_to_tempname( '', $dest_path );
		local( $restart ) = '';
#print `pwd`;
#print " $tmp $get_file, $can_restart, " . ((-f $tmp) ? "has size " : "no size ") . "$dest_time{ $tmp }, $src_time{ $src_path }\n";
		if( $get_file &&
		   $can_restart &&
		   -f $tmp &&
		   ($dest_time{ $tmp } eq $src_time{ $src_path }) ){
			# Then this is an xfer of the same file
			# so just restart where I left off
			$restart = 'r';
		}
		# x for xfer, c for compress, s for split
		push( @xfer_attribs,
		     "x$restart" .
		     ($compress ? "c" : "") .
		     ($split ? "s" : "") );
	}

}

sub compare_dirs_for_deletes
{
	local( *src_paths, *src_type, 
		*dest_paths, *dest_type ) = @_;

	local( $src_path, $dest_path, $dest_index, $i );

	@delete_dirs = @delete_files = ();

	print "compare directories for deletions\n";

	for( $i = 0; $i <= $#src_paths; $i++ ){
		$dest_path = $src_path = $src_paths[ $i ];

		if( $debug > 2 ){
			print "Compare src $src_path: $src_type{ $src_path }\n";
			print "       dest $dest_path: $dest_type{ $dest_path }\n";
		}
		
		if( $name_mappings ){
			local( $old_dest_path ) = $dest_path;
			eval "\$dest_path =~ $name_mappings";
			if( $dest_path ne $old_dest_path && $debug > 2 ){
				print "   Mapped name is $dest_path\n";
			}
		}

		if( $delete_excl && $src_path =~ /$delete_excl/ ){
			next;
		}

		# Should exist so don't delete
		if( $dest_type{ $dest_path } ){
			next;
		}

		# Was it compressed when xfered?  Hard to tell so
		# just check for an uncompressed file as well.
		if( $dest_path =~ /$squished/ ){
			local( $uncomp ) = $dest_path;
			$uncomp =~ s/$squished//;
			if( $dest_type{ $uncomp } ){
				next;
			}
		}
		
		# Was it split?  Really hard to tell so try and
		# convert back to its (probable) original name and
		# compare that
		if( $dest_path =~ /-split\/(part\d\d|README)$/ ){
			local( $unsplit ) = $dest_path;
			$unsplit =~ s,-split/(part\d\d|README)$,,;
			if( $dest_type{ $unsplit } ){
				next;
			}
			# Good Grief - it wasn't compressed as well
			if( $unsplit =~ /$squished/ ){
				local( $uncomp ) = $unsplit;
				$uncomp =~ s/$squished//;
				if( $dest_type{ $uncomp } ){
					next;
				}
			}
		}
		# and of course it may be a directory containing the split
		# up stuff!
		if( $dest_path =~ /-split\/$/ ){
			local( $unsplit ) = $dest_path;
			$unsplit =~ s,-split/$,,;
			if( $dest_type{ $unsplit } ){
				next;
			}
			# Good Grief - it wasn't compressed as well
			if( $unsplit =~ /$squished/ ){
				local( $uncomp ) = $unsplit;
				$uncomp =~ s/$squished//;
				if( $dest_type{ $uncomp } ){
					next;
				}
			}
		}

		if( $src_type{ $src_path } eq 'd' ){
			push( @delete_dirs, $src_path );
			print "delete dir $src_path\n" if( $debug > 1 );
		}
		else {
			push( @delete_files, $src_path );
			print "delete $src_path\n" if( $debug > 1 );
		}
	}
}

sub set_timestamps
{
	local( $src_path );
	
	if( ! $get_file ){
		print "Cannot set remote timestamps\n";
		return;
	}

	foreach $src_path ( @xfer_src ){
		local( $dest_path );

		$dest_path = shift( @xfer_dest );

		local( $rtime ) = $remote_time{ $src_path };
		if( $local_type{ $dest_path } &&
		   $local_time{ $dest_path } ne $rtime ){
			&set_timestamp( $dest_path, $rtime );
		}
	}
}

sub set_timestamp
{
	local( $path, $time ) =  @_;
	
	if( $dont_do ){
		print "Should set time of $path to $time\n";
		return;
	}

	if( $timestamp || $debug > 2 ){
		print "Setting time of $path to $time\n";
	}
	utime( $time, $time, $path );
}

sub make_things
{
	local( $thing );

	foreach $thing ( @things_to_make ){
		if( $thing =~ /^d (.*)/ ){
			if( ! $dont_do ){
				&mkdirs( $1 );
			}
		}
		elsif( $thing =~ /^l (.*) -> (.*)/ ){
			if( ! $dont_do ){
				&mksymlink( $1, $2 );
			}
		}
	}
}

sub do_all_transfers
{
	local( $src_path );
	
	if( $#xfer_src < 0 ){
		print "No files to transfer\n";
		return;
	}

	foreach $src_path ( @xfer_src ){
		local( $dest_path, $attribs );

		$dest_path = shift( @xfer_dest );
		$attribs = shift( @xfer_attribs );
		
		if( $dont_do ){
			# Skip trying to get the file.
			next;
		}

		print "Need to $XFER file $src_path as $dest_path ($attribs)\n" if( $debug > 1 );

		print "transferring $src_path ";
		local( $newpath ) = &transfer_file( $src_path, $dest_path, $attribs, $remote_time{ $src_path } );
		if( $get_file && $newpath eq '' ){
			print "Failed to $XFER file $ftp'response\n";
			if( $ftp'fatalerror ){
				print "Fatal error talking to site, skipping rest of transfers\n";
				&disconnect();
				return;
			}
			next;
		}

		# File will now have been split up.
		if( $attribs =~ /s/ ){
			print "\n";
			next;
		}

		if( $newpath ne $src_path ){
			print "into $newpath";
		}
		print "\n";

		&set_attribs( $newpath, 'f' );

		# we can only force time for local files
		if( $force_times && $get_file ){
			&set_timestamp( $newpath, $remote_time{ $src_path } );
		}
	}
}


sub transfer_file
{
	local( $src_path, $dest_path, $attribs, $timestamp ) = @_;
	local( $dir, $file, $temp, $compress, $split, $restart, $mesg, $got_mesg );
	
	# Make sure the required directory exists
	$dir = "";
	if( $dest_path =~ /^(.+\/)([^\/]+)$/ ){
		($dir, $file) = ($1, $2);
		if( $dest_type{ $dir } ne 'd' && &mkdirs( $dir ) ){
			push( @log, "Created dir $dir\n" );
		}
	}
	else {
		$file = $dest_path;
	}
	
	$temp = &filename_to_tempname( $dir, $file );
	
	# Interpret the attrib characters
	if( $attribs !~ /x/ ){
		# Not an xfer!
		return '';
	}
	if( $attribs =~ /c/ ){
		$compress = 1;
		$mesg = " and compress";
	}
	if( $attribs =~ /s/ ){
		$split = 1;
		$mesg = " and split";
	}
	if( $attribs =~ /r/ ){
		$restart = 1;
	}
	
	if( ! $get_file ){
		# put the file remotely

		if( ! &ftp'put( $src_path, $temp, $restart ) ){
			push( @log, "Failed to put $src_path: $ftp'response\n" );
			return '';
		}
	
		if( ! &ftp'rename( $temp, $dest_path ) ){
			push( @log, "Failed to remote rename $temp to $dest_path: $ftp'response\n" );
			return '';
		}

		return $dest_path;
	}

	# Get a file

#	if( -r $temp ){
#		unlink( $temp );
#	}
	
	if( ! &ftp'get( $src_path, $temp, $restart ) ){
		push( @log, "Failed to get $src_path: $ftp'response\n" );

		# Time stamp the temp file to allow for a restart
		if( -f $temp ){
			utime( $timestamp, $timestamp, $temp );
		}

		return '';
	}

	# delete source file after successfull transter
	if( $delete_source ){
		if( &ftp'delete( $path ) ){
			push( @log, "Deleted remote $lpath\n");
		}
		else {
			push( @log, "Failed to delete remote $lpath\n");
			print "Failed to delete remote $lpath\n";
		}
	}


	# Try and compress the file - dont worry if it doesn't manage
	# it - the file is probably already compressed
	if( $compress ){
		# Prevent the shell from expanding characters
		local( $f ) = $temp;
		$f =~ s/'/\\'/g;
		&sys( "$compress_prog '$temp'" );
		if( -r "$temp.Z" ){
			$temp .= '.Z';
		}
		$got_mesg .= "and compressed";
	}

	# Ok - chop it up into bits!
	if( $split ){
		local( $time ) = 0;
		if( $force_times ){
			$time = $remote_time{ $src_path };
		}
		&bsplit( $temp, $dest_path, $time );
		unlink $temp;
		$got_mesg .= "and split";
	}
	else {
		rename( $temp, $dest_path );
	}

	local( $filesize ) = &filesize( $dest_path );
	push( @log, "Got $src_path as $dest_path $got_mesg $filesize\n" );

	&log_upload( $src_path, $dest_path, $got_mesg, $filesize );

	return( $dest_path );
}

sub filename_to_tempname
{
	local( $dir, $file ) = @_;

	# dir 
	return "$dir.in.$file.";
}


# Open, write, close - to try and ensure that the log will allways be filled
# in.
sub log_upload
{
	local( $src_path, $dest_path, $got_mesg, $size ) = @_;

	if( ! $upload_log ){
		return;
	}

	if( ! open( ulog, ">>$upload_log" ) ){
		print STDERR "Cannot write to $upload_log\n";
		return;
	}

	print ulog "$site:$remote_dir/$src_path -> $local_dir/$dest_path $size ";
	if( $got_mesg ){
		print ulog "($got_mesg)";
	}
	print ulog "\n";
	close( ulog );
}

sub do_deletes
{
	if( $dont_do || ! $do_deletes ){
		return;
	}

	if( ! $really_do_deletes ){
		print "To chicken to implement do_deletes\n";
	}

	local( $del );
	foreach $del ( @delete_files ){
		if( $really_do_deletes ){
			if( $get_file ){
				print "unlink $cwd/$del\n";
				unlink( "$cwd/$del" );
			}
			else {
				&ftp'delete( "$cwd/$del" );
			}
		}
		else {
			if( $get_file ){
				print "NEED TO unlink $cwd/$del\n";
			}
			else {
				print "NEED TO ftp'delete $del\n";
			}
		}
	}
	foreach $del ( @delete_dirs ){
		$del =~ s,/+$,,;
		if( $really_do_deletes ){
			if( $get_file ){
				print "rmdir $cwd/$del\n";
				rmdir( "$cwd/$del" );
			}
			else {
				print "Cannot delete remote directories\n";
			}
		}
		else {
			if( $get_file ){
				print "NEED TO rmdir $cwd/$del\n";
			}
			else {
				print "NEED TO ftp'deldir $del\n";
			}
		}
	}
}

sub filesize
{
	local( $fname ) = @_;

	if( ! -f $fname ){
		return -1;
	}

	return (stat( _ ))[ 7 ];
	
}

# Is the value
sub istrue
{
	local( $val ) = @_;
	
	return $val eq '1' || $val eq 'yes' || $val eq 'ok' ||
	       $val eq 'true';
}

sub mksymlink
{
	local( $dest_path, $existing_path ) = @_;

	if( ! $get_file ){
		print "Cannot create symlinks on remote systems ($dest_path -> $existing_path)\n";
		return;
	}
	
	# make the symlink locally

	# Zap any exiting thing of that name
	if( -e $dest_path ){
		unlink( $dest_path );
		print "unlink( $dest_path )\n" if( $debug > 2 );
	}

	if( (eval 'symlink("","")', $@ eq '') ){
		symlink( $existing_path, $dest_path );
		push( @log, "Created symlink $dest_path -> $existing_path\n" );
		print "symlink( $existing_path, $dest_path )\n" if( $debug > 2 );
	}
	else {
		print "Tried to create symlink - but not supported locally\n";
	}
}


# Make a full directory heirarchy
# returns true if the directory doesn't exist
sub mkdirs
{
	local( $dir ) = @_;
	local( @dir, $d, $path );

	# Very often the directory does exist - so return now
	return 0 if( &dir_exists( $dir ) );
	
	# Make sure that the target directory exists
	@dirs = split( '/', $dir );
	
	# the root directory always exists
	$path = '';
	if( $dirs[ 0 ] eq '' ) { 
		shift( @dirs ); 
		$path = '/';
	}

	foreach $d ( @dirs ){
		$path = $path . $d;
		if( ! &dir_exists( $path ) ){
			print "mkdir $path\n" if( $debug > 2 );
			if( ! &make_dir( $path, 0755 ) ){
				print "make_dir($path,0755) failed with $err\n";
			}
			&set_attribs( $path, 'd' );
		}
		$path .= "/";
	}
	return 1;
}

# return 0 on error, 1 on success
sub make_dir
{
	local( $dir, $mode ) = @_;
	local( $val );

	if( $get_file ){
		# make a local directory
		$val = mkdir( $dir, $mode );
		$err = "$!";
	}
	else {
		# make a remote directory
		$val = &ftp'mkdir( $dir );

		# The mkdir might have failed due to bad mode
		# So try to chmod it anyway
		if( $remote_has_chmod ){
			$val = &ftp'chmod( $dir, $mode );
		}
	}

	return $val;
}

# return 1 if $dir exists, 0 if not
sub dir_exists
{
	local( $dir ) = @_;
	local( $val );

	if( $get_file ){
		# check if local directory exists
		$val = (-d $dir);
	}
	else {
		# check if remote directory exists
		local($old_dir) = &ftp'pwd();		
		
		$val = &ftp'cwd($dir);

		# go back to the original directory
		&ftp'cwd($old_dir) || die "Cannot cd to original remote directory";
	}
	return $val;
}

# Set file/directory attributes
sub set_attribs
{
	local( $path, $type ) = @_;
	local( $mode );
	
	if( $get_file ){
		$mode = $remote_mode{ $path };
	}
	else {
		$mode = $local_mode{ $path };
	}

	# If I can't figure out the mode or I'm not copying it
	# use the default
	if( !$mode_copy || !$mode ){
		if( $type eq 'f' ){
			$mode = $file_mode;
		}
		elsif( $type eq 'd' ){
			$mode = $dir_mode;
		}
	}

	# Convert from octal
	$mode = oct( $mode ) if( $mode =~ /^0/ );

	if( $get_file ){
		# Change local

		chmod $mode, $path;

		if( $user ne '' && $group ne '' ){
			if( $user =~ /^\d+$/ && $group =~ /\d+$/ ){
				chown $user, $group, $path;
			}
			else {
				if( $chowngrp ){
					&sys( "$chowngrp $user.$group $path" );
				}
				else {
					&sys( "$chown $user $path" );
					&sys( "$chgrp $group $path" );
				}
			}
		}
	}
	else {
		# change the remote file
		if( $remote_has_chmod ) {
			&ftp'chmod( $path, $mode );
		}
	}
}


sub get_passwd
{
	local( $user ) = @_;
	local( $pass );

	# prompt for a password
	$SIG{ 'INT' } = 'IGNORE';
	$SIG{ 'QUIT' } = 'IGNORE';

	system "stty -echo </dev/tty >/dev/tty 2>&1";
	print "Password for $user: ";

	$pass = <STDIN>;
	print "\n";
	chop( $pass );

	system "stty echo </dev/tty >/dev/tty 2>&1";

	$SIG{ 'INT' } = 'DEFAULT';
	$SIG{ 'QUIT' } = 'DEFAULT';
	
	return $pass;
}

sub compare_times
{
	# Try and allow for time zone changes (eg when a site
	# switches from daylight saving to non daylight saving)
	# by ignoring differences of exactly one hour

	local( $t1, $t2 ) = @_;
	local( $diff ) = ($t1 > $t2 ? $t1 - $t2 : $t2 - $t1);

	return ($t1 > $t2) && ($diff != 3600);
}

sub create_assocs
{
	local( $map );

	&delete_assocs();

	foreach $map ( @assocs ){
		eval "\$$map = \"\$tmp/$map.$$\"";
		eval "dbmopen( $map, \$$map, 0644 )";
	}
}

sub delete_assocs
{
	local( $map );

	foreach $map ( @assocs ){
		eval "\$$map = \"\$tmp/$map.$$\"";
		&unlink_dbm( eval "\$$map" );
		eval "\%$map = ()";
	}
}

sub unlink_dbm
{
	local( $file ) = @_;
	unlink "$file.pag";
	unlink "$file.dir";
}

# Chop the tmp file up
sub bsplit
{
	local( $temp, $dest_path, $time ) = @_;
	local( $dest_dir ) = "$dest_path-split";
	local( $bufsiz ) = 512;
	local( $buffer, $in, $sofar );

	print "Splitting up $temp into $dest_dir/ ($time)\n" if( $debug );

	# Stomp on the original directories
	&sys( "$rm_prog $dest_dir" );

	&mkdirs( $dest_dir );

	local( $index ) = "00";
	local( $part );
	open( tmp, $temp ) || die "Cannot open $temp!";
	$sofar = $split_chunk; # Force a new file
	while( ($in = sysread( tmp, $buffer, $bufsiz )) > 0 ){
		if( $sofar >= $split_chunk ){
			if( $part ){
				close( part );
				if( $time ){
					&set_timestamp( $part, $time );
				}
			}
			$index++;
			$part = "$dest_dir/part$index";
			print "creating $part\n" if( $debug );
			open( part, ">$part" ) || die "Cannot create $part";
			$sofar = 0;
		}
		if( ($out = syswrite( part, $buffer, $in )) != $in ){
			die "Failed to write data to $part";
		}
		$sofar += $in;
	}
	close( part );
	if( $time ){
		&set_timestamp( $part, $time );
	}
	close( tmp );

	# Generate a readme file about what is in the split directory
	local( $readme ) = "$dest_dir/README";
	open( readme, ">$readme" ) || die "Cannot create $readme";
	print readme "This directory contains a splitup version of $dest_path\n";
	print readme "to recreate the original simply concatenate all the\n";
	print readme "parts back together.\n\nChecksums are:\n\n";
	close readme;
	&sys( "(cd $dest_dir ; $sum_prog part* ) >> $readme" );
}

sub sys
{
	local( $com ) = @_;
	print "$com\n" if( $debug > 2 );
	system( $com );
}

# Set up an associative array given all an array of keys.
# @fred = ( 'a' );
# &set_assoc_from_array( *fred )
# Creates => $fred{ 'a' } = 1
#
sub set_assoc_from_array
{
	local( *things ) = @_;
	foreach $thing ( @things ){
		$things{ $thing } = 1;
	}
}

# Scan the given directory and all all files in it to the list
# of config files
sub add_all_files
{
	local( $dir ) = @_;

	chdir( $dir ) || die "Cannot chdir to $dir";
	opendir( dir, '.' ) || die "Cannot scan $dir";
	foreach $file ( readdir( dir ) ){
		if( -f $file ){
			push( @config_files, "$dir/$file" );
		}
	}
	closedir( dir );
	chdir $home;
}