#!/usr/bin/perl
# vim: sts=2 sw=2 ts=8 et

# 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::Path qw/mkpath/;
use File::Copy;
use IO::File;
use Pod::Usage;

use vars qw/%conf %locks $version_string $process_lock
            $PREFIX $CONF $BLOCKSIZE $DEBUG $HOST $BACKUP
            $RESTORE $RESTORE_HOST $RESTORE_ZFS $TIMESTAMP
            $LIST $SUMMARY $SUMMARY_EXT $SUMMARY_VIOLATORS
            $SUMMARY_VIOLATORS_VERBOSE $FORCE_FULL $FORCE_INC
            $EXPUNGE $NEUTERED $ZFS $SHOW_FILENAMES $ARCHIVE
            $VERSION $HELP/;
$version_string = '1.0.6';
$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;
$conf{'default'}->{'dataset_backup'} = 0;
$conf{'default'}->{'violator_grace_period'} = 21600;

=pod

=head1 NAME

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

=head1 SYNOPSIS

  zetaback -v

  zetaback [-l|-s|-sx|-sv|-svv] [--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,
  "svv"     => \$SUMMARY_VIOLATORS_VERBOSE,
  "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($SUMMARY_VIOLATORS_VERBOSE);
$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 
backup policy. This is where the most recent full backup is older than
full_interval seconds ago, or the most recent incremental backup is older
than backup_interval seconds ago.

If, at the time of the most recent backup, a filesystem no longer exists on
the server (because it was deleted), then backups of this filesystem are not
included in the list of violators. To include these filesystems, use the -svv
option instead.

=item -svv

The violators summary will exclude backups of filesystems that are no longer
on the server in the list of violators. Use this option to include those
filesystems.

=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.

When running interactively, you can choose multiple filesystems from the list
using ranges. For example 1-4,5,10-11. If you do this, zetaback will enter
multi-restore mode. In this mode it will automatically select the most recent
backup, and restore filesystems in bulk.

In multi-restore mode, you have the option to specify a base filesystem to
restore to. This filesystem will be added as a prefix to the original
filesystem name, so if you picked a prefix of data/restore, and one of the
filesystems you are restoring is called data/set/myfilesystem, then the
filesystem will be restored to data/restore/data/set/myfilesystem.

Note that, just like in regular restore mode, zetaback won't create
intermediate filesystems for you when restoring, and these should either exist
beforehand, or you should make sure you pick a set of filesystems that will
restore the entire tree for you, for example, you should restore data as well
as data/set before restoring data/set/foo.

=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 Storage Classes

In addition to the default and host stanzas, the configuration file can also
contain 'class' stanzas. Classes allow you to override settings on a
per-filesystem basis rather than a per-host basis. A class stanza begins with
the name of the class, and has a setting 'type = class'. For example:

  myclass {
    type = class
    store = /path/to/alternate/store
  }

To add a filesystem to a class, set a zfs user property on the relevant
filesystem. This must be done on the server that runs the zetaback agent, and
not the zetaback server itself.

  zfs set com.omniti.labs.zetaback:class=myclass pool/fs

Note that user properties (and therefore classes) are are only available on
Solaris 10 8/07 and newer, and on Solaris Express build 48 and newer. Only the
server running the agent needs to have user property support, not the zetaback
server itself.

The following settings can be included in a class stanza. All other settings
will be ignored, and their default (or per host) settings used instead:

=over

=item *

store

=item *

full_interval

=item *

backup_interval

=item *

retention

=item *

dataset_backup

=item *

violator_grace_period

=back

=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.  This can be a simple number, in
which case all backups older than this will be expunged.

The retention specification can also be more complex, and consist of pairs of
values separated by a comma. The first value is a time period in seconds, and
the second value is how many backups should be retained within that period.
For example:

retention = 3600,4;86400,11

This will keep up to 4 backups for the first hour, and an additional 11
backups over 24 hours. The times do not stack. In other words, the 11 backups
would be kept during the period from 1 hour old to 24 hours old, or one every
2 hours.

Any backups older than the largest time given are deleted. In the above
example, all backups older than 24 hours are deleted.

If a second number is not specified, then all backups are kept within that
period.

Note: Full backups are never deleted if they are depended upon by an
incremental. In addition, the most recent backup is never deleted, regardless
of how old it is.

This value 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.

=item dataset_backup

By default zetaback backs zfs filesystems up to files. This option lets you
specify that the backup go be stored as a zfs dataset on the backup host.

=item offline

Setting this option to 1 for a host will mark it as being 'offline'. Hosts
that are marked offline will not be backed up, will not have any old backups
expunged and will not be included in the list of policy violators. However,
the host will still be shown when listing backups and archiving.

=item violator_grace_period

This setting controls the grace period used when deciding if a backup has
violated its backup window. It is used to prevent false positives in the case
where a filesystem is still being backed up. For example, if it is 25 hours
since the last daily backup, but the daily backup is in progress, the grace
period will mean that it is not shown in the violators list.

Like all intervals, this period is in seconds. The default is 21600 seconds (6
hours).

=back

=head2 Global Settings

The following settings are only valid in the default scope:

=over

=item process_limit

This setting limits the number of concurrent zetaback processes that can run
at one time. Zetaback already has locks on hosts and datasets to prevent
conflicting backups, and this allows you to have multiple zetaback instances
running in the event a backup takes some time to complete, while still keeping
a limit on the resources used. If this configuration entry is missing, then no
limiting will occur.

=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($$;$) {
  # Params: host, key, class
  # Order of precedence: class, host, default
  if ($_[2]) {
    return $conf{$_[2]}->{$_[1]} || $conf{$_[0]}->{$_[1]} ||
        $conf{'default'}->{$_[1]};
  } else {
    return $conf{$_[0]}->{$_[1]} || $conf{'default'}->{$_[1]};
  }
}

sub get_store($;$) {
  my ($host, $class) = @_;
  my $store = config_get($host, 'store', $class);
  $store =~ s/%h/$host/g;;
  return $store;
}

sub get_classes() {
  my @classes = (""); # The default/blank class is always present
  foreach my $key (keys %conf) {
    if ($conf{$key}->{'type'} eq 'class') {
      push @classes, $key;
    }
  }
  return @classes;
}

sub fs_encode($) {
  my $d = shift;
  my @parts = split('@', $d);
  my $e = encode_base64($parts[0], '');
  $e =~ s/\//_/g;
  $e =~ s/=/-/g;
  $e =~ s/\+/\./g;
  if (exists $parts[1]) {
    $e .= "\@$parts[1]";
  }
  return $e;
}
sub fs_decode($) {
  my $e = shift;
  $e =~ s/_/\//g;
  $e =~ s/-/=/g;
  $e =~ s/\./\+/g;
  return decode_base64($e);
}
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 = get_store($host); # Don't take classes into account - not needed
  mkpath($store) if(! -d $store);
  return 1 if(exists($locks{"$host:$file"}));
  unless (open(LOCK, "+>>$store/$file")) {
    print STDERR "Cannot open: $store/$file\n" if $DEBUG;
    return 0;
  }
  unless(flock(LOCK, LOCK_EX | ($nowait ? LOCK_NB : 0))) {
    close(LOCK);
    print STDERR "Lock failed: $host:$file\n" if $DEBUG;
    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 = get_store($host); # Don't take classes into account - not needed
  mkpath($store) if(! -d $store);
  return 0 unless(exists($locks{"$host:$file"}));
  *UNLOCK = $locks{$file};
  unlink("$store/$file") if($remove);
  flock(UNLOCK, LOCK_UN);
  close(UNLOCK);
  return 1;
}
sub limit_running_processes() {
    my $max = $conf{'default'}->{'process_limit'};
    return unless defined($max);
    print "Aquiring process lock\n" if $DEBUG;
    for (my $i=0; $i < $max; $i++) {
        my $file = "/tmp/.zetaback_$i.lock";
        print "$file\n" if $DEBUG;
        open ($process_lock, "+>>$file") || next;
        if (flock($process_lock, LOCK_EX | LOCK_NB)) {
            print "Process lock succeeded: $file\n" if $DEBUG;
            return 1;
        } else {
            close($process_lock);
        }
    }
    print "Too many zetaback processes running. Exiting...\n" if $DEBUG;
    exit 0;
}
sub scan_for_backups($) {
  my %info = ();
  my $dir = shift;
  $info{last_full} = $info{last_incremental} = $info{last_backup} = 0;
  # Look for standard file based backups first
  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);
  # Now look for zfs based backups
  my $storefs;
  eval {
    $storefs = get_fs_from_mountpoint($dir);
  };
  return \%info if ($@);
  my $rv = open(ZFSLIST, "__ZFS__ list -H -r -t snapshot $storefs |");
  return \%info unless $rv;
  while (<ZFSLIST>) {
      my @F = split(' ');
      my ($rawfs, $snap) = split('@', $F[0]);
      my ($whence) = ($snap =~ /(\d+)/);
      next unless $whence;
      my @fsparts = split('/', $rawfs);
      my $fs = fs_decode($fsparts[-1]);
      # Treat a dataset backup as a full backup from the point of view of the
      # backup lists
      $info{$fs}->{full}->{$whence}->{'snapshot'} = $snap;
      $info{$fs}->{full}->{$whence}->{'dataset'} = "$rawfs\@$snap";
      # Note - this field isn't set for file backups - we probably should do
      # this
      $info{$fs}->{full}->{$whence}->{'pretty_size'} = "$F[1]";
      $info{$fs}->{last_full} = $whence if ($whence >
          $info{$fs}->{last_full});
      $info{$fs}->{last_backup} = $whence if ($whence >
          $info{$fs}->{last_backup});
  }
  close(ZFSLIST);

  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');
  if($ssh_config) {
    $ssh_config = "-F $ssh_config";
    print STDERR "Using custom ssh config file: $ssh_config\n" if($DEBUG);
  }
  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, $dumpname, $base) = @_;
  my ($storefs, $encodedname);
  my $agent = config_get($host, 'agent');
  my $ssh_config = config_get($host, 'ssh_config');
  if($ssh_config) {
    $ssh_config = "-F $ssh_config";
    print STDERR "Using custom ssh config file: $ssh_config\n" if($DEBUG);
  }

  # compression is meaningless for dataset backups
  if ($type ne "s") {
    my $cl = config_get($host, 'compressionlevel');
    if ($cl >= 1 && $cl <= 9) {
        open(LBACKUP, "|gzip -$cl >$store/.$dumpname") ||
        die "zfs_do_backup $host:$fs $type: cannot create dump\n";
    } else {
        open(LBACKUP, ">$store/.$dumpname") ||
        die "zfs_do_backup $host:$fs $type: cannot create dump\n";
    }
  } else {
    # Dataset backup - pipe received filesystem to zfs recv
    eval {
      $storefs = get_fs_from_mountpoint($store);
    };
    if ($@) {
      # The zfs filesystem doesn't exist, so we have to work out what it
      # would be
      my $basestore = $store;
      $basestore =~ s/\/?%h//g;
      $storefs = get_fs_from_mountpoint($basestore);
      $storefs="$storefs/$host";
    }
    $encodedname = fs_encode($dumpname);
    print STDERR "Receiving to zfs filesystem $storefs/$encodedname\n"
      if($DEBUG);
    zfs_create_intermediate_filesystems("$storefs/$encodedname");
    open(LBACKUP, "|__ZFS__ recv $storefs/$encodedname");
  }
  # Do it. yeah.
  eval {
    if(my $pid = fork()) {
      close(LBACKUP);
      die "Errno: $!" if (waitpid($pid, 0) == -1);
      my $ev = ($? >> 8);
      my $sn = $? & 127;
      die "Child signal number: $sn" if ($sn);
      die "Child exit value: $ev" if ($ev);
    }
    else {
      my @cmd = ('ssh', split(/ /, $ssh_config), $host, $agent, '-z', $fs);
      if ($type eq "i" || ($type eq "s" && $base)) {
        push @cmd, ("-i", $base);
      }
      if ($type eq "f" || $type eq "s") {
        push @cmd, ("-$type", $point);
      }
      open STDIN, "/dev/null" || exit(-1);
      open STDOUT, ">&LBACKUP" || exit(-1);
      print STDERR "   => @cmd\n" if($DEBUG);
      unless (exec { $cmd[0] } @cmd) {
        print STDERR "$cmd[0] failed: $!\n";
        exit(1);
      }
    }
    if ($type ne "s") {
      die "dump failed (zero bytes)\n" if(-z "$store/.$dumpname");
      rename("$store/.$dumpname", "$store/$dumpname") || die "cannot rename dump\n";
    } else {
      # Check everything is ok
      `__ZFS__ list $storefs/$encodedname`;
      die "dump failed (received snapshot $storefs/$encodedname does not exist)\n"
        if $?;
    }
  };
  if($@) {
    if ($type ne "s") {
        unlink("$store/.$dumpname");
    }
    chomp(my $error = $@);
    $error =~ s/[\r\n]+/ /gsm;
    zetaback_log($host, "FAILED[$error] $host:$fs $type\n");
    die "zfs_do_backup $host:$fs $type: $error";
  }
  my $size;
  if ($type ne "s") {
    my @st = stat("$store/$dumpname");
    $size = pretty_size($st[7]);
  } else {
    $size = `__ZFS__ get -Ho value used $storefs/$encodedname`;
    chomp $size;
  }
  zetaback_log($host, "SUCCESS[$size] $host:$fs $type\n");
}

sub zfs_create_intermediate_filesystems($) {
  my ($fs) = @_;
  my $idx=0;
  while (($idx = index($fs, '/', $idx+1)) != -1) {
      my $fspart = substr($fs, 0, $idx);
      `__ZFS__ list $fspart 2>&1`;
      if ($?) {
        print STDERR "Creating intermediate zfs filesystem: $fspart\n"
          if $DEBUG;
        `__ZFS__ create $fspart`;
      }
  }
}

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

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

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

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

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

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

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

  my $point = time();
  my $dumpname = "$fs\@$point";

  zfs_do_backup($host, $fs, 's', $point, $store, $dumpname, $base);
}

sub perform_retention($) {
  my ($host) = @_;
  my $now = time();

  if ($DEBUG) {
    print "Performing retention for $host\n";
  }

  foreach my $class (get_classes()) {
    if ($DEBUG) {
      if ($class) {
        print "=> Class: $class\n" if $class;
      } else {
        print "=> Class: (none)\n";
      }
    }
    my $retention = config_get($host, 'retention', $class);
    my $store = get_store($host, $class);
    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;

      if ($DEBUG) {
        print "   $disk\n";
      }

      # 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
      push(@{$must_save{$backup_points[0]}}, "most recent backup");
      my @fulls = grep { exists($info->{full}->{$_}) } @backup_points;
      push(@{$must_save{$fulls[0]}}, "most recent full");

      # Process retention policy
      my @parts = split(/;/, $retention);
      my %retention_map;
      foreach (@parts) {
        my ($period, $amount) = split(/,/);
        if (!defined($amount)) {
          $amount = -1;
        }
        $retention_map{$period} = $amount;
      }
      my @periods = sort { $a <=> $b } keys(%retention_map);
      my %backup_bins;
      foreach(@periods) {
        $backup_bins{$_} = ();
      }
      my $cutoff = $now - $periods[0];
      # Sort backups into time period sections
      foreach (@backup_points) {
        # @backup_points is in descending order (newest first)
        while ($_ <= $cutoff) {
          # Move to the next largest bin if the current backup is not in the
          # current bin. However, if there is no larger bin, then don't
          shift(@periods);
          if (@periods) {
            $cutoff = $now - $periods[0];
          } else {
            last;
          }
        }
        # Throw away all backups older than the largest time period specified
        if (!@periods) {
          last;
        }
        push(@{$backup_bins{$periods[0]}}, $_);
      }
      foreach (keys(%backup_bins)) {
        my $keep = $retention_map{$_}; # How many backups to keep
        if ($backup_bins{$_}) {
          my @backups = @{$backup_bins{$_}};
          my $total = @backups;  # How many backups we have
          # If we didn't specify how many to keep, keep them all
          if ($keep == -1) { $keep = $total };
          # If we have less backups than we should keep, keep them all
          if ($total < $keep) { $keep = $total };
          for (my $i = 1; $i <= $keep; $i++) {
            my $idx = int(($i * $total) / $keep) - 1;
            push(@{$must_save{$backups[$idx]}}, "retention policy - $_");
          }
        }
      }
      if ($DEBUG) {
        print "    => Backup bins:\n";
        foreach my $a (keys(%backup_bins)) {
          print "      => $a\n";
          foreach my $i (@{$backup_bins{$a}}) {
            my $trans = $now - $i;
            print "         => $i ($trans seconds old)";
            if (exists($must_save{$i})) { print " => keep" };
            print "\n";
          }
        }
      }

      # Look for dependencies
      foreach (@backup_points) {
        if(exists($info->{incremental}->{$_})) {
          print "   => $_ depends on $info->{incremental}->{$_}->{depends}\n" if($DEBUG);
          if (exists($must_save{$_})) {
            push(@{$must_save{$info->{incremental}->{$_}->{depends}}},
              "dependency");
          }
        }
      }

      my @removals = grep { !exists($must_save{$_}) } @backup_points;
      if($DEBUG) {
        my $tf = config_get($host, 'time_format');
        print "    => Candidates for removal:\n";
        foreach (@backup_points) {
          print "      => ". strftime($tf, localtime($_));
          print " ($_)";
          print " [". (exists($info->{full}->{$_}) ? "full":"incremental") ."]";
          if (exists($must_save{$_})) {
            my $reason = join(", ", @{$must_save{$_}});
            print " => keep ($reason)";
          } else {
            print " => remove";
          }
          print "\n";
        }
      }
      foreach (@removals) {
        my $efs = dir_encode($disk);
        my $filename;
        my $dataset;
        if(exists($info->{full}->{$_}->{file})) {
          $filename = $info->{full}->{$_}->{file};
        } elsif(exists($info->{incremental}->{$_}->{file})) {
          $filename = $info->{incremental}->{$_}->{file};
        } elsif(exists($info->{full}->{$_}->{dataset})) {
          $dataset = $info->{full}->{$_}->{dataset};
        } elsif(exists($info->{incremental}->{$_}->{dataset})) {
          $dataset = $info->{incremental}->{$_}->{dataset};
        } else {
          print "ERROR: We tried to expunge $host $disk [$_], but couldn't find it.\n";
        }
        print "    => expunging ${filename}${dataset}\n" if($DEBUG);
        unless($NEUTERED) {
          if ($filename) {
            unlink($filename) || print "ERROR: unlink $filename: $?\n";
          } elsif ($dataset) {
            `__ZFS__ destroy $dataset`;
            if ($?) {
              print "ERROR: zfs destroy $dataset: $?\n";
            }
          }
        }
      }
    }
  }
}

sub __default_sort($$) { return $_[0] cmp $_[1]; }
    
sub choose($$;$$) {
  my($name, $obj, $many, $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 if(scalar(@list) == 1) && $many;
  return $list[0] if(scalar(@list) == 1) && !$many;
  print "\n";
  my $i = 1;
  for (@list) {
    printf " %3d) $hash->{$_}\n", $i++;
  }
  if ($many) {
    my @selection;
    my $range;
    while(1) {
      print "$name: ";
      chomp($range = <>);
      next if ($range !~ /^[\d,-]+$/);
      my @parts = split(',', $range);
      foreach my $part (@parts) {
          my ($from, $to) = ($part =~ /(\d+)(?:-(\d+))?/);
          if ($from < 1 || $to > scalar(@list)) {
              print "Invalid range: $from-$to\n";
              @selection = ();
              last;
          }
          if ($to) {
            push @selection, @list[$from - 1 .. $to - 1];
          } else {
            push @selection, @list[$from - 1];
          }
      }
      if (@selection) {
          last;
      }
    }
    return \@selection;
  } else {
    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 get_fs_from_mountpoint($) {
    my ($mountpoint) = @_;
    my $fs;
    my $rv = open(ZFSLIST, "__ZFS__ list -t filesystem -H |");
    die "Unable to determine zfs filesystem for $mountpoint" unless $rv;
    while (<ZFSLIST>) {
        my @F = split(' ');
        if ($F[-1] eq $mountpoint) {
            $fs = $F[0];
            last;
        }
    }
    close(ZFSLIST);
    die "Unable to determine zfs filesystem for $mountpoint" unless $fs;
    return $fs;
}

sub perform_restore() {
  my (%source, %classmap);

  foreach my $host (grep { $_ ne "default" && $conf{$_}->{"type"} ne "class"} 
      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;
    }

    foreach my $class (get_classes()) {
      if ($DEBUG) {
        if ($class) {
          print "=> Class: $class\n" if $class;
        } else {
          print "=> Class: (none)\n";
        }
      }
      my $store = get_store($host, $class);
      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;
          $classmap{$host}->{$disk} = $class;
        }
      }
    }
  }

  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 $disks = choose("Restore from ZFS", [keys %{$source{$host}}], 1);

  if (scalar(@$disks) > 1) {
    # We selected multiple backups, only the latest backup of each should be
    # used
    print "Multiple filesystems selected, choosing latest backup for each\n";
    my $backup_list = {};
    foreach my $disk (@$disks) {
      my $store = get_store($host, $classmap{$host}->{$disk});
      my $backup_info = scan_for_backups($store);
      $backup_list->{$disk} = [ reverse backup_chain($backup_info->{$disk},
          $backup_info->{$disk}->{last_backup}) ];
    }

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

    # show intentions
    print "Going to restore:\n";
    print "\tfrom: $host\n";
    foreach my $disk (@$disks) {
      print "\tfrom: $disk\n";
    }
    print "\t  to: $RESTORE_HOST\n";
    print "\t  at base zfs: $RESTORE_ZFS\n";
    print "\n";

    foreach my $disk (@$disks) {
      print "Restoring: $disk\n";
      foreach(@{$backup_list->{$disk}}) {
        my $restore_dataset = $disk;
        if ($RESTORE_ZFS) {
          $restore_dataset = "$RESTORE_ZFS/$restore_dataset";
        }
        $_->{success} = zfs_restore_part($RESTORE_HOST, $restore_dataset, $_->{file}, $_->{dataset}, $_->{depends});
      }
    }
  } else {
    my $disk = $disks->[0];
    # 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, 0,
                            sub { $_[0] <=> $_[1]; });

    my $store = get_store($host, $classmap{$host}->{$disk});
    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}, $_->{dataset}, $_->{depends});
    }
  }

}

sub zfs_restore_part($$$$;$) {
  my ($host, $fs, $file, $dataset, $dep) = @_;
  unless ($file || $dataset) {
    print STDERR "=> No dataset or filename given to restore. Bailing out.";
    return 1;
  }
  my $ssh_config = config_get($host, 'ssh_config');
  if($ssh_config) {
    $ssh_config = "-F $ssh_config";
    print STDERR "Using custom ssh config file: $ssh_config\n" if($DEBUG);
  }
  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";
  }
  if ($file) {
    print " => piping $file to $command\n" if($DEBUG);
    print "gzip -dfc $file | ssh $ssh_config $host $command\n" if ($DEBUG && $NEUTERED);
  } elsif ($dataset) {
    print " => piping $dataset to $command using zfs send\n" if ($DEBUG);
    print "zfs send $dataset | ssh $ssh_config $host $command\n" if ($DEBUG && $NEUTERED);
  }
  unless($NEUTERED) {
    if ($file) {
      open(DUMP, "gzip -dfc $file |");
    } elsif ($dataset) {
      open(DUMP, "__ZFS__ send $dataset |");
    }
    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})) {
    if ($info->{full}->{$point}->{file}) {
      my @st = stat($info->{full}->{$point}->{file});
      print "FULL " . pretty_size($st[7]);
      print "\n\tfile: $info->{full}->{$point}->{file}" if($SHOW_FILENAMES);
    } elsif ($info->{full}->{$point}->{dataset}) {
      print "FULL $info->{full}->{$point}->{pretty_size}";
      print "\n\tdataset: $info->{full}->{$point}->{dataset}"
        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, $diskpat) = @_;
  my (@files, @datasets, %classmap);
  my $tf = config_get($host, 'time_format');
  foreach my $class (get_classes()) {
    if ($DEBUG) {
      if ($class) {
        print "=> Class: $class\n" if $class;
      } else {
        print "=> Class: (none)\n";
      }
    }
    my $store = get_store($host, $class);
    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($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);

      # 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, $_);
        if(exists($info->{full}->{$_}->{file})) {
          push @files, $info->{full}->{$_}->{file};
          $classmap{$info->{full}->{$_}->{file}} = $class;
        } elsif(exists($info->{incremental}->{$_}->{file})) {
          push @files, $info->{incremental}->{$_}->{file};
          $classmap{$info->{incremental}->{$_}->{file}} = $class;
        } elsif(exists($info->{full}->{$_}->{dataset})) {
          push @datasets, $info->{full}->{$_}->{dataset};
          $classmap{$info->{full}->{$_}->{dataset}} = $class;
        }
      }
      print "\n";
    }
  }
  if($ARCHIVE && (scalar(@files) || scalar(@datasets))) {
    print "\nAre you sure you would like to archive ".scalar(@files).
      " file(s) and ".scalar(@datasets)." dataset(s)? ";
    while(($_ = <>) !~ /(?:y|n|yes|no)$/i) {
      print "\nAre you sure you would like to archive ".scalar(@files).
        " file(s) and ".scalar(@datasets)." dataset(s)? ";
    }
    if(/^y/i) {
      if (@files) {
        my $archive = config_get($host, 'archive');
        $archive =~ s/%h/$host/g;
        if(! -d $archive) {
          mkdir $archive || die "Cannot mkdir($archive)\n";
        }
        foreach my $file (@files) {
          my $store = get_store($host, $classmap{$file});
          (my $afile = $file) =~ s/^$store/$archive/;
          move($file, $afile) || print "Error archiving $file: $!\n";
        }
      }
      if (@datasets) {
        my $archive = config_get($host, 'archive');
        (my $basearchive = $archive) =~ s/\/?%h//g;
        my $basearchivefs;
        eval {
          $basearchivefs = get_fs_from_mountpoint($basearchive);
        };
        die "Unable to find archive filesystem. The archive directory must be the root of a zfs filesystem to archive datasets." if $@;
        my $archivefs = "$basearchivefs/$host";
        `__ZFS__ create $archivefs`; # We don't care if this fails
        my %seen = ();
        foreach my $dataset (@datasets) {
          my $store = get_store($host, $classmap{$dataset});
          my $storefs = get_fs_from_mountpoint($store);
          $dataset =~ s/@.*$//; # Only rename filesystems, not snapshots
          next if $seen{$dataset}++; # Only rename a filesystem once
          (my $adataset = $dataset) =~ s/^$storefs/$archivefs/;
          `__ZFS__ rename $dataset $adataset`;
          if ($?) {
            print "Error archiving $dataset\n";
          }
        }
      }
    }
  }
}

sub show_violators($$) {
  my ($host, $diskpat) = @_;
  my $host_store = get_store($host);
  my $filesystems = {};
  if (open (my $fh, "$host_store/.fslist")) {
    while (<$fh>) {
      chomp;
      $filesystems->{$_} = 1;
    }
    close($fh);
  } elsif ($DEBUG) {
    print "=> $host_store/.fslist not present, skipping missing FS detection\n";
  }
  foreach my $class (get_classes()) {
    if ($DEBUG) {
      if ($class) {
        print "=> Class: $class\n" if $class;
      } else {
        print "=> Class: (none)\n";
      }
    }
    my $store = get_store($host, $class);
    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 (
        $diskpat &&      # if the pattern was specified it could
        !(
          $disk eq $diskpat ||                        # be a specific match
          ($diskpat =~ /^\/(.+)\/$/ && $disk =~ /$1/) # or a regex
        )
      ); # regex
      # Backups for filesystems that no longer exist aren't violators
      if (!$SUMMARY_VIOLATORS_VERBOSE && %{$filesystems} &&
        !defined $filesystems->{$disk}) {
        print "=> $disk doesn't exist on server, not marking as violator\n"
          if ($DEBUG);
        next;
      }


      my @violators = ();

      # No recent full
      if (time() > $info->{last_full} +
          config_get($host, 'full_interval', $class) +
          config_get($host, 'violator_grace_period', $class)) {
        push @violators, {
          "host" => $host, "disk" => $disk,
          "reason" => "No recent full backup",
          "backup" => "full"
        }
      }

      # No recent incremental
      if (time() > $info->{last_backup} +
          config_get($host, 'backup_interval', $class) +
          config_get($host, 'violator_grace_period', $class)) {
        push @violators, {
          "host" => $host, "disk" => $disk,
          "reason" => "No recent incremental backup",
          "backup" => "backup"
        }
      }

      for my $v (@violators) {
        print "$v->{host}:$v->{disk} - $v->{reason}\n";
        pretty_print_backup($info, $host, $info->{"last_$v->{'backup'}"});
      }
    }
  }
}

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

    # Get list of zfs filesystems from the agent
    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);
    # Write the filesystem list out to a file for use by the violators list
    my $store = get_store($host); # Don't take classes into account - not needed
    mkpath($store) if(! -d $store);
    open(my $fh, ">$store/.fslist");
    foreach my $diskline (@disklist) {
      # Get only the filesystem and not the snapshots/classes
      (my $filesystem = $diskline) =~ s/ \[.*//;
      print $fh "$filesystem\n";
    }
    close($fh);
    if ($DEBUG) {
      print " => Filesystems for $host (zetaback_agent -l output)\n";
      foreach my $diskline (@disklist) {
        print "    $diskline\n";
      }
    }

    foreach my $diskline (@disklist) {
      chomp($diskline);
      next unless($diskline =~ /^(\S+) \[([^\]]*)\](?: \{([^}]*)\})?/);
      my $diskname = $1;
      my %snaps;
      map { $snaps{$_} = 1 } (split(/,/, $2));
      my $class = $3;
 
      # 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
  
      $store = get_store($host, $class);
      if ($DEBUG) {
        if ($class) {
            print STDERR "=> Class is $class\n";
        } else {
            print STDERR "=> No/default class\n";
        }
      }
      print " => Scanning '$store' for old backups of '$diskname'.\n" if($DEBUG);

      # Make directory on demand
      mkpath($store) if(! -d $store);
      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', $class)) {
        $backup_type = 'incremental';
      }
      if(time() > $backup_info->{last_full} + config_get($host,
          'full_interval', $class)) {
        $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);
      $backup_type = 'dataset' if(config_get($host, 'dataset_backup', $class)
        eq 1 && $backup_type ne 'no');

      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') {
          eval { 
            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);
          };
          if ($@) {
            chomp(my $err = $@);
            print " => failure $err\n";
          }
          else { 
            $took_action = 1;
          }
        }
        if($backup_type eq 'dataset') {
          my @backups = sort { $b <=> $a } (keys %{$backup_info->{'full'}});
          eval { zfs_dataset_backup($host, $diskname, $backups[0], $store); };
          if ($@) {
            chomp(my $err = $@);
            print " => failure $err\n";
          }
          else {
            # Unless there was an error backing up, remove all the other dset snaps
            foreach (keys %snaps) {
              zfs_remove_snap($host, $diskname, $_) if(/^__zb_dset_(\d+)/) 
            }
          }
          $took_action = 1;
        }
        unlock($host, dir_encode($diskname), 1);
      }
      $suppress{"$host:$diskname"} = 1;
      last if($took_action);
    }
    unlock($host, '.list');
  }
}

## Start of main program
limit_running_processes;

if($RESTORE) {
  perform_restore();
}
else {
  foreach my $host (grep { $_ ne "default" && $conf{$_}->{"type"} ne "class"}
      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;
    }

    # Skip if the host is marked as 'offline' and we are not listing backups
    if (config_get($host, 'offline') == 1 && 
        !$LIST && !$SUMMARY && !$SUMMARY_EXT && !$ARCHIVE) {
      next;
    }

    if($LIST || $SUMMARY || $SUMMARY_EXT || $ARCHIVE) {
      show_backups($host, $ZFS);
    }
    if ($SUMMARY_VIOLATORS || $SUMMARY_VIOLATORS_VERBOSE) {
      show_violators($host, $ZFS);
    }
    if($BACKUP) {
      plan_and_run($host, $ZFS);
    }
    if($EXPUNGE) {
      perform_retention($host);
    }
  }
}

exit 0;

=pod

=head1 FILES

=over

=item 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