#!/usr/local/bin/perl
#
# $Id: psync,v 0.50 2002/01/18 18:30:51 dankogai Exp dankogai $
#

use strict;
use Getopt::Long;
use MacOSX::File::Copy;
use MacOSX::File::Catalog;
use Fcntl qq(:mode);
my $Debug = 0;

my ($opt_v, $opt_n, $opt_q);
Getopt::Long::Configure("bundling");
GetOptions(
           "v:i" => \$opt_v,
           "n"   => \$opt_n,
	   "q"   => \$opt_q,
           );

$opt_v ||= 1;
$opt_q and $opt_v = 0;

my $IgnorePat =
    qr[
       ^/(?:
            tmp/.*
          | dev/.*
          | private/var/tmp/.*
          | private/var/vm/.* 
          | private/var/run/.* 
          )
       ]xo;

my %IgnoreFiles = map { $_ => 1 }
(
 '.DS_Store',
 '.FBCIndex',
 '.FBCLockFolder',
 '.Trashes',
 'AppleShare PDS',
 'Desktop DB',
 'Desktop DF',
 'TheFindByContentFolder',
 'TheVolumeSettingsFolder',
 );

my $Topdev;
# Maybe we should tie them to DB_File to save memory
my (%Signature, %Attribs, %Action, %Root) = ();

select(STDOUT);
$|=1; #autoflush

my $Dst = pop @ARGV;
-d $Dst or help();
scalar @ARGV >= 1 or help();

$opt_v and do_log("Scanning Destination Directory $Dst ...");
$Topdev = (lstat($Dst))[0];
scantree($Dst, '', -1);
$opt_v and do_log((scalar keys %Action) . " items found.");

for my $src (@ARGV){
    $opt_v and do_log("Scanning Source Item $src ...");
    $Topdev = (lstat($src))[0];
    scantree($src, '' , +1);
    $opt_v and do_log((scalar keys %Action) . " items found.");
}

if ($opt_v){
    my ($n_del, $n_unchg, $n_copy) = (0,0,0);
    while(my ($k, $v) = each %Action){
	$k or next;
        $v <  0 and $n_del++;
        $v == 0 and $n_unchg++;
        $v >  0 and $n_copy++;
    }
    do_log(sprintf "%8d items to delete,", $n_del);
    do_log(sprintf "%8d items unchanged,", $n_unchg);
    do_log(sprintf "%8d items to copy.", $n_copy);
}
$opt_v and do_log("deleting items ...");
# sort must be this order for depth-first traversal
for my $k (sort {$b cmp $a} keys %Action){
    $k or next; $Action{$k} <  0 or next;
    my $dpath = $Dst . $k;
    $opt_v and do_log("- $dpath");
    unless ($opt_n){
	-e $dpath or next;
	unlink $dpath or rmdir $dpath or warn "$dpath : $!";
    }
}
$opt_v and do_log("copying items ...");
# sort must be this order for depth-last traversal
for my $k (sort keys %Action){
    $k or next; 
    my $spath = $Root{$k} . $k; $spath =~ s,^/+,/,o;
    my $dpath = $Dst . $k;
    $Action{$k} == 0 and $opt_v > 1 and do_log("== $spath");
    $Action{$k} >  0 or next;
    unless ($opt_n){
	my ($mode, $size, $mtime)  = unpack("N3", $Signature{$k});
	my ($uid,  $gid,  $atime)  = unpack("N3", $Attribs{$k});
	if     (S_ISDIR($mode)){ # -d
	    unless (-d $dpath){
		$opt_v and do_log("+d $spath");
		mkdir $dpath, 0755 or warn "$dpath : $!";
	    }else{
		$opt_v > 1 and do_log("=d $spath");
	    }
	}elsif (S_ISREG($mode)){ # -f
	    $opt_v and do_log("+f $spath");
	    copy ($spath, $dpath, undef, 1)
		or warn "$spath -> $dpath : $MacOSX::File::OSErr";
	    chmod $mode & 07777, $dpath;
	    chown $uid,   $gid,  $dpath;
	    # my $catalog = getcatalog($spath);
	    # $catalog and $catalog->set($dpath);
	    utime $atime, $mtime,  $dpath;
	}elsif (S_ISLNK($mode)){ # -l
	    $opt_v and do_log("+l $spath");
	    unlink $dpath;
	    symlink(readlink($spath), $dpath);
	}
	unless (S_ISLNK($mode)){
	    chown $uid, $gid, $dpath or warn "$dpath : $!";
 	}
    }
}
$opt_v and do_log("fixing directory permissions ...");
# sort must be this order for depth-first traversal
for my $k (sort {$b cmp $a} keys %Action){
    $k or next;
    $Action{$k} >  0 or next;
    my ($mode,$size,$mtime)  = unpack("N3", $Signature{$k});
    S_ISDIR($mode) or next;  # -d
    my $spath = $Root{$k} . $k; $spath =~ s,^/+,/,o;
    my $dpath = $Dst . $k;
    my ($uid,$gid,$atime)   = unpack("N3", $Attribs{$k});
    unless ($opt_n){
	chmod $mode & 07777, $dpath;
	chown $uid, $gid,    $dpath;
	my $catalog = getcatalog($spath);
	$catalog and $catalog->set($dpath);
	utime $atime, $mtime,  $dpath;
	$opt_v and do_log(sprintf "0%04o,%s,%s, $spath", 
			  ($mode & 07777),
			  (getpwuid($uid))[0],
			  (getgrgid($gid))[0],
			  );
    }
}

exit;
sub do_log{
    print shift, "\n";
}

sub sig2txt{
    return sprintf("0x%08x,0x%08x,0x%08x",unpack("N3",shift));
}

sub addsig{
    my ($path, $mode,$uid,$gid,$size,$atime,$mtime, $action) = @_;
    my $sig         = pack("N3", $mode, $size, $mtime);
    $Attribs{$path} = pack("N3", $uid, $gid, $atime);
    if ($opt_v > 3 and $action > 0){
	do_log qq(was: ) . sig2txt($Signature{$path});
	do_log qq(now: ) . sig2txt($sig);
    }
    if ($Signature{$path} eq $sig){
        $action = 0;               # same file
    }else{
        $Signature{$path} =  $sig; # different
    }
    $Action{$path} = $action;
    $opt_v > 2 and 
	do_log(join("," => $Action{$path},
		    sprintf("0x%08x,0x%08x,0x%08x", 
			    unpack("N3",$Signature{$path})),
		    $path));
}

# File::Find is too general purpose thus slow.
# we implement our own traversal routine

sub scantree {
    my ($root, $path, $action) = @_;
    if ($path =~ $IgnorePat){
        addsig($path, 0, 0, 0, 0, 0, 0, -2);
        return;
    }
    $action > 0 and $Root{$path} = $root;
    my $fpath = $root . $path;
    my ($dev, $mode, $nlink, $uid, $gid, $size, $atime, $mtime) = 
	(lstat($fpath))[0,2,3,4,5,7,8,9] or warn "can't stat $fpath";

    addsig($path, $mode, $uid, $gid, $size, $atime, $mtime, $action);

    if (-d _){
        $dev != $Topdev and return;
        opendir my $d, $fpath or warn "$fpath:$!";
        # see ._* is avoided
        my @f = grep !/^\.(?:\.?$|_)/o, readdir $d;
        closedir $d;
        for my $f (@f){
            my $spath = "$path/$f";
            if ($IgnoreFiles{$f}){
                addsig($spath, $mode, $uid, $gid, $size, $mtime, $atime, -3);
            }else{
                scantree($root, $spath, $action);
            }
        }
    }
}

sub help{
    print <<"EOT";
psync [-n][-q|-v] source_items ... target_directory
EOT
exit;
}
1;
__END__
=head1 NAME

psync -- update copy

=head1 SYNOPSIS

 psync [-n][-q|-vI<n>] source_items ... target_directory

=head1 DESCRIPTION

psync does an update copy.  It compares source directory and target
directory at first, then erases items that are nonexistent on source
directory and finally copies everything on source directory.  Items
items with the same modification date and (data fork) size remain
untouched, saving time on operation.

Currently psync supports options below

=over 4

=item -n

"Simulation mode".  It prints what it would do on standard output but
does nothing thus far.

=item -vI<n>

Sets verbose level.  Default verbose level is 1;  It prints only items
that are changed.  Level 2 prints unchanged files also.  Level 3 and
above are practically debugging mode.

=item -q

Quiet mode.  Sets verbose level to 0.

=back

=head1 EXAMPLE

To backup everything in startup volume, all you have to say is

  sudo psync / /Volumes/I<backup>

And the resulting I<backup> volume is fully-bootable copy thereof.
Note C<sudo> or root privilege is necessary to restore file
ownership. 

=head1 PERFORMANCE

On PowerBook G3 (pismo) with G3/400, 384MB Memory,  I tested with
C</usr/bin/time -l sudo psync / /Volumes/backup>.  The boot volume
contains no more than vanilla OS X 10.1.2 and Developer kit.  It
had a little over 85000 items and 1.5 GB of used space.  Here is
the result;

     1st run
     2539.48 real       121.97 user       290.78 sys
     Following run
      452.98 real        47.29 user        39.38 sys

Note screensaver was on with some other background programs.  I used
this program happily with my PowerBook G4 while I am surfing the web
and listening to iTunes at the same time letting SETI@Home search for
cosmic programmers :)  With MacOS X, background backup is no problem

=head1 BUGS

Using this utility over network such as AFS and NFS don't work well
because of file permissions.  There are several ways to overcome this
problem but for the time being it is not implemented.

On the other hand this utility works very well on not only HFS+ but
also UFS.  It even works with on disk images so backup over AFS is
still possible in theory by making a huge disk image on an AFS volume.

=head1 DISCLAIMER

The author of this utility will be held no responsibility for possible
damages and losses of data and/or files caused by the use thereof.
Use me at your own risk.

=head1 AUTHOR

Dan Kogai <dankogai@dan.co.jp>

=head1 SEE ALSO

L<pcpmac/1>

hfstar F<http://www.geocities.com/paulotex/tar/>

hfspax F<http://homepage.mac.com/howardoakley/>

C<The Finder and File Operations> F<http://developer.apple.com/techpubs/macosx/Essentials/SystemOverview/Finder/The_Finder___Operations.html>

=head1 COPYRIGHT

Copyright 2002 Dan Kogai <dankogai@dan.co.jp>

This library is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.
