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 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 $FORCE_FULL
            $EXPUNGE $NEUTERED $ZFS
            $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;

=pod

=head1 NAME

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

=head1 SYNOPSIS

  zetaback -v

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

  zetaback -b [-f] [-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,
  "b"       => \$BACKUP,
  "l"       => \$LIST,
  "s"       => \$SUMMARY,
  "sx"      => \$SUMMARY_EXT,
  "r"       => \$RESTORE,
  "t=i"     => \$TIMESTAMP,
  "rhost=s" => \$RESTORE_HOST,
  "rzfs=s"  => \$RESTORE_ZFS,
  "d"       => \$DEBUG,
  "n"       => \$NEUTERED,
  "x"       => \$EXPUNGE,
  "v"       => \$VERSION,
  "f"       => \$FORCE_FULL,
);

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

=pod

=head1 DESCRIPTION

The B<zetaback> program is orchestrates the backup (either full or
incremental) of remote ZFS filesysetms 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 options are optional and refine the target
of the action specified.

=head2 Generic Options

The following options 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 /etc/zetaback.conf.  The prefix for this file may
also be specified in the Makefile.

=item -d

Enable debugging output.

=item -n

Don't actually perform any remote commands or expunging.  This is useful with
the -d options 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 output of -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 this option is 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 this option is 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 also the most recent
backup information including timestamp type (full or incremental) and the
size on disk.

=item -sx

Shows a 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 -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 -f

Forces a full backup to be taken on each disk encountered.  This is used
in combination with -b.  It is recommended to use this option only when
targeting specific disks (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 -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 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.

=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");
  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');
  return unless($snap);
  print "Dropping $snap on $fs\n" if($DEBUG);
  `ssh $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');

  # Do it. yeah.
  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', $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_ out backups, so save the most recent no matter what
    $must_save{$backup_points[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}->{$_}} = 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 $command;
  if(exists($conf{$host})) {
    my $agent = config_get($host, 'agent');
    $command = "$agent -r -z $fs";
    $command .= " -b $dep" if($dep);
  }
  else {
    $command = "/usr/sbin/zfs recv $fs";
  }
  print " => piping $file to $command\n" if($DEBUG);
  if($NEUTERED) {
    print "gzip -dfc $file | ssh $host $command\n" if ($DEBUG);
  }
  else {
    open(DUMP, "gzip -dfc $file |");
    eval {
      open(RECEIVER, "| ssh $host $command");
      my $buffer;
      while(my $len = sysread(DUMP, $buffer, $BLOCKSIZE)) {
        if(syswrite(RECEIVER, $buffer, $len) != $len) {
          die "$!";
        }
      }
    };
    close(DUMP);
    close(RECEIVER);
  }
  return $?;
}

sub show_backups($$$) {
  my ($host, $store, $diskpat) = @_;
  my $backup_info = scan_for_backups($store);
  my $tf = config_get($host, 'time_format');
  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
    # We want to see this one
    print "$host:$disk\n";
    next unless($SUMMARY || $SUMMARY_EXT);
    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";
      }
    }
    my @backup_points = (keys %{$info->{full}}, keys %{$info->{incremental}});
    @backup_points = sort { $a <=> $b } @backup_points;
    unless ($SUMMARY_EXT) {
      @backup_points = (pop @backup_points);
    }
    foreach (@backup_points) {
      print "\t" . strftime($tf, localtime($_)) . " [$_] ";
      if(exists($info->{full}->{$_})) {
        my @st = stat($info->{full}->{$_}->{file});
        print "FULL " . pretty_size($st[7]);
      } else {
        my @st = stat($info->{incremental}->{$_}->{file});
        print "INCR from [$info->{incremental}->{$_}->{depends}] " . pretty_size($st[7]);
      }
      print "\n";
    }
    print "\n";
  }
}

sub plan_and_run($$$) {
  my ($host, $store, $diskpat) = @_;
  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(ZFSLIST, "ssh $host $agent -l |") || next;
    @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);

      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) {
      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 /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 in the Makefile.

=back

=head1 SEE ALSO

zetaback_agent(1)

=cut