#! /boot/home/config/bin/perl
# Generated automatically from remsync.in by configure.
eval "exec /boot/home/config/bin/perl -S $0 $*"
    if $running_under_some_shell;

# Synchronization tool for remote directories.
# Copyright (C) 1994 Free Software Foundation, Inc.
# François Pinard <pinard@iro.umontreal.ca>, 1994.

# This program 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.

# This program 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 this program; if not, write to the Free Software Foundation,
# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

# Parameters, but not meant to be changed.

$PACKAGE = "sharutils";		# name of package for this program
$VERSION = "4.2.1";		# version number for the whole package
$PROGRAM = "remsync";		# name of this particular program
$FORMAT = "1.3";		# version of format for files

$CONFIG = ".remsync";		# file containing synchronization information
$ARCHIVE = ".remsync.tar.gz";	# default file name of packed synchro. package
$WORKDIR = ".remsync-work";	# directory name of unpacked synchro. package
$ORDERS = "orders";		# file name containaing synchro. directives

$DIFF = "/bin/diff";		# GNU diff path
$TAR = "/bin/tar";			# GNU tar path
$SH = "/bin/sh";			# Bash or sh path

# Special constants.

$NEWLY_CREATED_SCAN = 2;	# Instead of 1, when by remote request

# Help strings.

$INITIAL_HELP = "$PROGRAM (format $FORMAT) - GNU $PACKAGE $VERSION
  Remote synchronization of files and directories.

The following commands are available at *any* \`$PROGRAM\' prompt:

  ?             reminder for available commands
  ! [COMMAND]   shell escape for processing COMMAND
  abort         get out of the current command right away
";

$NORMAL_HELP = "Usage: $PROGRAM [COMMANDS...]

  ! [COMMAND]   shell escape for processing COMMAND (defaults to shell)
  abort         get out of the current command right away
  quit          get out of program, saving file \`$CONFIG\' if modified

Synchronizing commands:
  chdir [DIRECTORY]     change current directory to DIRECTORY
  mode [MODE]           init (do not send contents) or noop (send nothing)
  broadcast [SET]       export a synchronization package to each site of SET
  process [FILE]        import a FILE (defaults to \`$ARCHIVE\')
  process [DIRECTORY]   or use an already exploded DIRECTORY (\`$WORKDIR\')

Maintenance commands:
  list                           list title, here, remotes, scans and ignores
  files                          list all files and their known signatures
  title [DESCRIPTION]            use DESCRIPTION as project title (or list it)
  here [ADDRESS [DIRECTORY]]     declare our ADDRESS, modify visited DIRECTORY
  remote [ADDRESS [DIRECTORY]]   declare remote ADDRESS, modify its DIRECTORY
  scan [PATTERN]                 scan directory with \`find\' for shell PATTERN
  ignore [REGEXP]                ignore scanned files if name matched by REGEXP
  delete TYPE DATA               delete the remote, scan or ignore having DATA

To obtain partial lists, use appropriate commands without their parameters.
Commands and keyword arguments may be abbreviated to one letter.
";

## Programming notes around probable Perl 4.X bugs:
## * local($_) is avoided, so beware $_ may be destroyed by any routine.
## * @_ is always saved on each routine entry, where sub-routines are used.

while (@ARGV)
{
    if ($ARGV[0] eq "--v" || $ARGV[0] eq "--ve" || $ARGV[0] eq "--ver"
	|| $ARGV[0] eq "--vers" || $ARGV[0] eq "--versi"
	|| $ARGV[0] eq "--versio" || $ARGV[0] eq "--version")
    {
	print "$PROGRAM (format $FORMAT) - GNU $PACKAGE $VERSION\n";
	exit 0;
    }
    elsif ($ARGV[0] eq "--h" || $ARGV[0] eq "--he" || $ARGV[0] eq "--hel"
	   || $ARGV[0] eq "--help")
    {
	print $NORMAL_HELP;
	exit 0;
    }
    else
    {
	last;
    }
}

if (@ARGV)
{
    $commands_ahead = join (";", @ARGV);
    @ARGV = ();
}
else
{
    print STDERR $INITIAL_HELP;
}

$fetch_config = 1;

&command_loop;

&maybe_save_config;

exit 0;

# Interactive command decoding.

## Read user commands and dispatch them.

sub command_loop
{
    $command_loop = 1;

  COMMAND_LOOP:
    while (1)
    {
	if ($commands_ahead)
	{
	    if ($commands_ahead =~ /^([^;]*);(.*)/)
	    {
		$_ = $1;
		$commands_ahead = $2;
	    }
	    else
	    {
		$_ = $commands_ahead;
		$commands_ahead = "quit";
	    }
	}
	else
	{
	    if ($noop_mode)
	    {
		&query ("\nnoop>>");
	    }
	    elsif ($init_mode)
	    {
		&query ("\ninit>>");
	    }
	    else
	    {
		&query ("\n>>");
	    }
	}
	s/^ +//;
	s/ +$//;

	next if /^$/;
	next if /^#/;
	last if /^q(uit)?$/;

	if (/^c(hdir)?$/ || /^pwd$/)
	{
	    &command_list_cwd;
	}
	elsif (/^c(hdir|d)? +(.+)/)
	{
	    &command_set_cwd ($2);
	}
	elsif (/^m(ode)?$/)
	{
	    &command_list_mode;
	}
	elsif (/^m(ode)? +([^ ]+)$/)
	{
	    &command_set_mode ($2);
	}
	elsif (/^b(roadcast)?$/)
	{
	    &command_broadcast ("");
	}
	elsif (/^b(roadcast)? +(.+)$/)
	{
	    &command_broadcast ($2);
	}
	elsif (/^p(rocess)?$/)
	{
	    &command_process ("");
	}
	elsif (/^p(rocess)? +([^ ]+)$/)
	{
	    &command_process ($2);
	}
	elsif (/^l(ist)?$/)
	{
	    &command_list_almost_all;
	}
	elsif (/^f(iles)?$/)
	{
	    &command_list_files;
	}
	elsif (/^t(itle)?$/)
	{
	    &command_list_title;
	}
	elsif (/^t(itle)? +(.+)$/)
	{
	    &command_set_title ($2);
	}
	elsif (/^h(ere)?$/)
	{
	    &command_list_here;
	}
	elsif (/^h(ere)? +([^ ]+) *([^ ]*)$/)
	{
	    &command_set_here ($2, $3);
	}
	elsif (/^r(emote)?$/)
	{
	    &command_list_remote;
	}
	elsif (/^r(emote)? +([^ ]+) *([^ ]*)$/)
	{
	    &command_set_remote ($2, $3);
	}
	elsif (/^s(can)?$/)
	{
	    &command_list_scan;
	}
	elsif (/^s(can)? +([^ ]+)$/)
	{
	    &command_set_scan ($2);
	}
	elsif (/^i(gnore)?$/)
	{
	    &command_list_ignore;
	}
	elsif (/^i(gnore)? +([^ ]+)$/)
	{
	    &command_set_ignore ($2);
	}
	elsif (/^d(elete)? *r(emote)? +([^ ]+)$/)
	{
	    &command_delete_remote ($3);
	}
	elsif (/^d(elete)? *s(can)? +([^ ]+)$/)
	{
	    &command_delete_scan ($3);
	}
	elsif (/^d(elete)? *i(gnore)? +([^ ]+)$/)
	{
	    &command_delete_ignore ($3);
	}
	else
	{
	    &diagnose ("Unrecognized command \`$_\', try \`?\' for help");
	}
    }

    $command_loop = 0;
}

## List current working directory.
## Synopses: `chdir' or `pwd'.

sub command_list_cwd
{
    print `pwd`;
}

## Change current working directory.
## Synopses: `chdir DIRECTORY' or `cd DIRECTORY'.

sub command_set_cwd
{
    local ($directory) = @_;

    $directory = &expand_filename ($directory);

    if (-d $directory)
    {
	&maybe_save_config;

	if (chdir ($directory))
	{
	    $fetch_config = 1;
	}
	else
	{
	    &diagnose ("Unable to change to directory \`$directory\'");
	}
    }
    else
    {
	&diagnose ("Non-existing directory \`$directory\'");
    }
}

## List all modes.
## Synopsis: `mode'.

sub command_list_mode
{
    print STDERR "\n";
    printf STDERR
	"Init mode %-5s   Send file signatures, but no file contents\n",
	($init_mode ? "(on)" : "(off)");
    printf STDERR
	"Noop mode %-5s   Avoid sending email, do not update \`$CONFIG\'",
	($noop_mode ? "(on)" : "(off)");
    print STDERR "\n";
}

## Set one of modes.
## Synopsis: `mode MODE'.

sub command_set_mode
{
    local ($mode) = @_;

    if ($mode eq "i" || $mode eq "init")
    {
	$init_mode = 1;
    }
    elsif ($mode eq "n" || $mode eq "noop")
    {
	$noop_mode = 1;
    }
    else
    {
	&diagnose ("Unrecognized mode \`$mode\'");
    }
}

## List title, here information, all remotes, all scans and all ignores.
## Synopsis: `list'.

sub command_list_almost_all
{
    &maybe_fetch_config;

    print "\n$project_title\n\n";

    print "HERE:\n";
    &command_list_here;

    print "REMOTE:\n" if @remote;
    &command_list_remote;

    print "SCAN:\n" if %scan;
    &command_list_scan;

    print "IGNORE:\n" if %ignore;
    &command_list_ignore;
}

## List information for all files.
## Synopsis: `files'.

sub command_list_files
{
    local ($format, $field);

    &maybe_fetch_config;
    &maybe_study_files;

    $format = "  %-5s  %-${maximum_name_width}s  ";
    foreach (sort keys %signature)
    {
	printf $format, $here_signature{$_}, $_;
	foreach $field (split (/ /, $signature{$_}))
	{
	    $field = " ..." if $field eq $here_signature{$_};
	    printf "%-7s", $field;
	}
	print "\n";
    }
}

## List the title of the project.
## Synopsis: `title'.

sub command_list_title
{
    &maybe_fetch_config;

    print "$project_title\n";
}

## Set the title of the project.
## Synopsis: `title DESCRIPTION'.

sub command_set_title
{
    local ($description) = @_;

    &maybe_fetch_config;

    if ($description ne $project_title)
    {
	$project_title = $description;
	$save_config = 1;
    }
}

## List local information.
## Synopsis: `here'.

sub command_list_here
{
    &maybe_fetch_config;

    print "  [0]\t$here_email $here_home\n";
}

## Modify our local information to ADDRESS and DIRECTORY.
## Synopsis: `here ADDRESS DIRECTORY'.

sub command_set_here
{
    local ($email, $directory) = @_;

    &maybe_fetch_config;

    $email =~ tr/A-Z/a-z/;
    if ($email ne "-" && $email ne $here_email)
    {
	$here_email = $email;
	$save_config = 1;
    }

    if ($directory && $directory ne $here_home)
    {
	$here_home = &normalize_directory ($directory);
	$config_filename = &expand_filename ("$here_home/$CONFIG");
	$save_config = 1;
    }
}

## List information for all remotes.
## Synopsis: `remote'.

sub command_list_remote
{
    local ($index, $email);

    &maybe_fetch_config;

    $index = 0;
    foreach (@remote)
    {
	$index++;
	print "  [$index]\t$_ $remote{$_}\n";
    }
}

## Create a new remote given its REMOTE address, modify its DIRECTORY.
## Synopsis: `remote REMOTE DIRECTORY'.

sub command_set_remote
{
    local ($remote, $directory) = @_;
    local ($index);

    &maybe_fetch_config;

    $remote =~ tr/A-Z/a-z/;
    $remote = @remote[$remote - 1] if ($remote > 0 && $remote <= @remote);

    if (defined $remote{$remote})
    {
	if ($directory && $remote{$remote} ne $directory)
	{
	    $remote{$remote} = $directory;
	    $save_config = 1;
	}
	elsif ($remote{$remote} ne "-")
	{
	    &diagnose ("Remote directory is known to be \`$remote{$remote}\'");
	    &query ("Do you want me to keep this knowledge (y/n)? [y]");
	    if (! /(y|yes)/i)
	    {
		$remote{$remote} = "-";
		$save_config = 1;
	    }
	}
    }
    else
    {
	if ($directory)
	{
	    &create_remote ($remote, $directory);
	}
	else
	{
	    &create_remote ($remote, "-");
	    $index = @remote;
	    &warn ("You may also use \`remote $index DIRECTORY\'"
		   . " if you know the remote directory");
	}
    }
}

## Delete an existing remote given its ADDRESS address.
## Synopsis: `delete remote ADDRESS'.

sub command_delete_remote
{
    local ($remote) = @_;

    &maybe_fetch_config;

    $remote = @remote[$remote - 1] if ($remote > 0 && $remote <= @remote);
    &delete_remote ($remote);
}

## List information for all scans.
## Synopsis: `scan'.

sub command_list_scan
{
    local ($index);

    &maybe_fetch_config;

    $index = 0;
    @scan = ();
    foreach (sort keys %scan)
    {
	$index++;
	push (@scan, $_);
	print "  [$index]\t$_\n";
    }
}

## Create a new SCAN.
## Synopsis: `scan SCAN'.

sub command_set_scan
{
    local ($scan) = @_;

    &maybe_fetch_config;

    if (defined $scan{$scan})
    {
	&diagnose ("Redundant creation of scan \`$scan\'");
    }
    else
    {
	$scan{$scan} = 1;
	$save_config = 1;
	$study_files = 1;
    }
}

## Delete an existing SCAN.
## Synopsis: `delete scan SCAN'.

sub command_delete_scan
{
    local ($scan) = @_;

    &maybe_fetch_config;

    $scan = @scan[$scan - 1] if ($scan > 0 && $scan <= @scan);
    if (defined $scan{$scan})
    {
	delete $scan{$scan};
	$save_config = 1;
	$study_files = 1;
    }
    else
    {
	&diagnose ("Cannot delete inexisting scan \`$scan\'");
    }
}

## List information for all ignores.
## Synopsis: `ignore'.

sub command_list_ignore
{
    local ($index);

    &maybe_fetch_config;

    $index = 0;
    @ignore = ();
    foreach (sort keys %ignore)
    {
	$index++;
	push (@ignore, $_);
	print "  [$index]\t$_\n";
    }
}

## Create a new IGNORE.
## Synopsis: `ignore IGNORE'.

sub command_set_ignore
{
    local ($ignore) = @_;

    &maybe_fetch_config;

    if (defined $ignore{$ignore})
    {
	&diagnose ("Redundant creation of ignore \`$ignore\'");
    }
    else
    {
	$ignore{$ignore} = 1;
	$save_config = 1;
	$study_files = 1;
    }
}

## Delete an existing IGNORE.
## Synopsis: `delete ignore IGNORE'.

sub command_delete_ignore
{
    local ($ignore) = @_;
    local ($index);

    &maybe_fetch_config;

    $ignore = @ignore[$ignore - 1] if ($ignore > 0 && $ignore <= @ignore);
    if (defined $ignore{$ignore})
    {
	delete $ignore{$ignore};
	$save_config = 1;
	$study_files = 1;
    }
    else
    {
	&diagnose ("Cannot delete inexisting ignore \`$ignore\'");
    }
}

# Broadcasting away synchronization packages.

## Export a synchronization package to each site of SET.
## Synopsis: `broadcast SET'.

sub command_broadcast
{
    local ($set) = @_;
    local ($site, $index, $ordinal, $file, @signature);

    &maybe_fetch_config;

    &decode_site_set ($set);
    foreach $site (@site_set)
    {
	&warn ("");
	&warn ("Broadcasting to address \`$remote[$site]\'");

	if (-f $ARCHIVE && ! $noop_mode)
	{
	    &diagnose ("The archive \`$ARCHIVE\' already exists!");
	    &query ("Should I delete it for you (y/n)? [n]");
	    &interrupt ("Command aborted!") if ! /^(y|yes)/i;
	    unlink $ARCHIVE
		|| &interrupt ("Cannot delete file \`$ARCHIVE\'");
	}
	if (-d $WORKDIR && ! $noop_mode)
	{
	    &diagnose ("The work directory \`$WORKDIR\' already exists!");
	    &query ("Should I remove all of it first (y/n)? [y]");
	    &interrupt ("Command aborted!") if ! /^(y|yes)/i;
	    system "rm -rf $WORKDIR"
		|| &interrupt ("Cannot remove directory \`$WORKDIR\'");
	}

	&maybe_study_files;
	&update_file_registry;

	# Initialize the invoice.

	if (! $noop_mode)
	{
	    mkdir ($WORKDIR, 0700)
		|| &interrupt ("Unable to make directory \`$WORKDIR\'");
	    open (OUTPUT, ">$WORKDIR/$ORDERS")
		|| &interrupt ("Cannot create file \`$WORKDIR/$ORDERS\'");

	    print OUTPUT "format\t$PROGRAM $FORMAT\n";
	    print OUTPUT "title\t$project_title\n";
	    print OUTPUT "here\t$here_email $here_home\n";
	    foreach (@remote)
	    {
		print OUTPUT "remote\t$_ $remote{$_}\n";
	    }
	    foreach (sort keys %scan)
	    {
		print OUTPUT "scan\t$_\n";
	    }
	    foreach (sort keys %ignore)
	    {
		print OUTPUT "ignore\t$_\n";
	    }

	    print OUTPUT "visit\t$site\n";
	    print OUTPUT "copy\t", join (" ", @site_set), "\n";
	}

	# Transmit all file signatures and replacement orders.

	$ordinal = 0;
	foreach $file (sort keys %signature)
	{
	    if (! $noop_mode)
	    {
		print OUTPUT "check\t$file $here_signature{$file}";
		@signature = split (/ /, $signature{$file});
		foreach (@site_set)
		{
		    print OUTPUT " ", $signature[$_];
		}
		print OUTPUT "\n";
	    }

	    next if $init_mode;
	    next if $signature[$site] eq $here_signature{$file};

	    &warn ("Packaging file \`$file\'");
	    if (! $noop_mode)
	    {
		$ordinal++;
		symlink ("../$file", "$WORKDIR/$ordinal");
		print OUTPUT "update\t$file $signature[$site] $ordinal\n";
	    }
	    $signature[$site] = $here_signature{$file};
	    $signature{$file} = join (" ", @signature);
	    $save_config = 1;
	}

	# Complete the invoice.

	if (! $noop_mode)
	{
	    close OUTPUT;
	    system "$TAR cfzh $ARCHIVE $WORKDIR"
		|| &interrupt ("Cannot construct archive \`$ARCHIVE\'"
			       . " from directory \`$WORKDIR\'");
	    system "rm -rf $WORKDIR"
		|| &interrupt ("Cannot remove directory \`$WORKDIR\'");
	    system "mailshar $remote[$site] $ARCHIVE"
		|| &interrupt ("Cannot send file \`$ARCHIVE\'"
			       . " to address \`$remote[$site]\'");
	    unlink $ARCHIVE
		|| &interrupt ("Cannot delete file \`$ARCHIVE\'");
	}
    }
    &warn ("Command \`broadcast\' done");
}

# Processing received synchronization packages.

## Import a FILE or use an already exploded DIRECTORY.
## Synopses: `process [FILE]' or `process [DIRECTORY]'.

sub command_process
{
    local ($argument) = @_;
    local ($archive, $prior, $file, @signature);

    $work_directory = &expand_filename ($WORKDIR);

    if ($argument)
    {
	$archive = &expand_filename ($argument);
    }
    elsif (-f $ARCHIVE)
    {
	$archive = &expand_filename ($ARCHIVE);
	$archive_to_unlink = $archive if ! $noop_mode;
    }
    elsif (-d $WORKDIR)
    {
	$archive = $work_directory;
    }
    else
    {
	&interrupt ("No argument, no archive \`$ARCHIVE\'"
		    . " and no directory \`$WORKDIR\'");
    }

    if (-f $archive)
    {
	&warn ("Exploding archive \`$archive\'");

	if (-d $WORKDIR)
	{
	    &diagnose ("The work directory \`$WORKDIR\' already exists!");
	    &query ("Should I remove all of it first (y/n)? [y]");
	    &interrupt ("Command aborted!") if ! /^(y|yes)/i;
	    system "rm -rf $WORKDIR"
		|| &interrupt ("Cannot remove directory \`$WORKDIR\'");
	}

	system "$TAR xfoz $archive"
	    || &interrupt ("Failure while untarring file \`$archive\'");
	$workdir_to_unlink = $work_directory;
    }

    chop ($prior = `pwd`);
    open (PACKAGE, "$work_directory/$ORDERS")
	|| &interrupt ("Cannot read file \`$work_directory/$ORDERS\'");

    &process_loop;

    close PACKAGE;
    chdir $prior;

    if ($workdir_to_unlink)
    {
	unlink "$workdir_to_unlink/$ORDERS"
	    || &diagnose ("Cannot delete file \`$workdir_to_unlink/$ORDERS\'");
	rmdir $workdir_to_unlink
	    || &diagnose ("Cannot remove directory \`$workdir_to_unlink\'");
	$workdir_to_unlink = "";
    }

    if ($archive_to_unlink)
    {
	unlink $archive_to_unlink
	    || &diagnose ("Cannot delete file \`$archive_to_unlink\'");
	$archive_to_unlink = "";
    }
    &warn ("Command \`process\' done");
}

## Decode each received package orders, in turn.  Most validation
## is delayed until the \`visit\' order.

sub process_loop
{
    $process_loop = 1;

  PROCESS_LOOP:
    while (<PACKAGE>)
    {
	chop;

	# Handle commands not requiring the analysis of file $CONFIG.

	if (/^(format|version)\t$PROGRAM ([^ ]+)$/o)
	{
	    &interrupt
		("Need $PROGRAM (format $FORMAT) to process this package!")
		    if $2 ne $FORMAT;
	}
	elsif (/^title\t(.*)/)
	{
	    $project_title_received = $1;
	}
	elsif (/^(here|local)\t([^ ]+) ([^ ]+)$/)
	{
	    ($here_email_received, $here_home_received) = ($2, $3);
	    $here_email_received =~ tr/A-Z/a-z/;
	}
	elsif (/^remote\t([^ ]+) ([^ ]+)$/)
	{
	    push (@remote_received, $1);
	    $remote_received{$1} = $2;
	    $remote_received =~ tr/A-Z/a-z/;
	}
	elsif (/^scan\t([^ ]+)$/)
	{
	    $scan_received{$1} = 1;
	}
	elsif (/^ignore\t([^ ]+)$/)
	{
	    $ignore_received{&convert_ignore ($1)} = 1;
	}
	elsif (/^visit\t([^ ]+)$/)
	{
	    &process_visit ($1);
	}
	elsif (/^copy\t(.+)/)
	{
	    &process_copy ($1);
	}
	elsif (/^check\t([^ ]+) ([^ ]+) (.+)/)
	{
	    &process_check ($1, $2, $3);
	}
	elsif (/^update\t([^ ]+) ([^ ]+) ([^ ]+)$/)
	{
	    &process_update ($1, $2, $3);
	}
	else
	{
	    &interrupt ("Unrecognized command \`$_\' in process input");
	}
    }

    $process_loop = 0;
    &update_file_registry;

    if (%signature_received)
    {
	foreach $file (sort keys %signature)
	{
	    if (! defined $signature_received{$file})
	    {
		&diagnose ("File \`$file\' is not registered remotely");

		@signature = split (/ /, $signature{$file});
		if ($signature[$from_email] ne "-")
		{
		    $signature[$from_email] = "-";
		    $save_config = 1;
		    $signature{$file} = join (" ", @signature);
		}

		&query ("Should I delete this file, here too (y/n)? [n]");
		if (/^(y|yes)$/i)
		{
		    if (! $noop_mode)
		    {
			unlink $file
			    || &diagnose ("Cannot delete file \`$file\'");
		    }
		    delete $signature{$file};
		}
	    }
	}
    }
}

## Prepare to visit a directory, conciliating all received information.
## Synopsis: `visit VISITED', where VISITED is an index in remotes.

sub process_visit
{
    local ($visited) = @_;
    local ($email, $home, $string, $scan, $ignore);

    &maybe_save_config;

    &warn ("");
    &warn ("Package being received:");
    &warn ("  from address \`$here_email_received\'");
    &warn ("  for project \`$project_title_received\'");

    # Check the recipient address.

    $email = &guess_here_email;
    $string = $remote_received[$visited];

    if (! &equivalent_email ($email, $string))
    {
	&diagnose ("This package was sent to address \`$string\'");
	&warn ("but your address is known to be \`$email\'");
	&warn ("");
	&warn ("The possibilities at this point are:");
	&warn ("  1. Correct your full email address to \`$string\'");
	&warn ("  2. Use your current email address \`$email\'");
	&warn ("  3. Specify another full email address (beware!)");
	&warn ("  4. Abandon the processing of this package");
	$_ = "";
	&query ("Which action do you choose (1-4)? [1]")
	    while ! /^[1-4]$/;
	if ($_ eq "1")
	{
	    $email = $string;
	}
	elsif ($_ eq "3")
	{
	    $_ = &guess_here_email;
	    &query ("What is your full email address, here? [$_]");
	    $email = $_;
	}
	elsif ($_ eq "4")
	{
	    &interrupt ("Command aborted!");
	}
    }

    # Check the recipient directory.

    $string = $remote_received{$string};
    $_ = &expand_filename ($string);
    if (-d $_)
    {
	$home = $string;
    }
    else
    {
	chop ($_ = `pwd`);
	$home = &normalize_directory ($_);

	&diagnose ("This package was aimed for directory \`$string\'");
	&warn ("but this directory does not exist here");
	&warn ("");
	&warn ("The possibilities at this point are:");
	&warn ("  1. Attempt creating the \`$string\' directory");
	&warn ("  2. Use the current directory \`$home\' (are you sure?)");
	&warn ("  3. Specify another synchronized directory (beware!)");
	&warn ("  4. Abandon the processing of this package");
	$_ = "";
	&query ("Which action do you choose (1-4)? [1]")
	    while ! /^[1-4]$/;
	if ($_ eq "1")
	{
	    $home = $string;
	}
	elsif ($_ eq "3")
	{
	    &query ("Which directory should be used? [$home]");
	    $home = &normalize_directory ($_);
	}
	elsif ($_ eq "4")
	{
	    &interrupt ("Command aborted!");
	}
    }

    # Force our way to the wanted directory.

    &warn ("Visiting directory \`$home',"
	   . " remote was \`$here_home_received\'");

    $home = &expand_filename ($home);
    &prepare_filename ("$home/$CONFIG");
    chdir $home || &interrupt ("Cannot change directory to \`$home\'");

    # Swallow or simulate the $CONFIG file.

    if (-f "$home/$CONFIG")
    {
	$fetch_config = 1;
	&maybe_fetch_config;

	# Reconciliate $project_title.

	if ($project_title ne $project_title_received)
	{
	    &diagnose ("The package title is \`$project_title_received\'");
	    &warn ("but \`$CONFIG\' says it should be \`$project_title\'");
	    &warn ("");
	    &warn ("The possibilities at this point are:");
	    &warn ("  1. Use \`$project_title_received\' as title");
	    &warn ("  2. Keep \`$project_title' as title\'");
	    &warn ("  3. Specify another project title");
	    $_ = "";
	    &query ("Which action do you choose (1-3)? [1]")
		while ! /^[1-3]$/;
	    if ($_ eq "1")
	    {
		$project_title = $project_title_received;
	    }
	    elsif ($_ eq "3")
	    {
		&query ("What will be the new project title?");
		$project_title = $_;
	    }
	}

	# Reconciliate $here_email.

	if (! &equivalent_email ($email, $here_email))
	{
	    &diagnose ("This package is sent to address \`$here_email\'");
	    &warn ("but \`$CONFIG\' says it should have been \`$email\'");
	    &warn ("");
	    &warn ("The possibilities at this point are:");
	    &warn ("  1. Use your current full email address \`$email\'");
	    &warn ("  2. Correct your full email address to \`$here_email\'");
	    &warn ("  3. Specify another full email address");
	    $_ = "";
	    &query ("Which action do you choose (1-3)? [1]")
		while ! /^[1-3]$/;
	    if ($_ eq "1")
	    {
		$here_email = $email;
	    }
	    elsif ($_ eq "3")
	    {
		$_ = &guess_here_email;
		&query ("What is your full email address, here? [$_]");
		$here_email = $_;
	    }
	}

	# Reconciliate $here_home.

	$home = &normalize_directory ($home);
	if ($home ne $here_home)
	{
	    &diagnose ("This package is aimed for directory \`$here_home\'");
	    &warn ("but \`$CONFIG\' says it should have been \`$home\'");
	    &warn ("");
	    &warn ("The possibilities at this point are:");
	    &warn ("  1. Record the \`$home\' directory in the configuration");
	    &warn ("  2. Correct the directory to \`$here_home\'");
	    &warn ("  3. Record another name for this directory (beware!)");
	    $_ = "";
	    &query ("Which action do you choose (1-3)? [1]")
		while ! /^[1-3]$/;
	    if ($_ eq "1")
	    {
		$here_home = $home;
		$config_filename = &expand_filename ("$here_home/$CONFIG");
	    }
	    elsif ($_ eq "3")
	    {
		&query ("Which directory should be used? [$home]");
		$here_home = &normalize_directory ($_);
		$config_filename = &expand_filename ("$here_home/$CONFIG");
	    }
	}

	# Reconciliate remote information.

	foreach $remote (sort keys %remote)
	{
	    if (defined $remote_received{$remote})
	    {
		if ($remote{$remote} ne $remote_received{$remote})
		{
		    &diagnose ("Conflicting directories for \`$remote\'");
		    &warn ("registered as \`$remote{$remote}\' here and");
		    &warn ("as \`$remote_received{$remote}\' remotely");
		}
		delete $remote_received{$remote};
	    }
	    elsif ($remote ne $here_email_received)
	    {
		&diagnose ("Remote \`$remote\' is not registered remotely");
		&query ("Should I unregister it here (y/n)? [n]");
		delete $remote{$remote} if /(y|yes)/i;
	    }
	}
	foreach $remote (sort keys %remote_received)
	{
	    if ($remote ne $here_email)
	    {
		&diagnose ("Remote \`$remote\' is registered remotely"
			   . " and not locally");
		&query ("Should I register it here (y/n)? [y]");
		&create_remote ($remote, $remote_received{$remote})
		    if (/(y|yes)/i);
	    }
	    delete $remote_received{$remote};
	}

	# Reconciliate scan information.

	foreach $scan (sort keys %scan)
	{
	    if (defined $scan_received{$scan})
	    {
		delete $scan_received{$scan};
	    }
	    else
	    {
		&diagnose ("Scan \`$scan\' is not registered remotely");
		&query ("Should I unregister it here (y/n)? [n]");
		delete $scan{$scan} if /(y|yes)/i;
	    }
	}
	foreach $scan (sort keys %scan_received)
	{
	    &diagnose
		("Scan \`$scan\' is registered remotely and not locally");
	    &query ("Should I register it here (y/n)? [y]");
	    $scan{$scan} = $NEWLY_CREATED_SCAN if /(y|yes)/i;
	    delete $scan_received{$scan};
	}

	# Reconciliate ignore information.

	foreach $ignore (sort keys %ignore)
	{
	    if (defined $ignore_received{$ignore})
	    {
		delete $ignore_received{$ignore};
	    }
	    else
	    {
		&diagnose ("Ignore \`$ignore\' is not registered remotely");
		&query ("Should I unregister it here (y/n)? [n]");
		delete $ignore{$ignore} if /(y|yes)/i;
	    }
	}
	foreach $ignore (sort keys %ignore_received)
	{
	    &diagnose
		("Ignore \`$ignore\' is registered remotely and not locally");
	    &query ("Should I register it here (y/n)? [y]");
	    $ignore{$ignore} = 1 if /(y|yes)/i;
	    delete $ignore_received{$ignore};
	}
    }
    else
    {

	# Use remote information for initializing the local one.

	&warn ("Initializing file \`$CONFIG\' from received information");

	$project_title = $project_title_received;
	$here_email = $remote_received[$visited];
	$here_home = $remote_received{$here_email};
	$config_filename = &expand_filename ("$here_home/$CONFIG");

	if ($here_email ne $here_email_received)
	{
	    $remote_received[$visited] = $here_email_received;
	    $remote_received{$here_email_received} = $here_home_received;
	    delete $remote_received{$here_email};
	}

	@remote = @remote_received;

	%remote = %remote_received;
	%remote_received = ();
	%scan = %scan_received;
	%scan_received = ();
	%ignore = %ignore_received;
	%ignore_received = ();

	$new_config = 1;
	$save_config = 1;
	$fetch_config = 0;
	$study_files = 1;
    }
}

## Package was sent to each address in SET.
## Synopsis: `copy SET'.

sub process_copy
{
    local ($set) = @_;
    local ($index);

    &maybe_fetch_config;

    @copy_list = ();
    $counter = 0;
    foreach (split (" ", $set))
    {
	$_ = $remote_received[$_];

	$copy_list[$counter++]
	    = $_ eq $here_email ? -1 : &validated_remote_index ($_);
    }
}

## Set FILE signatures to SIGNATURE, given a SET of previous values.
## Synopsis: `check FILE SIGNATURE SET'.

sub process_check
{
    local ($file, $signature, $set) = @_;
    local (@signature, @check, $counter, $new_signature);

    @check = split (" ", $set);
    &interrupt ("Unmatching number of signatures for file \`$file\'")
	if @check != @copy_list;

#   &maybe_fetch_config;
    &maybe_study_files;

    if (defined $signature{$file})
    {
	@signature = split (/ /, $signature{$file});
    }
    else
    {
	@signature = ("-") x @remote;
    }
    if ($signature ne $signature[$from_email])
    {
	$signature[$from_email] = $signature;
	$save_config = 1;
    }
    for ($counter = 0; $counter < @check; $counter++)
    {
	if ($copy_list[$counter] >= 0 && $check[$counter] ne "-")
	{
	    if ($signature[$copy_list[$counter]] eq "-"
		|| $signature[$copy_list[$counter]] eq $check[$counter])
	    {
		$new_signature = $signature;
	    }
	    else
	    {

		# If we do have an idea of a remote file\'s signature, and
		# if this idea is contradicted by a synchronization
		# package, rather say we know nothing besides that the
		# file merely exists.  Give it a signature from hell.

		$new_signature = "666";
	    }
	    if ($new_signature ne $signature[$copy_list[$counter]])
	    {
		$signature[$copy_list[$counter]] = $new_signature;
		$save_config = 1;
	    }
	}
    }

    $signature{$file} = join (" ", @signature);
    $signature_received{$file} = 1;
}

## If FILE checks to SIGNATURE, replace it by PACKAGED.
## Synopsis: `update FILE SIGNATURE PACKAGED'.

sub process_update
{
    local ($file, $old_signature, $packaged) = @_;
    local ($action, $cautious, $packaged_signature);

    $packaged = "$work_directory/$packaged";

#   &maybe_fetch_config;
#   &maybe_study_files;

    if (&ignorable_file ($file))
    {
	&diagnose ("File \`$file\' is the subject of some \`ignore\'");
	&query ("Should I accept it nevertheless (y/n)? [n]");
	$action = "UNLINK" if ! /^(y|yes)$/i;
    }

    if (! $action && -f $file && ! defined $here_signature{$file})
    {
	&diagnose ("File \`$file\' was not locally scanned");
	$here_signature{$file} = &single_signature ($file);
	$cautious = 1;
    }

    if (! $action && -f $file && $old_signature eq $here_signature{$file})
    {
	if ($cautious)
	{
	    &query ("Show diffs before updating it (y/n)? [y]");
	    $action = /^(y|yes)$/i ? "DIFF" : "MOVE";
	}
	else
	{
	    &warn ("Updating file \`$file\'");
	    $action = "MOVE";
	}
    }

    if (! $action && -f $file)
    {
	$packaged_signature = &single_signature ($packaged);
	if ($old_signature eq "-")
	{
	    if ($packaged_signature eq $here_signature{$file})
	    {
		&diagnose ("Redundant creation of file \`$file\'");
		$action = "UNLINK";
	    }
	    else
	    {
		&diagnose ("Unexpected preexisting file \`$file'");
		$action = "DIFF";
	    }
	}
	else
	{
	    if ($packaged_signature eq $here_signature{$file})
	    {
		&diagnose ("Redundant updating of file \`$file\'");
		$action = "UNLINK";
	    }
	    else
	    {
		&diagnose ("Local changes occurred to file \`$file\'");
		$action = "DIFF";
	    }
	}
    }

    if (! $action)		# $file does not exist locally
    {
	if ($old_signature eq "-")
	{
	    &warn ("Creating new file \`$file\'");
	    $action = "MOVE";
	}
	else
	{
	    &diagnose ("File \`$file\' has locally disappeared");
	    &query ("Should I recreate it from remote copy (y/n)? [y]");
	    $action = /^(y|yes)$/i ? "MOVE" : "UNLINK";
	}
    }

    if ($action eq "DIFF")
    {
	&warn ("");
	&warn ("$DIFF -u $file $packaged");
	system "$DIFF -u $file $packaged";
	&warn ("");
	&warn ("Before replying to next question, please reconciliate:");
	&warn ("  -) \`$file\'");
	&warn ("  +) \`$packaged\'");
	&warn ("");
	&query ("Now, which of these files should be kept (-/+)? [-]");
	$action = /^\+$/ ? "MOVE" : "UNLINK";
    }

    if ($action eq "UNLINK" && ! $noop_mode)
    {
	unlink $packaged || &diagnose ("Cannot delete file \`$packaged\'");
    }

    if ($action eq "MOVE" && ! $noop_mode)
    {
	if (-f $file)
	{
	    unlink $file || &diagnose ("Cannot delete file \`$file\'");
	}
	&prepare_filename ($file);
	system "mv $packaged $file"
	    || &interrupt ("Cannot move packaged file into \`$file\'");
	$here_signature{$file} = &single_signature ($file);
    }
}

# $CONFIG file maintainance.

## Digest in file \`$CONFIG\' if not done already.

sub maybe_fetch_config
{
    local (@signature, $index, $string);

    return if ! $fetch_config;

    %remote = ();
    %scan = ();
    %ignore = ();
    %signature = ();

    if (open (CONFIG, $CONFIG))
    {
	while (chop ($_ = <CONFIG>))
	{
	    next if /^$/;
	    next if /^#/;

	    if (/^(format|version)\t$PROGRAM ([^ ]+)$/o
		||/^($PROGRAM|version)\t([^ ]+)$/o)
	    {
		&interrupt ("$CONFIG:$.: Unmatching format for $CONFIG")
		    if $2 ne $FORMAT;
	    }
	    elsif (/^title\t(.*)$/)
	    {
		$project_title = $1;
		&warn ("Reading configuration for project \`$project_title\'");
	    }
	    elsif (/^(here|local)\t([^ ]+) ([^ ]+)$/)
	    {
		($here_email, $here_home) = ($2, $3);
		$here_email =~ tr/A-Z/a-z/;
		$config_filename = &expand_filename ("$here_home/$CONFIG");
	    }
	    elsif (/^remote\t([^ ]+) ([^ ]+)$/)
	    {
		$string = $1;
		$string =~ tr/A-Z/a-z/;
		$saved_save_config = $save_config;
		&create_remote ($1, $2);
		$save_config = $saved_save_config;
	    }
	    elsif (/^scan\t([^ ]+)$/)
	    {
		$scan{$1} = 1;
	    }
	    elsif (/^ignore\t([^ ]+)$/)
	    {
		$ignore{&convert_ignore ($1)} = 1;
	    }
	    elsif (/^\t([^ ]+) (.*)/)
	    {

		# Temporary code, the time everything is getting updated.
		# Was: $signature{$1} = $2;

		@signature = split (/ /, $2);
		for ($index = 0; $index < @remote; $index++)
		{
		    if (! $signature[$index])
		    {
			&diagnose ("Empty signature for file \`$1\' [$index]");
			$signature[$index] = "-";
			$save_config = 1;
		    }
		}
		$signature{$1} = join (" ", @signature);
	    }
	    else
	    {
		&interrupt ("** $CONFIG:$.: Illegal format for $CONFIG");
	    }
	}
	close CONFIG;

	if (! $project_title)
	{
	    &diagnose ("There is no title for this project.");
	    &query ("Please enter a short project description:");
	    $project_title = $_;
	}
    }
    else
    {
	chop ($_ = `pwd`);
	$_ = &normalize_directory ($_);
	&diagnose ("Directory \`$_\' is not ready for synchronization");
	&query ("Should I prepare it for its first time (y/n)? [y]");
	&interrupt ("Command aborted!") if ! /^(y|yes)$/i;
	$new_config = 1;

	&query ("Please enter a short project description:");
	$project_title = $_;

	$_ = &guess_here_email;
	&query ("What is your full email address, here? [$_]");
	$here_email = $_;

	chop ($_ = `pwd`);
	$here_home = &normalize_directory ($_);
	$config_filename = &expand_filename ("$here_home/$CONFIG");

	foreach (("(.*/)?core(\\..*)?",
		  ".*,v",
		  ".*/RCS/.*",
		  ".*\\.(bak|BAK)",
		  ".*\\.[oa]",
		  ".*~",
		  "\\$CONFIG.*",
		  "\\\#.*"))
	{
	    $ignore{$_} = 1;
	}
    }

    $fetch_config = 0;
    $save_config = 1;
    $study_files = 1;
}

## Write back file \`$CONFIG\' if it has been modified.

sub maybe_save_config
{
    local ($index);

    return if ! $save_config;
    $save_config = 0;
    return if $noop_mode;

    if (! $new_config)
    {
	unlink "$config_filename.bak";
	rename ("$config_filename", "$config_filename.bak")
	    || &interrupt ("Cannot backup file \`$config_filename'");
    }

    open (CONFIG, ">$config_filename")
	|| &interrupt ("Cannot create file \`$config_filename\'");
    print CONFIG
	"# This file is maintained automatically by program \`$PROGRAM\'.",
	"  DO NOT EDIT!\n";
    print CONFIG "\n";
    print CONFIG "format\t$PROGRAM $FORMAT\n";
    print CONFIG "title\t$project_title\n";
    &diagnose ("There is no project title, yet") if ! $project_title;
    print CONFIG "here\t$here_email $here_home\n";
    &diagnose ("There are no declared remote connections, yet")
	if ! @remote;
    foreach (@remote)
    {
	print CONFIG "remote\t$_ $remote{$_}\n";
    }
    print CONFIG "\n";
    foreach (sort keys %scan)
    {
	print CONFIG "scan\t$_\n";
    }
    foreach (sort keys %ignore)
    {
	print CONFIG "ignore\t$_\n";
    }
    foreach (sort keys %signature)
    {
	print CONFIG "\t", $_, " ", $signature{$_}, "\n";
    }
    close CONFIG;
}

## Scan for files with \`find\' and \`sum\', unless this is done already.

sub maybe_study_files
{
    local ($list, $signature, $file);

    # Do not execute this lengthy process without reason.

    return if ! $study_files;
    &warn ("Studying local files for their signature");

    # Find the proper "sum" command.

    if (! $sum_command)
    {
	foreach (("sum", "sum -r"))
	{
	    if (`echo x | $_` =~ /^00070 /)
	    {
		$sum_command = $_;
		last;
	    }
	}
	&interrupt ("Cannot find BSD program \`sum\' around")
	    if ! $sum_command;
    }

    # Trigger execution of find with all the %scan parameters.

    if (%scan == 0)
    {
	$list = " .";
    }
    else
    {
	$list = "";
	foreach (sort keys %scan)
	{
	    $list .= " '$_'";
	}
    }

    open (SCAN, ("find$list -type f -print 2> /tmp/$$.find"
		 . " | xargs $sum_command |"))
	|| &interrupt ("Cannot launch program \`find\'");

    # Process each existing file in turn.

    %here_signature = ();
    $maximum_name_width = 0;

    while (<SCAN>)
    {
	if (/^([0-9]+) +[0-9]+ +(\.\/)?(.*)/)
	{
	    ($signature, $file) = ($1, $3);
	}
	else
	{
	    chop;
	    &diagnose ("Unrecognized output from program \`sum\': \`$_\'");
	    next;
	}

	next if &ignorable_file ($file);

	$here_signature{$file} = $signature;
	$maximum_name_width = length $file
	    if length $file > $maximum_name_width;
    }
    close SCAN;

    # Clean out scanning for inexisting files.

    open (SCAN, "/tmp/$$.find");
    while (<SCAN>)
    {
	chop;
	if (/^find: (.*): No such file or directory$/)
	{
	    $file = $1;
	    &diagnose ("No files found while scanning for \`$file\'");
	    if (! defined $scan{$file})
	    {
		&diagnose ("And this is not even a valid scan.  Bizarre...");
	    }
	    elsif ($scan{$file} != $NEWLY_CREATED_SCAN)
	    {
		&query ("Should I delete this scan (y/n)? [y]");
		if (/^(y|yes)$/i)
		{
		    &delete_scan ($file);
		}
		else
		{
		    &diagnose ("Please ensure some local file exists for it!");
		}
	    }
	}
	else
	{
	    &diagnose ("Scan error: $_");
	}
    }
    close SCAN;
    unlink "/tmp/$$.find";

    $study_files = 0;
}

## Compute \`sum\' over a single file.

sub single_signature
{
    (split (" ", `$sum_command $_[0]`))[0];
}

## Update file and signature matrix according to what exists here.

sub update_file_registry
{
    local ($cautious);

    foreach (sort keys %signature)
    {
	if (! defined $here_signature{$_})
	{
	    &warn ("Unregistering file \`$_\'");
	    delete $signature{$_};
	    $save_config = 1;
	}
    }

    foreach (sort keys %here_signature)
    {
	if (! defined $signature{$_})
	{
	    &warn ("Registering file \`$_\'");
	    $signature{$_} = join (" ", ("-") x @remote);
	    $save_config = 1;
	    $cautious = 1;
	}
    }

    if ($cautious && !$process_loop)
    {
	&diagnose ("There were new registrations, please check them");
	&query ("Should I resume the current command (y/n)? [y]");
	&interrupt ("Command aborted!") if ! /^(y|yes)$/i;
    }
}

# Identification and filename services.

## Return a sensible suggestion for our probable email address.

sub guess_here_email
{
    return $here_email if $here_email;

    chop ($_ = `hostname`);
    if (/\./)
    {
	$_ = "$ENV{'LOGNAME'}@$_";
    }
    else
    {
	$_ .= "!$ENV{'LOGNAME'}";
    }
    tr/A-Z/a-z/;
    return $_;
}

## Use forgiving rules to test for equivalence between EMAIL_LEFT
## and EMAIL_RIGHT.

sub equivalent_email
{
    local ($email_left, $email_right) = @_;
    local ($user_left, $user_right, $domain_left, $domain_right);

    if ($email_left =~ /(.+)@(.+)/)
    {
	($user_left, $domain_left) = ($1, $2);
    }
    elsif ($email_left =~ /(.+)!([^!]+)/)
    {
	($user_left, $domain_left) = ($2, $1);
    }
    else
    {
	($user_left, $domain_left) = ($email_left, "");
    }

    if ($email_right =~ /(.+)@(.+)/)
    {
	($user_right, $domain_right) = ($1, $2);
    }
    elsif ($email_right =~ /(.+)!([^!]+)/)
    {
	($user_right, $domain_right) = ($2, $1);
    }
    else
    {
	($user_right, $domain_right) = ($email_right, "");
    }

    $domain_left =~ s/\.uucp$//;
    $domain_right =~ s/\.uucp$//;

    return 0 if ($user_left !~ /^$user_right(-batch)?$/
		 && $user_right !~ /^$user_left(-batch)?$/);

    return 0 if ($domain_left !~ /$domain_right$/
		 && $domain_right !~ /$domain_left$/);
    1;
}

## Return the given filename expanded so the system will recognize it.

sub expand_filename
{
    local ($pwd);

    $_ = @_[0];
    if (/^~/)
    {
	return $ENV{"HOME"} if /^~$/;
	s|^~/|$ENV{"HOME"}/|;
    }
    return $_ if /^\//;

    chop ($pwd = `pwd`);
    "$pwd/$_";
}

## Return the given directory normalized so the user will like
## it more.  However, still avoid relative notations.

sub normalize_directory
{
    return "~" if $_[0] eq $ENV{"HOME"};

    $_ = $_[0];
    s|^$ENV{"HOME"}/|~/|;
    chop ($_ = `cd $_; pwd`) if ! /^[~\/]/;
    $_;
}

## Ensure intermediate directories exist by creating them as needed,
## and that the appropriate permissions are set for the FILE to be
## created or replaced.

sub prepare_filename
{
    local ($filename) = @_;
    local (@filename, $counter);

    if (-e $filename)
    {
	&interrupt ("Cannot modify read-only file \`$filename\'")
	    if ! -w $filename;
	return;
    }

    @filename = split (/\//, $filename);
    pop @filename;

    for ($counter = $filename[0] ? 0 : 1; $counter < @filename; $counter++)
    {
	$filename = join ("/", @filename[0 .. $counter]);
	next if -d $filename;
	&warn ("  Creating new directory \`$filename\'");
	if (! mkdir ($filename, 0755))
	{
	    &interrupt ("Cannot create directory \`$filename\'");
	    return;
	}
    }
}

# Various services.

## Convert IGNORE from previous "local" format to current "here" format.
## This routine is meant to disappear soon after everything stabilized.

sub convert_ignore
{
    $_ = $_[0];

    if (/^[\^\/](.*)/ || /(.*)[\$\/]$/)
    {
	if (/^\^(.*)/)
	{
	    $_ = $1;
	}
	else
	{
	    $_ = ".*$_";
	}

	if (/(.*)\$$/)
	{
	    $_ = $1;
	}
	else
	{
	    $_ = "$_.*";
	}
	$save_config = 1;
    }

    return $_;
}

## Says whether if FILE should be ignored.

sub ignorable_file
{
    local ($file) = @_;

    foreach (keys %ignore)
    {
	if (/^!(.*)/)
	{
	    return 1 if $file !~ /^$1$/;
	}
	else
	{
	    return 1 if $file =~ /^$_$/;
	}
    }
    0;
}

## Initialize @site_set according to the given SET.

sub decode_site_set
{
    local ($set) = @_;
    local ($index, $counter);

    if ($set eq "")
    {
	@site_set = 0 .. @remote - 1;
    }
    elsif ($set eq "!")
    {
	@site_set = ();
    }
    elsif ($set =~ /!(.*)/)
    {
	@site_set = 0 .. @remote - 1;
	foreach (split (" ", $1))
	{
	    $site_set[&validated_remote_index ($_)] = "";
	}
	@site_set = grep (/./, @site_set);
    }
    else
    {
	@site_set = ();
	@copy_list = ();	# used to parallel "from" and "check" lines
	$counter = 0;
	foreach (split (" ", $set))
	{
	    $index = &validated_remote_index ($_);
	    $copy_list[$counter++] = $index;
	    $site_set[$index] = $index;
	}
	@site_set = grep (/./, @site_set);
    }
}

## Create a new REMOTE address with its related DIRECTORY.

sub create_remote
{
    local ($remote, $directory) = @_;

    push (@remote, $remote);
    $remote{$remote} = $directory;
    foreach (keys %signature)
    {
	$signature{$_} .= " -";
    }
    $save_config = 1;
}

## Alter a REMOTE address to a NEW_REMOTE address, known to be equivalent.

sub change_remote
{
    local ($remote, $new_remote) = @_;

    return if $remote eq $new_remote;
    $remote[&validated_remote_index ($remote)] = $new_remote;
    $remote{$new_remote} = $remote{$remote};
    delete $remote{$remote};
    $save_config = 1;
}

## Destroy information related to a REMOTE address.

sub delete_remote
{
    local ($remote) = @_;
    local ($index);

    $index = &validated_remote_index ($remote);
    @remote = @remote[0 .. $index - 1, $index + 1 .. @remote - 1];
    delete $remote{$remote};

    foreach (keys %signature)
    {
	@signature = split (/ /, $signature{$_});
	$signature{$_} = join (" ", @signature[0 .. $index - 1,
					       $index + 1 .. @signature - 1]);
    }
    $save_config = 1;
}

## Return the index of a given REMOTE, interrupting the command if not found.

sub validated_remote_index
{
    local ($remote) = @_;
    local ($index);

    $index = &remote_index ($remote);
    return $index if $index >= 0;
    &interrupt ("Specification \`$remote\' invalid for remote address");
}

## Return the index of a given REMOTE, or a negative value if not found.

sub remote_index
{
    local ($remote) = @_;
    local ($index);

    $remote = @remote[$remote - 1] if ($remote > 0 && $remote <= @remote);
    $index = 0;
    foreach (@remote)
    {
	return $index if $remote eq $_;
	$index++;
    }
    -1;
}

# Interactive dialog and error processing.

## Query the user interactively with QUESTION, return the reply
## in $_.  An empty reply means the default signature from the QUESTION
## if any, written as "...? [DEFAULT]".  Echo the input if used
## in process.

sub query
{
    local ($query) = @_;

    while (1)
    {
	print STDERR "\a$query ";
	$_ = <>;
	if ($_)
	{
	    print STDERR if ! -t;
	    chop;
	    if (/^\?$/)
	    {
		print STDERR $NORMAL_HELP;
		next;
	    }
	    if (/^! *(.*)$/)
	    {
		if ($1)
		{
		    system $1;
		}
		elsif (defined $ENV{$SHELL})
		{
		    system $ENV{$SHELL};
		}
		else
		{
		    system $SH;
		}
		next;
	    }
	    if (/^abort$/)
	    {
		if ($save_config)
		{
		    &diagnose
			("Modifications to file \`$CONFIG\' are unsaved");
		    &query ("Should I stop without saving them (y/n)? [n]");
		    if (/^(y|yes)$/i)
		    {
			$command_loop = 0;
			$process_loop = 0;
			&interrupt ("Program aborted!");
		    }
		}
		&interrupt ("Command aborted!");
	    }
	    $_ = $1 if (! $_ && $query =~ /\? \[(.+)\]$/);
	    return;
	}
	else
	{
	    print STDERR "quit\n";
	    $_ = "quit";
	    return;
	}
    }
}

## Issue a message for the (possibly interactive) user.

sub warn
{
    warn "  $_[0]\n";
}

## Issue an error message for the (possibly interactive) user.

sub diagnose
{
    warn "* $_[0]\n";
}

## Issue an error message for the (possibly interactive) user, while
## interrupting the command being currently executed.  Abort if none.

sub interrupt
{
    if ($process_loop)
    {
	$workdir_to_unlink = "";
	$archive_to_unlink = "";
	%signature_received = ();

	warn "* $_[0]\n";
	last PROCESS_LOOP;
    }
    elsif ($command_loop)
    {
	warn "* $_[0]\n";
	next COMMAND_LOOP;
    }
    else
    {
	die "** $_[0]\n";
    }
}

# Local Variables:
# mode: perl
# End: