#!/usr/bin/perl

#
# Create a shell script and tar ball that will apply against srcdir to
# make it into a copy of dstdir.  We don't bother making the timestamps
# on files the same, but we do check owners, permissions, etc.
#
# Usage: mk_sync.pl srcdir dstdir
#
# Writes "sync.sh" and "sync.tgz".  Copy them over to a machine
# containing a copy of srcdir, run sync.sh, untar sync.tgz, and you'll
# end up with a copy of dstdir.
#
# Last update: 20020604 Ian Goldberg <ian@cypherpunks.ca>
#

use strict;
use File::stat;

# Get the dirnames
die "Usage: $0 srcdir dstdir\n" unless $#ARGV == 1;
my ($srcdir, $dstdir) = @ARGV;

# The array that will store the rm, chown, and chmod commands
my @delmods = ();

# The array that will store the filenames to put in the tarball
my @adds = ();

# Do the recursive analysis
&handle($srcdir, $dstdir, \@delmods, \@adds, "");

# Make the tarball
$ENV{"GZIP"} = "-9";
system("tar", "czvvf", "sync.tgz", "-C", $dstdir, "--", @adds);

# Write the shell script
open(O, ">sync.sh") or die "Cannot write sync.sh: $!\n";
print O "#!/bin/bash\n\n";
print O "cd /\n";
print O join("\n", @delmods), "\n";
close(O);
chmod 0755, "sync.sh";

exit 0;

# Now the part that does the work
sub handle {
    my ($src, $dst, $delmodr, $addr, $prefix) = @_;
    my (@srcfiles, @dstfiles);
    opendir(SD, $src) or die "Cannot opendir $src: $!\n";
    @srcfiles = sort grep ( $_ ne "." && $_ ne "..", readdir SD );
    closedir SD;

    opendir(DD, $dst) or die "Cannot opendir $dst: $!\n";
    @dstfiles = sort grep ( $_ ne "." && $_ ne "..", readdir DD );
    closedir DD;

    while($#srcfiles >= 0 || $#dstfiles >= 0) {
	if (($#dstfiles < 0) ||
		($#srcfiles >= 0 && ($srcfiles[0] lt $dstfiles[0]))) {
	    # There's a file in src that isn't in dst
	    my $delfile = shift @srcfiles;
	    push(@$delmodr, "rm -rf " . &safename($prefix.$delfile));
	    next;
	}
	if (($#srcfiles < 0) ||
		($#dstfiles >= 0 && ($srcfiles[0] gt $dstfiles[0]))) {
	    # There's a file in dst that isn't in src
	    my $addfile = shift @dstfiles;
	    push(@$addr, $prefix.$addfile);
	    next;
	}
	# Sanity check
	die "Bad logic!\n" unless $#srcfiles >= 0 && $#dstfiles >= 0 &&
		$srcfiles[0] eq $dstfiles[0];

	my $file = shift @srcfiles;
	shift @dstfiles;

	# OK, we have the same file _name_ in the two dirs.  Are they
	# the same file?
	my $srcf = "$src/$file";
	my $dstf = "$dst/$file";
	print "$srcf\n";
	my $srcst = lstat $srcf or die "Cannot lstat $srcf: $!\n";
	my $srckind = (-l _ && "link") || (-f _ && "file") ||
	    (-d _ && "dir") || (-p _ && "pipe") || (-S _ && "socket") ||
	    (-b _ && "block") || (-c _ && "char") || (-t _ && "tty") ||
	    "unknown";
	my $srcperm = $srcst->mode & 07777;
	my $dstst = lstat $dstf or die "Cannot lstat $dstf: $!\n";
	my $dstkind = (-l _ && "link") || (-f _ && "file") ||
	    (-d _ && "dir") || (-p _ && "pipe") || (-S _ && "socket") ||
	    (-b _ && "block") || (-c _ && "char") || (-t _ && "tty") ||
	    "unknown";
	my $dstperm = $dstst->mode & 07777;

	# Are they even the same _kind_ of file?
	if ($srckind ne $dstkind) {
	    # Nope
	    push(@$delmodr, "rm -rf " . &safename($prefix.$file));
	    push(@$addr, $prefix.$file);
	    next;
	}

	# OK, it's the same kind of file at least.  Handle the various
	# kinds.
	if ($srckind eq "link") {
	    # Perms don't matter, but contents do
	    my $srclink = readlink $srcf;
	    die "Cannot readlink $srcf: $!\n" unless defined $srclink;
	    my $dstlink = readlink $dstf;
	    die "Cannot readlink $dstf: $!\n" unless defined $dstlink;
	    if ($srclink ne $dstlink) {
		push(@$delmodr, "rm -rf " . &safename($prefix.$file));
		push(@$addr, $prefix.$file);
	    }
	    next;
	}

	if ($srckind eq "file") {
	    # Are the sizes the same?
	    if ($srcst->size != $dstst->size) {
		# push(@$delmodr, "rm -rf " . &safename($prefix.$file));
		push(@$addr, $prefix.$file);
		next;
	    }
	    # OK, we need to check the contents
	    system "cmp", "-s", $srcf, $dstf;
	    my $retval = ($? >> 8);
	    if ($retval) {
		# push(@$delmodr, "rm -rf " . &safename($prefix.$file));
		push(@$addr, $prefix.$file);
		next;
	    }
	    # The files are identical.  Check the permissions.
	    if ($srcperm != $dstperm) {
		push(@$delmodr, sprintf "chmod 0%04o %s",
		    $dstperm, &safename($prefix.$file));
	    }
	    # And check the owners
	    if ($srcst->uid != $dstst->uid) {
		push(@$delmodr, sprintf "chown %d %s",
		    $dstst->uid, &safename($prefix.$file));
	    }
	    # And the groups
	    if ($srcst->gid != $dstst->gid) {
		push(@$delmodr, sprintf "chown .%d %s",
		    $dstst->gid, &safename($prefix.$file));
	    }
	    next;
	}

	if ($srckind eq "dir") {
	    # Check the perms and owners, as above
	    if ($srcperm != $dstperm) {
		push(@$delmodr, sprintf "chmod 0%04o %s",
		    $dstperm, &safename($prefix.$file));
	    }
	    if ($srcst->uid != $dstst->uid) {
		push(@$delmodr, sprintf "chown %d %s",
		    $dstst->uid, &safename($prefix.$file));
	    }
	    if ($srcst->gid != $dstst->gid) {
		push(@$delmodr, sprintf "chown .%d %s",
		    $dstst->gid, &safename($prefix.$file));
	    }
	    # And recurse
	    &handle($srcf, $dstf, $delmodr, $addr, "$prefix$file/");
	    next;
	}

	# This is a weirdo kind of file; just remove it and restore from
	# the tarball
	push(@$delmodr, "rm -rf " . &safename($prefix.$file));
	push(@$addr, $prefix.$file);
    }
}

# Safely shell-escape a filename
sub safename {
    # Escape any single quotes that are there
    my $safe = $_[0];
    $safe =~ s/'/'\\''/g;

    # Put single quotes around the whole thing
    "'" . $safe . "'";
}
