#!/bin/sh
# -*- perl -*-
# This code allows us to start perl from our path or an environment variable
# rather than hardcoding a path into the #! line.  It works from sh or csh.
(exit $?0) && eval 'exec ${QPERLQ-perl} -x $0 ${1+"$@"}'
if (! $?QPERLQ) setenv QPERLQ perl
exec $QPERLQ -x $0 $argv:q

#!/usr/local/bin/perl -w
#
# $Id: apply_sync,v 1.44 1999/02/14 19:29:08 ejb Exp $
# $Source: /home/ejb/source/qsync/util/RCS/apply_sync,v $
# $Author: ejb $
#
# Author: E. Jay Berkenbilt
#
# This script is used to apply a synchronization package as created
# by make_sync.  It simply extracts the tarfile and executes the commands
# in the actions file.
#

require 5.001;
use strict;

my $whoami = ($0 =~ m,([^/\\]*)$,) ? $1 : $0;
my $dirname = ($0 =~ m,(.*)[/\\][^/\\]+$,) ? $1 : ".";
push(@INC, "$dirname/qsutil_modules");

if ((@ARGV == 1) && ($ARGV[0] eq "--help"))
{
    &help(*STDOUT);
    exit 0;
}

if ((@ARGV == 1) && ($ARGV[0] eq "--version"))
{
    print "$whoami version 1.2.1 -- requires qsync version 1.6 or later\n";
    exit 0;
}

my $chownlinks = &chownlinks();

require qsync_utils;
require QsyncConfig;

{
    local($^W) = 0;
    my $w = $SIG{'__WARN__'};
    $SIG{'__WARN__'} = sub {};
    eval { $SIG{'PIPE'} = 'IGNORE'; };
    $SIG{'__WARN__'} = $w;
}

&usage if (@ARGV < 2);

umask 0;

my $ea_before = 0;
my $ea_after = 1;

$| = 1;
my ($sync_file, $sync_dir) = splice(@ARGV, 0, 2);
$sync_dir =~ s:/$::;
$sync_dir =~ s:^\./::;
my $use_stdin = ($sync_file eq "-");

if ((! $use_stdin) && (! -f $sync_file))
{
    print STDERR "$whoami: sync_file ($sync_file) does not exist or is " .
	"not a file.\n";
    &usage;
}

if (! -d $sync_dir)
{
    print STDERR "$whoami: sync_dir ($sync_dir) does not exist or is " .
	"not a directory.\n";
    &usage;
}

my @skip_conflicts = ();
while (@ARGV)
{
    my $arg = shift(@ARGV);
    if ($arg eq "-skip-conflict")
    {
	&usage() unless @ARGV;
	push(@skip_conflicts, shift(@ARGV));
    }
    else
    {
	&usage();
    }
}

eval
{
    # If the sync_file itself is less than five minutes newer than the
    # last_sync that would have resulted after the previous completion
    # of this command, it is likely that apply_sync is accidentally
    # being run on an old sync_file.  Try to detect this case.

    my $config = new QsyncConfig($whoami, $sync_dir);
    $config->validate_config(1, 0);
    my $check = $config->get_config("rename_to");
    if ($check eq "")
    {
	$check = $config->get_config("last_sync");
    }

    if ((-f $sync_file) && (-f $check))
    {
	my @st_sf = stat($sync_file);
	my @st_ls = stat($check);
	if (scalar(@st_sf) && scalar(@st_ls))
	{
	    my $sf_mtime = $st_sf[9];
	    my $ls_mtime = $st_ls[9];
	    if ($sf_mtime < ($ls_mtime + 300))
	    {
		print STDERR
		    "whoami: WARNING: $sync_file is older than $check.\n";
		exit 2 if &yn("Exit? ");
	    }
	}
    }
};

my $tar_command = (&qsystem("gtar --version >/dev/null 2>&1") == 0)
    ? "gtar" : "tar";
my $tar_args = "xvfp";
if (&qsystem("$tar_command --version >/dev/null 2>&1") != 0)
{
    $tar_args = "xvf";
    print STDERR "$whoami: WARNING: $tar_command is not gnu tar.  Long " .
	"filenames, devices,\n";
    print STDERR "  and sparse files may not extract properly.\n";
}

my $pending = &QsyncConfig::pending($sync_dir);

if ($use_stdin)
{
    open(TARFILE, "<&STDIN") ||
	die "$whoami: can't read STDIN: $!\n";
}
else
{
    open(TARFILE, "gunzip -c $sync_file |") ||
	die "$whoami: can't read tarfile: $!\n";
}
binmode TARFILE;
my $tarfile = new_read_fh Tarfile(*TARFILE);

open(TAR, "| $tar_command $tar_args -") ||
    die "$whoami: can't run $tar_command to extract sync dir: $!\n";
binmode TAR;
select(TAR); $| = 1;
select(STDOUT);


my $buf;
my $hdr = $tarfile->next_file_info(\$buf);
my $name = $hdr->name();
$name =~ s,^\./,,;
if ($name ne $pending)
{
    die "$whoami: this does not appear to be a synchronization " .
	"package\n  for $sync_dir.  It does not contain $pending.\n";
}
my $pending_data = $buf . $tarfile->file_data($hdr);

print TAR $pending_data;

# Must do actions first in case removes, chmods, etc. must be done
# before extraction can succeed.  Must repeat chmods afterwards.

print "Extracting sync_dir from archive\n";

while (1)
{
    $hdr = $tarfile->next_file_info(\$buf);
    last if ! defined $hdr;
    my $name = $hdr->name();
    $name =~ s,^\./,,;
    if ($name =~ m,^$sync_dir/,)
    {
	print TAR $buf;
	print TAR $tarfile->file_data($hdr);
    }
    else
    {
	last;
    }
}

# To flush things out, close the tarfile.  It will be reopened later.
close(TAR);

my $config = new QsyncConfig($whoami, $sync_dir);
$config->validate_config(1, 0);
my $actions = $config->actions();
my $tarlist = $config->tarlist();
my $olddata = $config->olddata();

if ((! $use_stdin) && (-f $olddata) && (! -z $olddata))
{
    &check_conflicts($olddata);
}
    
if (! -z $actions)
{
    print "$whoami: preparing to perform the following actions:\n";
    if (&qsystem("cat $actions") != 0)
    {
	die "$whoami: failed to cat $actions\n";
    }
    exit 2 if (! &yn("Continue? "));
    if (! &eval_actions($ea_before, $actions))
    {
	die "$whoami: failed to run commands in $actions\n";
    }
}

my @newfiles = ();
open(TARLIST, "<$tarlist") || die "$whoami: can't read $tarlist: $!\n";
while (<TARLIST>)
{
    chop;
    if (! m,^\./$sync_dir/,)
    {
	push(@newfiles, $_);
    }
}
close(TARLIST);

my $blocksize = 16 << 10;
if (@newfiles)
{
    open(TAR, "| $tar_command $tar_args -") ||
	die "$whoami: can't run $tar_command to extract package: $!\n";
    binmode TAR;
    select(TAR); $| = 1;
    select(STDOUT);

    if (! $use_stdin)
    {
	print "$whoami: preparing to remove the following files:\n";
	for (@newfiles)
	{
	    print $_, "\n";
	}
	exit 2 if (! &yn("Continue? "));
    }
    &remove_files(@newfiles);
    
    print "$whoami: extracting archive\n";
    print TAR $buf;
    while (read(TARFILE, $buf, $blocksize))
    {
	print TAR $buf;
    }
    close(TAR);
}
else
{
    print "$whoami: no files to replace\n";
    while (read(TARFILE, $buf, $blocksize))
    {
	# Do nothing -- just avoid broken pipe message
    }
}
close(TARFILE);

print "Repeating chmod/chown/chgrp actions and " .
    "setting directory modification times\n";
&eval_actions($ea_after, $actions);

my $new_sync = $config->get_config("new_sync");
my $rename_to = $config->get_config("rename_to");
if (($rename_to ne "") && (-e $new_sync))
{
    unlink $rename_to;
    rename($new_sync, $rename_to);
}

my $peer = $config->get_config("peer");
if ($peer ne "")
{
    eval
    {
	my $pconfig = new QsyncConfig($whoami, $peer);
	$pconfig->validate_config(1, 0);
	my $new_sync = $pconfig->get_config("new_sync");
	my $rename_to = $pconfig->get_config("rename_to");
	if (($rename_to ne "") && (-e $new_sync))
	{
	    unlink $rename_to;
	    rename($new_sync, $rename_to);
	}
    };
}

unlink $pending;
print "$whoami: synchronization complete.\n";

sub yn
{
    return 1 if $use_stdin;
    my ($prompt) = @_;
    my $answer;
    print $prompt;
    do {
	chop($answer = <STDIN>);
	if ($answer eq "y")
	{
	    return 1;
	}
	elsif ($answer eq "n")
	{
	    return 0;
	}
	else
	{
	    print "Please enter y or n: ";
	}
    }
    while (($answer ne "y") && ($answer ne "n"));
}

sub check_conflicts
{
    my $olddata = shift;
    print "$whoami: checking for conflicts\n";
    open(OLDDATA, "<$olddata") or die "$whoami: can't read $olddata: $!\n";
    my $warn = 0;
    while(<OLDDATA>)
    {
	chomp;
	if (m/^(.*) (\d+|-) (\d+|-)$/)
	{
	    my ($filename, $omode, $omtime) = ($1, oct($2), $3);
	    next if $filename =~ m,^\./$sync_dir/,;
	    my $skip = 0;
	    for (@skip_conflicts)
	    {
		$skip = 1 if $filename eq $_;
	    }
	    next if $skip;
	    if (($omode eq "-") && ($omtime eq "-"))
	    {
		if (-e $filename)
		{
		    $warn = 1;
		    print "$whoami: $filename exists but was not expected to\n";
		}
	    }
	    elsif (($omode =~ m/^\d+/) && ($omtime =~ m/^\d+$/))
	    {
		my @stat = lstat($filename);
		if (@stat)
		{
		    my $mode = $stat[2];
		    my $mtime = $stat[9];
		    if ($mode != $omode)
		    {
			$warn = 1;
			printf("$whoami: mode for %s: " .
			       "actual = %07o, expected = %07o\n",
			       $filename, $mode, $omode);
		    }
		    if ($mtime != $omtime)
		    {
			$warn = 1;
			printf("$whoami: mtime for %s: " .
			       "actual = %d, expected = %d\n",
			       $filename, $mtime, $omtime);
		    }
		}
		else
		{
		    $warn = 1;
		    print "$whoami: expected to see $filename but did not\n";
		}
	    }
	    else
	    {
		# ignore
	    }
	}
	else
	{
	    # Ignore
	}
    }
    close(OLDDATA);
    if ($warn && (&yn("Possible conflicts detected.  Exit? ")))
    {
	exit 2;
    }
}

sub eval_actions
{
    my $ea = shift;
    my ($actions) = @_;

    # All actions are perfomed if $ea is $ea_before.  If $ea is $ea_after,
    # only operations that could have been overridden by tarfile extraction
    # (such as chmod operations) are performed.

    open(ACTIONS, "<$actions") || die "$whoami: can't read $actions: $!\n";
    while(<ACTIONS>)
    {
	chop;
	# Regular expressions are used here rather than split to accomodate
	# files with spaces in their names.
	next unless m/^(\S+) (.*)$/;
	my ($cmd, $rest) = ($1, $2);
	if ($cmd eq "typechange")
	{
	    &remove_files($rest) unless ($ea == $ea_after);
	}
	elsif ($cmd eq "rm")
	{
	    unlink $rest unless ($ea == $ea_after);
	}
	elsif ($cmd eq "chmod")
	{
	    $rest =~ m/^(\S+) (.*)$/;
	    my ($mode, $file) = (oct($1), $2);
	    chmod $mode, $file;
	}
	elsif ($cmd eq "chown")
	{
	    $rest =~ m/^(\S+) (.*)$/;
	    my ($uid, $file) = ($1, $2);
	    chown $uid, -1, $file;
	}
	elsif ($cmd eq "chgrp")
	{
	    $rest =~ m/^(\S+) (.*)$/;
	    my ($gid, $file) = ($1, $2);
	    chown -1, $gid, $file;
	}
	elsif ($cmd eq "linkchown")
	{
	    if ($chownlinks)
	    {
		$rest =~ m/^(\S+) (.*)$/;
		my ($uid, $file) = ($1, $2);
		chown $uid, -1, $file;
	    }
	}
	elsif ($cmd eq "linkchgrp")
	{
	    if ($chownlinks)
	    {
		$rest =~ m/^(\S+) (.*)$/;
		my ($gid, $file) = ($1, $2);
		chown -1, $gid, $file;
	    }
	}
	elsif ($cmd eq "mkdir")
	{
	    $rest =~ m/^(.*) (\S+)$/;
	    my ($file, $mode) = ($1, oct($2));
	    mkdir $file, $mode unless ($ea == $ea_after);
	}
	elsif ($cmd eq "rmdir")
	{
	    rmdir $rest unless ($ea == $ea_after);
	}
	elsif ($cmd eq "setmtime")
	{
	    $rest =~ m/^(.*) (\S+)$/;
	    my ($file, $mtime) = ($1, $2);
	    utime $mtime, $mtime, $file if ($ea == $ea_after);
	}
	else
	{
	    print STDERR "$whoami: ignoring unknown action $cmd\n";
	}
    }
    close(ACTIONS);
    1;
}

sub chownlinks
{
    # Determine whether we can chown links on this system.
    my $r = 1;
    eval
    {
	my $result = 0;
	my $tfile = ",,tfile.$$";
	my $tlink = ",,tlink.$$";
	my $a = new OnExit(sub { unlink $tfile, $tlink }, []);
	local(*F);
	open(F, ">$tfile") || die;
	close(F);
	symlink($tfile, $tlink) || die;
	my @stat = lstat($tlink);
	die unless @stat;
	my $gid = $stat[5];
	my @groups = (split(/ /, $());
	my $trygroup = undef;
	while (@groups)
	{
	    my $g = shift(@groups);
	    if ($g != $gid)
	    {
		$trygroup = $g;
		last;
	    }
	}
	die unless defined $trygroup;
	(chown -1, $trygroup, $tlink) || die;
	@stat = lstat($tlink);
	die unless @stat;
	die if ($stat[5] != $trygroup);
    };
    $r = 0 if $@;
    $r;
}    

sub help
{
    local(*F) = shift;
    print F <<EOF
Usage: $whoami sync_file sync_dir [ -skip-conflict file ]
  Apply synchronization file specified to current directory.  Find
  actions to perform after extracting file in the sync_dir directory.
  This should be the same directory as was the argument to make_sync.
  If sync_file is -, it is read from stdin and assumed not to be
  compresed.  This is useful for make_sync output written directly to
  a backup medium.

  The -skip-conflict flag may be specified any number of times.  Each
  time it is specified, the named file is added to a list of files for
  which conflicts should be ignored.

      OR

  $whoami --help | --version
EOF
    ;
}

sub usage
{
    &help(*STDERR);
    exit(2);
}