root/zetaback.in

#!/usr/bin/perl

# Copyright (c) 2007 OmniTI Computer Consulting, Inc. All rights reserved.
# For information on licensing see:
#   https://labs.omniti.com/zetaback/trunk/LICENSE

use strict;
use Getopt::Long;
use MIME::Base64;
use POSIX qw/strftime/;
use Fcntl qw/:flock/;
use File::Copy;
use IO::File;
use Pod::Usage;

use vars qw/%conf %locks $version_string
            $PREFIX $CONF $BLOCKSIZE $DEBUG $HOST $BACKUP
            $RESTORE $RESTORE_HOST $RESTORE_ZFS $TIMESTAMP
            $LIST $SUMMARY $SUMMARY_EXT $SUMMARY_VIOLATORS
            $FORCE_FULL $FORCE_INC $EXPUNGE $NEUTERED $ZFS
            $SHOW_FILENAMES $ARCHIVE $VERSION $HELP/;
$version_string = '0.1';
$PREFIX = q^__PREFIX__^;
$CONF = qq^$PREFIX/etc/zetaback.conf^;
$BLOCKSIZE = 1024*64;

$conf{'default'}->{'time_format'} = "%Y-%m-%d %H:%M:%S";
$conf{'default'}->{'retention'} = 14 * 86400;
$conf{'default'}->{'compressionlevel'} = 1;

=pod

=head1 NAME

zetaback - perform backup, restore and retention policies for ZFS backups.

=head1 SYNOPSIS

  zetaback -v

  zetaback [-l | -s | -sx | -sv] [--files] [-c conf] [-d] [-h host] [-z zfs]

  zetaback -a [-c conf] [-d] [-h host] [-z zfs]

  zetaback -b [-ff] [-fi] [-x] [-c conf] [-d] [-n] [-h host] [-z zfs]

  zetaback -x [-b] [-c conf] [-d] [-n] [-h host] [-z zfs]

  zetaback -r [-c conf] [-d] [-n] [-h host] [-z zfs] [-t timestamp]
              [-rhost host] [-rzfs fs]

=cut

GetOptions(
  "h=s"     => \$HOST,
  "z=s"     => \$ZFS,
  "c=s"     => \$CONF,
  "a"       => \$ARCHIVE,
  "b"       => \$BACKUP,
  "l"       => \$LIST,
  "s"       => \$SUMMARY,
  "sx"      => \$SUMMARY_EXT,
  "sv"      => \$SUMMARY_VIOLATORS,
  "r"       => \$RESTORE,
  "t=i"     => \$TIMESTAMP,
  "rhost=s" => \$RESTORE_HOST,
  "rzfs=s"  => \$RESTORE_ZFS,
  "d"       => \$DEBUG,
  "n"       => \$NEUTERED,
  "x"       => \$EXPUNGE,
  "v"       => \$VERSION,
  "ff"      => \$FORCE_FULL,
  "fi"      => \$FORCE_INC,
  "files"   => \$SHOW_FILENAMES,
);

# actions allowed together 'x' and 'b' all others are exclusive:
my $actions = 0;
$actions++ if($ARCHIVE);
$actions++ if($BACKUP || $EXPUNGE);
$actions++ if($RESTORE);
$actions++ if($LIST);
$actions++ if($SUMMARY);
$actions++ if($SUMMARY_EXT);
$actions++ if($SUMMARY_VIOLATORS);
$actions++ if($VERSION);
$actions++ if($BACKUP && $FORCE_FULL && $FORCE_INC);
if($actions != 1) {
  pod2usage({ -verbose => 0 });
  exit -1;
}

=pod

=head1 DESCRIPTION

The B<zetaback> program orchestrates the backup (either full or
incremental) of remote ZFS filesystems to a local store.  It handles
frequency requirements for both full and incemental backups as well
as retention policies.  In addition to backups, the B<zetaback> tool
allows for the restore of any backup to a specified host and zfs
filesystem.

=head1 OPTIONS

The non-optional action command line arguments define the invocation purpose
of B<zetaback>.  All other arguments are optional and refine the target
of the action specified.

=head2 Generic Options

The following arguments have the same meaning over several actions:

=over

=item -c <conf>

Use the specified file as the configuration file.  The default file, if
none is specified is /usr/local/etc/zetaback.conf.  The prefix of this 
file may also be specified as an argument to the configure script.

=item -d

Enable debugging output.

=item -n

Don't actually perform any remote commands or expunging.  This is useful with
the -d argument to ascertain what would be done if the command was actually
executed.

=item -t <timestamp>

Used during the restore process to specify a backup image from the desired 
point in time.  If omitted, the command becomes interactive.  This timestamp
is a UNIX timestamp and is shown in the output of the -s and -sx actions.

=item -rhost <host>

Specify the remote host that is the target for a restore operation.  If
omitted the command becomes interactive.

=item -rzfs <zfs>

Specify the remote ZFS filesystem that is the target for a restore
operation.  If omitted the command becomes interactive.

=item -h <host>

Filters the operation to the host specified.  If <host> is of the form
/pattern/, it matches 'pattern' as a perl regular expression against available
hosts.  If omitted, no limit is enforced and all hosts are used for the action.

=item -z <zfs>

Filters the operation to the zfs filesystem specified.  If <zfs> is of the
form /pattern/, it matches 'pattern' as a perl regular expression against
available zfs filesystems.  If omitted, no filter is enforced and all zfs 
filesystems are used for the action.

=back

=head2 Actions

=over

=item -v

Show the version.

=item -l

Show a brief listing of available backups.

=item -s

Like -l, -s will show a list of backups but provides additional information
about the backups including timestamp, type (full or incremental) and the
size on disk.

=item -sx

Shows an extended summary.  In addition to the output provided by the -s
action, the -sx action will show detail for each availble backup.  For
full backups, the detail will include any more recent full backups, if
they exist.  For incremental backups, the detail will include any
incremental backups that are more recent than the last full backup. 

=item -sv

Display all backups in the current store that violate the configured 
retention policy.

=item --files

Display the on-disk file corresponding to each backup named in the output.
This is useful with the -sv flag to name violating files.  Often times, 
violators are filesystems that have been removed on the host machines and 
zetaback can no longer back them up.  Be very careful if you choose to 
automate the removal of such backups as filesystems that would be backed up 
by the next regular zetaback run will often show up as violators.

=item -a

Performs an archive.  This option will look at all eligible backup points
(as restricted by -z and -h) and move those to the configured archive
directory.  The recommended use is to first issue -sx --files then
carefully review available backup points and prune those that are
unneeded.  Then invoke with -a to move only the remaining "desired"
backup points into the archives.  Archived backups do not appear in any
listings or in the list of policy violators generated by the -sv option.
In effect, they are no longer "visible" to zetaback.

=item -b

Performs a backup.  This option will investigate all eligible hosts, query
the available filesystems from the remote agent and determine if any such
filesystems require a new full or incremental backup to be taken.  This
option may be combined with the -x option (to clean up afterwards.)

=item -ff

Forces a full backup to be taken on each filesystem encountered.  This is 
used in combination with -b.  It is recommended to use this option only when
targeting specific filesystems (via the -h and -z options.)  Forcing a full
backup across all machines will cause staggered backups to coalesce and
could cause performance issues.

=item -fi

Forces an incremental backup to be taken on each filesystem encountered.  
This is used in combination with -b.  It is recommended to use this option 
only when targeting specific filesystems (via the -h and -z options.)  Forcing 
an incremental backup across all machines will cause staggered backups 
to coalesce and could cause performance issues.

=item -x

Perform an expunge.  This option will determine which, if any, of the local
backups may be deleted given the retention policy specified in the
configuration.

=item -r

Perform a restore.  This option will operate on the specified backup and
restore it to the ZFS filesystem specified with -rzfs on the host specified
with the -rhost option.  The -h, -z and -t options may be used to filter
the source backup list.  If the filtered list contains more than one
source backup image, the command will act interactively.  If the -rhost
and -rzfs command are not specified, the command will act interactively.

=back

=cut

if($VERSION) {
  print "zetaback: $version_string\n";
  exit 0;
}

=pod

=head1 CONFIGURATION

The zetaback configuration file consists of a default stanza, containing
settings that can be overridden on a per-host basis.  A stanza begins
either with the string 'default', or a fully-qualified hostname, with 
settings enclosed in braces ({}).  Single-line comments begin with a hash
('#'), and whitespace is ignored, so feel free to indent for better
readability.  Every host to be backed up must have a host stanza in the
configuration file.

=head2 Settings

The following settings are valid in both the default and host scopes:

=over

=item store

The base directory under which to keep backups.  An interpolated variable
'%h' can be used, which expands to the hostname.  There is no default for
this setting.

=item archive

The base directory under which archives are stored.  The format is the same
as the store setting.  This is the destination to which files are relocated 
when issuing an archive action (-a).

=item agent

The location of the zetaback_agent binary on the host.  There is no default
for this setting.

=item time_format

All timestamps within zetaback are in UNIX timestamp format.  This setting
provides a string for formatting all timestamps on output.  The sequences
available are identical to those in strftime(3).  If not specified, the
default is '%Y-%m-%d %H:%M:%S'.

=item backup_interval

The frequency (in seconds) at which to perform incremental backups.  An 
incremental backup will be performed if the current time is more than 
backup_interval since the last incremental backup.  If there is no full backup
for a particular filesystem, then a full backup is performed.  There is no 
default for this setting.

=item full_interval

The frequency (in seconds) at which to perform full backups.  A full backup will
be performed if the current time is more than full_interval since the last full 
backup.

=item retention

The retention time (in seconds) for backups.  Defaults to (14 * 86400), or two
weeks.

=item compressionlevel

Compress files using gzip at the specified compression level. 0 means no
compression. Accepted values are 1-9. Defaults to 1 (fastest/minimal
compression.)

=item ssh_config

Full path to an alternate ssh client config.  This is useful for specifying a
less secure but faster cipher for some hosts, or using a different private 
key.  There is no default for this setting.

=back

=head1 CONFIGURATION EXAMPLES

=head2 Uniform hosts

This config results in backups stored in /var/spool/zfs_backups, with a
subdirectory for each host.  Incremental backups will be performed
approximately once per day, assuming zetaback is run hourly.  Full backups
will be done once per week.  Time format and retention are default.

  default {
    store = /var/spool/zfs_backups/%h
    agent = /usr/local/bin/zetaback_agent
    backup_interval = 83000
    full_interval = 604800
  }

  host1 {}

  host2 {}

=head2 Non-uniform hosts

Here, host1's and host2's agents are found in different places, and host2's
backups should be stored in a different path.

  default {
    store = /var/spool/zfs_backups/%h
    agent = /usr/local/bin/zetaback_agent
    backup_interval = 83000
    full_interval = 604800
  }

  host1 {
    agent = /opt/local/bin/zetaback_agent
  }

  host2 {
    store = /var/spool/alt_backups/%h
    agent = /www/bin/zetaback_agent
  }

=cut

# Make the parser more formal:
# config => stanza*
# stanza => string { kvp* }
# kvp    => string = string
my $str_re = qr/(?:"(?:\\\\|\\"|[^"])*"|\S+)/;
my $kvp_re = qr/($str_re)\s*=\s*($str_re)/;
my $stanza_re = qr/($str_re)\s*\{((?:\s*$kvp_re)*)\s*\}/;

sub parse_config() {
  local($/);
  $/ = undef;
  open(CONF, "<$CONF") || die "Unable to open config file: $CONF";
  my $file = <CONF>;
  # Rip comments
  $file =~ s/^\s*#.*$//mg;
  while($file =~ m/$stanza_re/gm) {
    my $scope = $1;
    my $filepart = $2;
    $scope =~ s/^"(.*)"$/$1/;
    $conf{$scope} ||= {};
    while($filepart =~ m/$kvp_re/gm) {
      my $key = $1;
      my $value = $2;
      $key =~ s/^"(.*)"$/$1/;
      $value =~ s/^"(.*)"$/$1/;
      $conf{$scope}->{lc($key)} = $value;
    }
  }
  close(CONF);
}
sub config_get($$) {
  return $conf{$_[0]}->{$_[1]} || $conf{'default'}->{$_[1]};
}

sub dir_encode($) {
  my $d = shift;
  my $e = encode_base64($d, '');
  $e =~ s/\//_/;
  return $e;
}
sub dir_decode($) {
  my $e = shift;
  $e =~ s/_/\//;
  return decode_base64($e);
}
sub pretty_size($) {
  my $bytes = shift;
  if($bytes > 1024*1024*1024) {
    return sprintf("%0.2f Gb", $bytes / (1024*1024*1024));
  }
  if($bytes > 1024*1024) {
    return sprintf("%0.2f Mb", $bytes / (1024*1024));
  }
  if($bytes > 1024) {
    return sprintf("%0.2f Kb", $bytes / (1024));
  }
  return "$bytes b";
}
sub lock($;$$) {
  my ($host, $file, $nowait) = @_;
  print "Acquiring lock for $host:$file\n" if($DEBUG);
  $file ||= 'master.lock';
  my $store = config_get($host, 'store');
  $store =~ s/%h/$host/g;
  return 1 if(exists($locks{"$host:$file"}));
  open(LOCK, "+>>$store/$file") || return 0;
  unless(flock(LOCK, LOCK_EX | ($nowait ? LOCK_NB : 0))) {
    close(LOCK);
    return 0;
  }
  $locks{"$host:$file"} = \*LOCK;
  return 1;
}
sub unlock($;$$) {
  my ($host, $file, $remove) = @_;
  print "Releasing lock for $host:$file\n" if($DEBUG);
  $file ||= 'master.lock';
  my $store = config_get($host, 'store');
  $store =~ s/%h/$host/g;
  return 0 unless(exists($locks{"$host:$file"}));
  *UNLOCK = $locks{$file};
  unlink("$store/$file") if($remove);
  flock(UNLOCK, LOCK_UN);
  close(UNLOCK);
  return 1;
}
sub scan_for_backups($) {
  my %info = ();
  my $dir = shift;
  $info{last_full} = $info{last_incremental} = $info{last_backup} = 0;
  opendir(D, $dir) || return \%info;
  foreach my $file (readdir(D)) {
    if($file =~ /^(\d+)\.([^\.]+)\.full$/) {
      my $whence = $1;
      my $fs = dir_decode($2);
      $info{$fs}->{full}->{$whence}->{'file'} = "$dir/$file";
      $info{$fs}->{last_full} = $whence if($whence > $info{$fs}->{last_full});
      $info{$fs}->{last_backup} = $info{$fs}->{last_incremental} > $info{$fs}->{last_full} ?
                                     $info{$fs}->{last_incremental} : $info{$fs}->{last_full};
    }
    elsif($file =~ /^(\d+).([^\.]+)\.incremental.(\d+)$/) {
      my $whence = $1;
      my $fs = dir_decode($2);
      $info{$fs}->{incremental}->{$whence}->{'depends'} = $3;
      $info{$fs}->{incremental}->{$whence}->{'file'} = "$dir/$file";
      $info{$fs}->{last_incremental} = $whence if($whence > $info{$fs}->{last_incremental});
      $info{$fs}->{last_backup} = $info{$fs}->{last_incremental} > $info{$fs}->{last_full} ?
                                     $info{$fs}->{last_incremental} : $info{$fs}->{last_full};
    }
  }
  closedir(D);
  return \%info;
}

parse_config();

sub zetaback_log($$;@) {
  my ($host, $mess, @args) = @_;
  my $tf = config_get($host, 'time_format');
  my $file = config_get($host, 'logfile');
  my $fileh;
  if(defined($file)) {
    $fileh = IO::File->new(">>$file");
  }
  $fileh ||= IO::File->new(">&STDERR");
  printf $fileh "%s: $mess", strftime($tf, localtime(time)), @args;
  $fileh->close();
}

sub zfs_remove_snap($$$) {
  my ($host, $fs, $snap) = @_;
  my $agent = config_get($host, 'agent');
  my $ssh_config = config_get($host, 'ssh_config');
  $ssh_config = "-F $ssh_config" if($ssh_config);
  return unless($snap);
  print "Dropping $snap on $fs\n" if($DEBUG);
  `ssh $ssh_config $host $agent -z $fs -d $snap`;
}

# Lots of args.. internally called.
sub zfs_do_backup($$$$$$) {
  my ($host, $fs, $type, $point, $store, $dumpfile) = @_;
  my $agent = config_get($host, 'agent');
  my $ssh_config = config_get($host, 'ssh_config');
  $ssh_config = "-F $ssh_config" if($ssh_config);

  # Do it. yeah.
  my $cl = config_get($host, 'compressionlevel');
  if ($cl >= 1 && $cl <= 9) {
    open(LBACKUP, "|gzip -$cl >$store/.$dumpfile") ||
      die "zfs_full_backup: cannot create dump\n";
  } else {
    open(LBACKUP, ">$store/.$dumpfile") ||
      die "zfs_full_backup: cannot create dump\n";
  }
  eval {
    if(my $pid = fork()) {
      close(LBACKUP);
      waitpid($pid, 0);
      die "error: $?" if($?);
    }
    else {
      my @cmd = ('ssh', $ssh_config, $host, $agent, '-z', $fs, "-$type", $point);
      open STDIN, "/dev/null" || exit(-1);
      open STDOUT, ">&LBACKUP" || exit(-1);
      exec { $cmd[0] } @cmd;
      print STDERR "$cmd[0] failed: $?\n";
      exit($?);
    }
    die "dump failed (zero bytes)\n" if(-z "$store/.$dumpfile");
    rename("$store/.$dumpfile", "$store/$dumpfile") || die "cannot rename dump\n";
  };
  if($@) {
    unlink("$store/.$dumpfile");
    chomp(my $error = $@);
    $error =~ s/[\r\n]+/ /gsm;
    zetaback_log($host, "FAILED[$error] $host:$fs $type\n");
    die "zfs_full_backup: failed $@";
  }
  my @st = stat("$store/$dumpfile");
  my $size = pretty_size($st[7]);
  zetaback_log($host, "SUCCESS[$size] $host:$fs $type\n");
}

sub zfs_full_backup($$$) {
  my ($host, $fs, $store) = @_;

  # Translate into a proper dumpfile nameA
  my $point = time();
  my $efs = dir_encode($fs);
  my $dumpfile = "$point.$efs.full";

  zfs_do_backup($host, $fs, 'f', $point, $store, $dumpfile);
}

sub zfs_incremental_backup($$$$) {
  my ($host, $fs, $base, $store) = @_;
  my $agent = config_get($host, 'agent');

  # Translate into a proper dumpfile nameA
  my $point = time();
  my $efs = dir_encode($fs);
  my $dumpfile = "$point.$efs.incremental.$base";

  zfs_do_backup($host, $fs, 'i', $base, $store, $dumpfile);
}

sub perform_retention($$) {
  my ($host, $store) = @_;
  my $cutoff = time() - config_get($host, 'retention');
  my $backup_info = scan_for_backups($store);
  
  foreach my $disk (sort keys %{$backup_info}) {
    my $info = $backup_info->{$disk};
    next unless(ref($info) eq 'HASH');
    my %must_save;

    # Get a list of all the full and incrementals, sorts newest to oldest
    my @backup_points = (keys %{$info->{full}}, keys %{$info->{incremental}});
    @backup_points = sort { $b <=> $a } @backup_points;

    # We _cannot_ throw away _all_ our backups,
    # so save the most recent incremental and full no matter what
    $must_save{$backup_points[0]} = 1;
    my @fulls = grep { exists($info->{full}->{$_}) } @backup_points;
    $must_save{$fulls[0]} = 1;

    # Walk the list for backups within our retention period.
    foreach (@backup_points) {
      if($_ >= $cutoff) {
        $must_save{$_} = 1;
      }
      else {
        # they are in decending order, once we miss, all will miss
        last;
      }
    }

    # Look for dependencies
    foreach (@backup_points) {
      if(exists($info->{incremental}->{$_})) {
        print "   => $_ depends on $info->{incremental}->{$_}->{depends}\n" if($DEBUG);
        $must_save{$info->{incremental}->{$_}->{depends}} = 1
      }
    }
    my @removals = grep { !exists($must_save{$_}) } @backup_points;
    if($DEBUG) {
      my $tf = config_get($host, 'time_format');
      print "    => I can remove:\n";
      foreach (@backup_points) {
        print "      => ". strftime($tf, localtime($_));
        print " [". (exists($info->{full}->{$_}) ? "full":"incremental") ."]";
        print " XXX" if(!exists($must_save{$_}));
        print "\n";
      }
    }
    foreach (@removals) {
      my $efs = dir_encode($disk);
      my $filename;
      if(exists($info->{full}->{$_})) {
        $filename = "$store/$_.$efs.full";
      }
      elsif(exists($info->{incremental}->{$_})) {
        $filename = "$store/$_.$efs.incremental.$info->{incremental}->{$_}->{depends}";
      }
      else {
        print "ERROR: We tried to expunge $host $disk [$_], but couldn't find it.\n";
      }
      print "    => expunging $filename\n" if($DEBUG);
      unless($NEUTERED) {
        unlink($filename) || print "ERROR: unlink $filename: $?\n";
      }
    }
  }
}

sub __default_sort($$) { return $_[0] cmp $_[1]; }
    
sub choose($$;$) {
  my($name, $obj, $sort) = @_;
  $sort ||= \&__default_sort;;
  my @list;
  my $hash;
  if(ref $obj eq 'ARRAY') {
    @list = sort { $sort->($a,$b); } (@$obj);
    map { $hash->{$_} = $_; } @list;
  }
  elsif(ref $obj eq 'HASH') {
    @list = sort { $sort->($a,$b); } (keys %$obj);
    $hash = $obj;
  }
  else {
    die "choose passed bad object: " . ref($obj) . "\n";
  }
  return $list[0] if(scalar(@list) == 1);
  print "\n";
  my $i = 1;
  for (@list) {
    printf " %3d) $hash->{$_}\n", $i++;
  }
  my $selection = 0;
  while($selection !~ /^\d+$/ or
        $selection < 1 or
        $selection >= $i) {
    print "$name: ";
    chomp($selection = <>);
  }
  return $list[$selection - 1];
}

sub backup_chain($$) {
  my ($info, $ts) = @_;
  my @list;
  push @list, $info->{full}->{$ts} if(exists($info->{full}->{$ts}));
  if(exists($info->{incremental}->{$ts})) {
    push @list, $info->{incremental}->{$ts};
    push @list, backup_chain($info, $info->{incremental}->{$ts}->{depends});
  }
  return @list;
}

sub perform_restore() {
  my %source;

  foreach my $host (grep { $_ ne "default" } keys %conf) {
    # If -h was specific, we will skip this host if the arg isn't
    # an exact match or a pattern match
    if($HOST &&
       !(($HOST eq $host) ||
         ($HOST =~ /^\/(.*)\/$/ && $host =~ /$1/))) {
      next;
    }

    my $store = config_get($host, 'store');
    $store =~ s/%h/$host/g;;
    mkdir $store if(! -d $store);

    my $backup_info = scan_for_backups($store);
    foreach my $disk (sort keys %{$backup_info}) {
      my $info = $backup_info->{$disk};
      next unless(ref($info) eq 'HASH');
      next
        if($ZFS &&      # if the pattern was specified it could
           !($disk eq $ZFS ||        # be a specific match or a
             ($ZFS =~ /^\/(.+)\/$/ && $disk =~ /$1/))); # regex
      # We want to see this one
      my @backup_points = (keys %{$info->{full}}, keys %{$info->{incremental}});
      my @source_points;
      foreach (@backup_points) {
        push @source_points, $_ if(!$TIMESTAMP || $TIMESTAMP == $_)
      }
      if(@source_points) {
        $source{$host}->{$disk} = \@source_points;
      }
    }
  }

  if(! keys %source) {
    print "No matching backups found\n";
    return;
  }

  # Here goes the possibly interactive dialog
  my $host = choose("Restore from host",  [keys %source]);
  my $disk = choose("Restore from ZFS", [keys %{$source{$host}}]);
  
  # Times are special.  We build a human readable form and use a numerical
  # sort function instead of the default lexical one.
  my %times;
  my $tf = config_get($host, 'time_format');
  map { $times{$_} = strftime($tf, localtime($_)); } @{$source{$host}->{$disk}};
  my $timestamp = choose("Restore as of timestamp", \%times,
                         sub { $_[0] <=> $_[1]; });

  my $store = config_get($host, 'store');
  $store =~ s/%h/$host/g;;
  mkdir $store if(! -d $store);
  my $backup_info = scan_for_backups($store);
  my @backup_list = reverse backup_chain($backup_info->{$disk}, $timestamp);

  if(!$RESTORE_HOST) {
    print "Restore to host [$host]:";
    chomp(my $input = <>);
    $RESTORE_HOST = length($input) ? $input : $host;
  }
  if(!$RESTORE_ZFS) {
    print "Restore to zfs [$disk]:";
    chomp(my $input = <>);
    $RESTORE_ZFS = length($input) ? $input : $disk;
  }

  # show intentions
  print "Going to restore:\n";
  print "\tfrom: $host\n";
  print "\tfrom: $disk\n";
  print "\t  at: $timestamp [" . strftime($tf, localtime($timestamp)) . "]\n";
  print "\t  to: $RESTORE_HOST\n";
  print "\t  to: $RESTORE_ZFS\n";
  print "\n";

  foreach(@backup_list) {
    $_->{success} = zfs_restore_part($RESTORE_HOST, $RESTORE_ZFS, $_->{file}, $_->{depends});
  }
}

sub zfs_restore_part($$$;$) {
  my ($host, $fs, $file, $dep) = @_;
  my $ssh_config = config_get($host, 'ssh_config');
  $ssh_config = "-F $ssh_config" if($ssh_config);
  my $command;
  if(exists($conf{$host})) {
    my $agent = config_get($host, 'agent');
    $command = "$agent -r -z $fs";
    $command .= " -b $dep" if($dep);
  }
  else {
    $command = "__ZFS__ recv $fs";
  }
  print " => piping $file to $command\n" if($DEBUG);
  if($NEUTERED) {
    print "gzip -dfc $file | ssh $ssh_config $host $command\n" if ($DEBUG);
  }
  else {
    open(DUMP, "gzip -dfc $file |");
    eval {
      open(RECEIVER, "| ssh $ssh_config $host $command");
      my $buffer;
      while(my $len = sysread(DUMP, $buffer, $BLOCKSIZE)) {
        if(syswrite(RECEIVER, $buffer, $len) != $len) {
          die "$!";
        }
      }
    };
    close(DUMP);
    close(RECEIVER);
  }
  return $?;
}

sub pretty_print_backup($$$) {
  my ($info, $host, $point) = @_;
  my $tf = config_get($host, 'time_format');
  print "\t" . strftime($tf, localtime($point)) . " [$point] ";
  if(exists($info->{full}->{$point})) {
    my @st = stat($info->{full}->{$point}->{file});
    print "FULL " . pretty_size($st[7]);
    print "\n\tfile: $info->{full}->{$point}->{file}" if($SHOW_FILENAMES);
  } else {
    my @st = stat($info->{incremental}->{$point}->{file});
    print "INCR from [$info->{incremental}->{$point}->{depends}] " . pretty_size($st[7]);
    print "\n\tfile: $info->{incremental}->{$point}->{file}" if($SHOW_FILENAMES);
  }
  print "\n";
}

sub show_backups($$$) {
  my ($host, $store, $diskpat) = @_;
  my $backup_info = scan_for_backups($store);
  my $tf = config_get($host, 'time_format');
  my @files;
  foreach my $disk (sort keys %{$backup_info}) {
    my $info = $backup_info->{$disk};
    next unless(ref($info) eq 'HASH');
    next
      if($diskpat &&      # if the pattern was specified it could
         !($disk eq $diskpat ||        # be a specific match or a
           ($diskpat =~ /^\/(.+)\/$/ && $disk =~ /$1/))); # regex

    my @backup_points = (keys %{$info->{full}}, keys %{$info->{incremental}});
    @backup_points = sort { $a <=> $b } @backup_points;
    @backup_points = (pop @backup_points) unless ($ARCHIVE || $SUMMARY_EXT || $SUMMARY_VIOLATORS);

    # Quick short-circuit in the case of retention violation checks
    if($SUMMARY_VIOLATORS) {
      if(time() > $info->{last_full} + config_get($host, 'full_interval') ||
         time() > $info->{last_backup} + config_get($host, 'backup_interval')) {
        print "$host:$disk\n";
        pretty_print_backup($info, $host, $backup_points[0]);
      }
      next;
    }

    # We want to see this one
    print "$host:$disk\n";
    next unless($SUMMARY || $SUMMARY_EXT || $ARCHIVE);
    if($SUMMARY_EXT) {
      print "\tLast Full: ". ($info->{last_full} ? strftime($tf, localtime($info->{last_full})) : "Never") . "\n";
      if($info->{last_full} < $info->{last_incremental}) {
        print "\tLast Incr: ". strftime($tf, localtime($info->{last_incremental})). "\n";
      }
    }
    foreach (@backup_points) {
      pretty_print_backup($info, $host, $_);
      push @files, exists($info->{full}->{$_}) ? $info->{full}->{$_}->{file} : $info->{incremental}->{$_}->{file};
    }
    print "\n";
  }
  if($ARCHIVE && scalar(@files)) {
    my $archive = config_get($host, 'archive');
    $archive =~ s/%h/$host/g;
    if(! -d $archive) {
      mkdir $archive || die "Cannot mkdir($archive)\n";
    }
    print "\nAre you sure you would like to archive ".scalar(@files)." file(s)? ";
    while(($_ = <>) !~ /(?:y|n|yes|no)$/i) {
      print "Are you sure you would like to archive ".scalar(@files)." file(s)? ";
    }
    if(/^y/i) {
      foreach my $file (@files) {
        (my $afile = $file) =~ s/^$store/$archive/;
        move($file, $afile) || print "Error archiving $file: $!\n";
      }
    }
  }
}

sub plan_and_run($$$) {
  my ($host, $store, $diskpat) = @_;
  my $ssh_config = config_get($host, 'ssh_config');
  $ssh_config = "-F $ssh_config" if($ssh_config);
  my %suppress;
  print "Planning '$host'\n" if($DEBUG);
  my $agent = config_get($host, 'agent');
  my $took_action = 1;
  while($took_action) {
    $took_action = 0;
    my @disklist;

    # We need a lock for the listing.
    return unless(lock($host, ".list"));
    open(SILENT, ">&", \*STDERR);
    close(STDERR);
    my $rv = open(ZFSLIST, "ssh $ssh_config $host $agent -l |");
    open(STDERR, ">&", \*SILENT);
    close(SILENT);
    next unless $rv;
    @disklist = grep { chomp } (<ZFSLIST>);
    close(ZFSLIST);

    foreach my $diskline (@disklist) {
      chomp($diskline);
      next unless($diskline =~ /^(\S+) \[([^\]]*)\]/);
      my $diskname = $1;
      my %snaps;
      map { $snaps{$_} = 1 } (split(/,/, $2));
 
      # We've just done this.
      next if($suppress{"$host:$diskname"}); 
      # If we are being selective (via -z) now is the time.
      next
        if($diskpat &&          # if the pattern was specified it could
           !($diskname eq $diskpat ||        # be a specific match or a
             ($diskpat =~ /^\/(.+)\/$/ && $diskname =~ /$1/))); # regex
  
      print " => Scanning '$store' for old backups of '$diskname'.\n" if($DEBUG);

      # Make directory on demand
      my $backup_info = scan_for_backups($store);
      # That gave us info on all backups, we just want this disk
      $backup_info = $backup_info->{$diskname} || {};
  
      # Should we do a backup?
      my $backup_type = 'no';
      if(time() > $backup_info->{last_backup} + config_get($host, 'backup_interval')) {
        $backup_type = 'incremental';
      }
      if(time() > $backup_info->{last_full} + config_get($host, 'full_interval')) {
        $backup_type = 'full';
      }
  
      # If we want an incremental, but have no full, then we need to upgrade to full
      if($backup_type eq 'incremental') {
        my $have_full_locally = 0;
        # For each local full backup, see if the full backup still exists on the other end.
        foreach (keys %{$backup_info->{'full'}}) {
          $have_full_locally = 1 if(exists($snaps{'__zb_full_' . $_}));
        }
        $backup_type = 'full' unless($have_full_locally);
      }
      $backup_type = 'full' if($FORCE_FULL);
      $backup_type = 'incremental' if($FORCE_INC);

      print " => doing $backup_type backup\n" if($DEBUG);
      # We need to drop a __zb_base snap or a __zb_incr snap before we proceed
      unless($NEUTERED || $backup_type eq 'no') {
        # attempt to lock this action, if it fails, skip -- someone else is working it.
        next unless(lock($host, dir_encode($diskname), 1));
        unlock($host, '.list');

        if($backup_type eq 'full') {
          eval { zfs_full_backup($host, $diskname, $store); };
          if ($@) {
            chomp(my $err = $@);
            print " => failure $err\n";
          }
          else {
            # Unless there was an error backing up, remove all the other full snaps
            foreach (keys %snaps) {
              zfs_remove_snap($host, $diskname, $_) if(/^__zb_full_(\d+)/) 
            }
          }
          $took_action = 1;
        }
        if($backup_type eq 'incremental') {
          zfs_remove_snap($host, $diskname, '__zb_incr') if($snaps{'__zb_incr'});
          # Find the newest full from which to do an incremental (NOTE: reverse numeric sort)
          my @fulls = sort { $b <=> $a } (keys %{$backup_info->{'full'}});
          zfs_incremental_backup($host, $diskname, $fulls[0], $store);
          $took_action = 1;
        }
        unlock($host, dir_encode($diskname), 1);
      }
      $suppress{"$host:$diskname"} = 1;
      last if($took_action);
    }
    unlock($host, '.list');
  }
}

if($RESTORE) {
  perform_restore();
}
else {
  foreach my $host (grep { $_ ne "default" } keys %conf) {
    # If -h was specific, we will skip this host if the arg isn't
    # an exact match or a pattern match
    if($HOST &&
       !(($HOST eq $host) ||
         ($HOST =~ /^\/(.*)\/$/ && $host =~ /$1/))) {
      next;
    }
  
    my $store = config_get($host, 'store');
    $store =~ s/%h/$host/g;;
    mkdir $store if(! -d $store);
  
    if($LIST || $SUMMARY || $SUMMARY_EXT || $SUMMARY_VIOLATORS || $ARCHIVE) {
      show_backups($host, $store, $ZFS);
    }
    if($BACKUP) {
      plan_and_run($host, $store, $ZFS);
    }
    if($EXPUNGE) {
      perform_retention($host, $store);
    }
  }
}

exit 0;

=pod

=head1 FILES

=over

=item /usr/local/etc/zetaback.conf

The main zetaback configuration file.  The location of the file can be
specified on the command line with the -c flag.  The prefix of this 
file may also be specified as an argument to the configure script.

=back

=head1 SEE ALSO

zetaback_agent(1)

=cut