#!/usr/bin/perl

# For backing up files on an HFS+ partition to a remote Unix host

# usage: xbup options
#  
# options: --local              make effective backup directory the
#                               current working directory, rather than the
#                               root of the backup tree
# 
#          --files              backup only those files and directories
#                               listed in .bupfiles (located in the
#                               effective backup directory)
#   
#          --files-from file    like --files, but use specified file
#                               instead of .bupfiles
#                 
#          --config file        read config from file, instead of ~/.xbupconfig
#
#          --checksum           always checksum data files
#                               by default, no transfer occurs if
#                               modtime agrees.  Note that xattr containers
#                               are always checksummed.
#
#          --dry-run            just a dry run
#                               tip: use --checksum --dry-rum
#                               to compare source and destination
#
#          --restore            restores files, instead of backing them up
#

use warnings;
use strict;
use Cwd;


sub ptsystem {
   print "$_[0]\n";
   return system("time $_[0]");
}

sub psystem {
   print "$_[0]\n";
   return system("$_[0]");
}

my $rsync_args = "--rsh=ssh --stats -vzrlpt --delete";
   # general rsync options

my $xrsync_args = "--rsh=ssh --stats -vzrl --checksum --delete";
   # options used to backup xattr containers.
   # Don't prerseve modtimes or permissions, and always checksum.
   # This ensures modtimes on remote host reflect when the xattr
   # container was really created or modified, and enables accurate
   # restores of xattrs from the backup archive.


######################### 

### command line options

my $files_flag = 0;
my $local_flag = 0;
my $config_flag = 0;
my $files_from_flag = 0;
my $restore_flag = 0;
my $dry_run_flag = 0;
my $checksum_flag = 0;

my $user_xbupconfig;
my $user_bupfiles;

my $argc = @ARGV;

foreach my $argnum (0 .. $argc - 1) {

   if ($config_flag == -1) {
      $user_xbupconfig = $ARGV[$argnum];
      $config_flag = 1;
   }
   elsif ($files_from_flag == -1) {
      $user_bupfiles = $ARGV[$argnum];
      $files_flag = 1;
      $files_from_flag = 1;
   }
   elsif ($ARGV[$argnum] eq "--files") {
      $files_flag = 1;
   }
   elsif ($ARGV[$argnum] eq "--local") {
      $local_flag = 1;
   }
   elsif ($ARGV[$argnum] eq "--config") {
      $config_flag = -1;
   }
   elsif ($ARGV[$argnum] eq "--files-from") {
      $files_from_flag = -1;
   }
   elsif ($ARGV[$argnum] eq "--restore") {
      $restore_flag = 1;
   }
   elsif ($ARGV[$argnum] eq "--dry-run") {
      $dry_run_flag = 1;
   }
   elsif ($ARGV[$argnum] eq "--checksum") {
      $checksum_flag = 1;
   }
   else {
      die("unknown argument \"$ARGV[$argnum]\"");
   }
}

if ($config_flag == -1) { die("dangling --config option"); }
if ($files_from_flag == -1) { die("dangling --files-from option"); }

my $dry_run_arg = "";
if ($dry_run_flag == 1) {
   $dry_run_arg = "--dry-run";
}

my $checksum_arg = "";
if ($checksum_flag == 1) {
   $checksum_arg = "--checksum";
}



######## config variables

my $RSYNC="";   
my $BIN="";     
my $TEMP=""; 
my $SRC="";  
my $RHOST="";  
my $DST="";  
my $RBIN="";  
my $NDAYS="";  

my $xbupconfig;

if ($config_flag == 1) {
   $xbupconfig = $user_xbupconfig;
}
else {
   $xbupconfig="$ENV{HOME}/.xbupconfig";
}

open(F, "<",  "$xbupconfig") or die("can't open \"$xbupconfig\"");
my $config_code = do { local $/; <F> };
close F;

eval $config_code;

if ($@ ne "") { die("error processing \"$xbupconfig\": $@"); }

if ($RSYNC eq "" || $BIN eq "" || $TEMP eq "" || $SRC eq "" 
   || $RHOST eq "" || $DST eq "" || $RBIN eq "" || $NDAYS eq "" ) {
   die("error processing \"$xbupconfig\": some variables undefined");
}


#########################

#### initial sanity checking and cleaning

my $legal = "A-Za-z0-9 /._:\\-";  
   # allowable characters in filenames -- prevents shell madness

if ( $DST =~ m{[^$legal]} || $DST =~ m{.*/$} ) { 
   die("destination directory \"$DST\" has a funny name");
}

if ( $SRC =~ m{[^$legal]} || $SRC =~ m{.*/$} ) { 
   die("source directory \"$SRC\" has a funny name");
}

if ( $TEMP =~ m{[^$legal]} || $TEMP =~ m{.*/$} ) { 
   die("temp directory \"$TEMP\" has a funny name");
}

if ( $BIN =~ m{[^$legal]} || $BIN =~ m{.*/$} ) { 
   die("temp directory \"$BIN\" has a funny name");
}

if ( $RBIN =~ m{[^$legal]} || $RBIN =~ m{.*/$} ) { 
   die("temp directory \"$RBIN\" has a funny name");
}

$DST =~ s{/$}{};
$SRC =~ s{/$}{};
$TEMP =~ s{/$}{};
$BIN =~ s{/$}{};
$RBIN =~ s{/$}{};

if (! (-d $TEMP) ) {

   print "creating $TEMP\n";

   mkdir($TEMP) or die("failed to create \"$TEMP\"");

}

if (! (-d $SRC)) {
   die("source directory \"$SRC\" does not exist");
}



#########################

####### process local flag

my $effdir;
my $ext;

if ($local_flag == 1) {
   $effdir = ".";

   my $pwd = getcwd;

   if ( $pwd =~ m{[^$legal]} ) { 
      die("current directory \"$pwd\" has a funny name");
   }

   $ext = "$pwd/";
   $ext =~ s{^$SRC/}{}  
      or die("current directory \"$pwd\" not a subdirectory of \"$SRC\"");
}
else {
   $effdir = $SRC;
   $ext = "";
}



#########################

##### process --files flag
#####
##### This is tricky -- especially to get the patterns just right
##### for the xattr container files

my $exclude_arg = "";
my $xexclude_arg = "";
my $files_arg = "";


if ($files_flag == 1) {


   my $bupfiles="$effdir/.bupfiles";
   if ($files_from_flag == 1) {
      $bupfiles = $user_bupfiles;
   }

   my %bupname = ();
   my %prefixdir = ();

   ### gather names

   open(F, "<",  "$bupfiles") or die("can't open \"$bupfiles\"");


   while (my $line = <F>) {
      chomp $line;

      if ($line ne "") { # skip blank lines

         # check for wierd names
         my $name = "/$line/";
         if ( $name =~ m{[^$legal]} || $name =~ m{//} ) { 
            die("funny name \"$name\" in \"$bupfiles\"");
         }

         $bupname{$line} = 0;

      }
   }

   close F;

   ### generate prefix directories


   for my $name (keys %bupname) {
      $prefixdir{$name} = 0;
      while ( $name =~ m{(.*)/.*} ) {
         $name = $1;
         $prefixdir{$name} = 0;
      }
   }

   ### write exclude patterns for data

   open(F, ">", "$TEMP/pat") or die("can't open \"$TEMP/pat\"");

   for my $name (keys %prefixdir) {
      print F "+ /$name/\n";
   }

   for my $name (keys %bupname) {
      print F "+ /$name/**\n";
   }

   print F "- */\n";

   for my $name (keys %bupname) {
      print F "+ /$name\n";
   }

   print F "- *\n";

   close F;

   ### write exclude patterns for xattrs

   open(F, ">", "$TEMP/xpat") or die("can't open \"$TEMP/xpat\"");

   for my $name (keys %prefixdir) {
      print F "+ /$name/\n";
   }

   for my $name (keys %bupname) {
      print F "+ /$name/**\n";
   }

   print F "- */\n";

   for my $name (keys %bupname) {
      $name = "/$name";
      $name =~ m{(.*)/(.*)};
      $name = "$1/\@_$2";
      print F "+ $name\n";
   }

   print F "- *\n";

   close F;

   $exclude_arg = "--exclude-from=\"$TEMP/pat\"";
   $xexclude_arg = "--exclude-from=\"$TEMP/xpat\"";
   $files_arg = "--files-from \"$bupfiles\"";

}


if ($restore_flag == 0) {

############################
############################

##### perform backup



############################

##### generate UTC timestamp and set up files on remote host


my $timestamp=`date -u '+GMT%Y-%m-%d-%H-%M-%S'`;
chomp $timestamp;

if (ptsystem("ssh $RHOST 'bash \"$RBIN/xbup_helper\" \"$DST\" \"$ext\" \"$timestamp\" \"$NDAYS\"'")) {
   exit;
}

my $backup_arg = "";
my $xbackup_arg = "";

if ($NDAYS ne "-") {

   $backup_arg = "-b --backup-dir='\"$DST/archive/arch.$timestamp/data/$ext\"'";
   $xbackup_arg = "-b --backup-dir='\"$DST/archive/arch.$timestamp/xattr/$ext\"'";

}
   



#############################

####### sync data

print "\nsyncing files\n\n";

my $opt_rsync_args = "$dry_run_arg $exclude_arg $checksum_arg $backup_arg";


ptsystem("$RSYNC $rsync_args $opt_rsync_args \"$effdir/\" '$RHOST:\"$DST/data/$ext\"'");


##############################

####### split xattrs

print "\nsplitting xattrs\n\n";

psystem("rm -rf \"$TEMP/xattr\"");

if (ptsystem("\"$BIN/split_xattr\" $files_arg \"$effdir\" \"$TEMP/xattr\"")) {
   die("error in split_xattr -- backup not complete");
}

###############################

####### sync xattrs
   

print "\nsyncing xattrs\n\n";

my $opt_xrsync_args = "$dry_run_arg $xexclude_arg $xbackup_arg";

ptsystem("$RSYNC $xrsync_args $opt_xrsync_args \"$TEMP/xattr/\" '$RHOST:\"$DST/xattr/$ext\"'");


}
else {

############################
############################

##### perform restore

my $response;

print "preparing to restore to \"$SRC/$ext\"\n";

if ($files_flag == 1) {
   print "pruning using file list: $files_arg\n";
}

if ($dry_run_flag == 1) {
   print "this is a dry run\n";
}

print "continue? [yn] ";
$response = <STDIN>;
chop $response;


while ($response ne "y" && $response ne "n") {

   print "continue? [yn] ";
   $response = <STDIN>;
   chop $response;

}

if ($response eq "n") {

   print "goodbye\n";
   exit;

}



##### check for files on remote host



if (ptsystem("ssh $RHOST 'bash \"$RBIN/xbup_helper\" \"$DST\" \"$ext\" - -'")) {
   exit;
}



#############################

####### strip locks


if ($dry_run_flag == 0) {
   print "\nstripping locks\n\n";
   ptsystem("\"$BIN/strip_locks\" $files_arg \"$effdir\"");
}
else {
   print "\ndry run: locks not stripped\n\n";
}


#############################

####### sync data




print "\nsyncing files\n\n";

my $opt_rsync_args = "$dry_run_arg $exclude_arg $checksum_arg";

ptsystem("$RSYNC $rsync_args $opt_rsync_args '$RHOST:\"$DST/data/$ext\"' \"$effdir/\"");

###############################

####### sync xattrs
   

print "\nsyncing xattrs\n\n";
psystem("rm -rf \"$TEMP/xattr\"");
mkdir("$TEMP/xattr") or die("failed to make \"$TEMP/xattr\"");


my $opt_xrsync_args = "$dry_run_arg $xexclude_arg";

ptsystem("$RSYNC $rsync_args $opt_xrsync_args '$RHOST:\"$DST/xattr/$ext\"' \"$TEMP/xattr/\"");


##############################

####### join xattrs

if ($dry_run_flag == 0) {

   print "\nready to restore xattrs\n";

   print "continue? [yn] ";
   $response = <STDIN>;
   chop $response;

   while ($response ne "y" && $response ne "n") {

      print "continue? [yn] ";
      $response = <STDIN>;
      chop $response;

   }

   if ($response eq "n") {

      print "xattrs not restored\n";
      exit;

   }

   print "\njoining xattrs\n\n";


   if (ptsystem("\"$BIN/join_xattr\" $files_arg \"$effdir\" \"$TEMP/xattr\"")) {
      die("error in join_xattr -- restore may not be complete");
   }
}
else {
   print "\ndry run: xattrs not restored\n\n";
}


}
