#!/usr/bin/perl

# this software is licensed for use under the Free Software Foundation's GPL v3.0 license, as retrieved
# from http://www.gnu.org/licenses/gpl-3.0.html on 2014-11-17.  A copy should also be available in this
# project's Git repository at https://github.com/jimsalterjrs/sanoid/blob/master/LICENSE.

$::VERSION = '1.4.16';

use strict;
use warnings;
use Data::Dumper;
use Getopt::Long qw(:config auto_version auto_help);
use Pod::Usage;
use Time::Local;
use Sys::Hostname;

# Blank defaults to use ssh client's default
# TODO: Merge into a single "sshflags" option?
my %args = ('sshkey' => '', 'sshport' => '', 'sshcipher' => '', 'sshoption' => [], 'target-bwlimit' => '', 'source-bwlimit' => '');
GetOptions(\%args, "no-command-checks", "monitor-version", "compress=s", "dumpsnaps", "recursive|r",
                   "source-bwlimit=s", "target-bwlimit=s", "sshkey=s", "sshport=i", "sshcipher|c=s", "sshoption|o=s@",
                   "debug", "quiet", "no-stream", "no-sync-snap") or pod2usage(2);

$args{'compress'} = compressargset($args{'compress'} || 'default'); # Can't be done with GetOptions arg, as default still needs to be set

# TODO Expand to accept multiple sources?
if (scalar(@ARGV) != 2) {
	print("Source or target not found!\n");
	pod2usage(2);
	exit 127;
} else {
	$args{'source'} = $ARGV[0];
	$args{'target'} = $ARGV[1];
}

# Could possibly merge these into an options function
if (length $args{'source-bwlimit'}) {
	$args{'source-bwlimit'} = "-R $args{'source-bwlimit'}";
}
if (length $args{'target-bwlimit'}) {
	$args{'target-bwlimit'} = "-r $args{'target-bwlimit'}";
}
$args{'streamarg'} = (defined $args{'no-stream'} ? '-i' : '-I');

my $rawsourcefs = $args{'source'};
my $rawtargetfs = $args{'target'};
my $debug = $args{'debug'};
my $quiet = $args{'quiet'};

my $zfscmd = '/sbin/zfs';
my $sshcmd = '/usr/bin/ssh';
my $pscmd = '/bin/ps';

my $pvcmd = '/usr/bin/pv';
my $mbuffercmd = '/usr/bin/mbuffer';
my $sudocmd = '/usr/bin/sudo';
my $mbufferoptions = '-q -s 128k -m 16M 2>/dev/null';
# currently using ls to check for file existence because we aren't depending on perl
# being present on remote machines.
my $lscmd = '/bin/ls';

if (length $args{'sshcipher'}) {
	$args{'sshcipher'} = "-c $args{'sshcipher'}";
}
if (length $args{'sshport'}) {
  $args{'sshport'} = "-p $args{'sshport'}";
}
if (length $args{'sshkey'}) {
	$args{'sshkey'} = "-i $args{'sshkey'}";
}
my $sshoptions = join " ", map { "-o " . $_ } @{$args{'sshoption'}}; # deref required

# figure out if source and/or target are remote.
$sshcmd = "$sshcmd $args{'sshcipher'} $sshoptions $args{'sshport'} $args{'sshkey'}";
if ($debug) { print "DEBUG: SSHCMD: $sshcmd\n"; }
my ($sourcehost,$sourcefs,$sourceisroot) = getssh($rawsourcefs);
my ($targethost,$targetfs,$targetisroot) = getssh($rawtargetfs);

my $sourcesudocmd = $sourceisroot ? '' : $sudocmd;
my $targetsudocmd = $targetisroot ? '' : $sudocmd;

# figure out whether compression, mbuffering, pv
# are available on source, target, local machines.
# warn user of anything missing, then continue with sync.
my %avail = checkcommands();

my %snaps;

## break here to call replication individually so that we ##
## can loop across children separately, for recursive     ##
## replication                                            ##

if (!defined $args{'recursive'}) {
	syncdataset($sourcehost, $sourcefs, $targethost, $targetfs);
} else {
	if ($debug) { print "DEBUG: recursive sync of $sourcefs.\n"; }
	my @datasets = getchilddatasets($sourcehost, $sourcefs, $sourceisroot);
	foreach my $dataset(@datasets) {
		$dataset =~ s/$sourcefs//;
		chomp $dataset;
		my $childsourcefs = $sourcefs . $dataset;
		my $childtargetfs = $targetfs . $dataset;
		# print "syncdataset($sourcehost, $childsourcefs, $targethost, $childtargetfs); \n";
		syncdataset($sourcehost, $childsourcefs, $targethost, $childtargetfs);
	}
}

# close SSH sockets for master connections as applicable
if ($sourcehost ne '') {
	open FH, "$sshcmd $sourcehost -O exit 2>&1 |";
	close FH;
}
if ($targethost ne '') {
	open FH, "$sshcmd $targethost -O exit 2>&1 |";
	close FH;
}

exit 0;

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

sub getchilddatasets {
	my ($rhost,$fs,$isroot,%snaps) = @_;
	my $mysudocmd;

	if ($isroot) { $mysudocmd = ''; } else { $mysudocmd = $sudocmd; }
	if ($rhost ne '') { $rhost = "$sshcmd $rhost"; }

	my $getchildrencmd = "$rhost $mysudocmd $zfscmd list -o name -t filesystem,volume -Hr $fs |";
	if ($debug) { print "DEBUG: getting list of child datasets on $fs using $getchildrencmd...\n"; }
	open FH, $getchildrencmd;
	my @children = <FH>;
	close FH;

	return @children;
}

sub syncdataset {

	my ($sourcehost, $sourcefs, $targethost, $targetfs) = @_;

	if ($debug) { print "DEBUG: syncing source $sourcefs to target $targetfs.\n"; }

	# make sure target is not currently in receive.
	if (iszfsbusy($targethost,$targetfs,$targetisroot)) {
		warn "Cannot sync now: $targetfs is already target of a zfs receive process.\n";
		return 0;
	}

	# does the target filesystem exist yet?
	my $targetexists = targetexists($targethost,$targetfs,$targetisroot);

	# build hashes of the snaps on the source and target filesystems.

	%snaps = getsnaps('source',$sourcehost,$sourcefs,$sourceisroot);

	if ($targetexists) {
		my %targetsnaps = getsnaps('target',$targethost,$targetfs,$targetisroot);
		my %sourcesnaps = %snaps;
		%snaps = (%sourcesnaps, %targetsnaps);
	}

	if (defined $args{'dumpsnaps'}) {
		print "merged snapshot list of $targetfs: \n";
		dumphash(\%snaps);
		print "\n\n\n";
	}

	# create a new syncoid snapshot on the source filesystem.
	my $newsyncsnap;
	if (!defined $args{'no-sync-snap'}) {
		$newsyncsnap = newsyncsnap($sourcehost,$sourcefs,$sourceisroot);
	} else {
		# we don't want sync snapshots created, so use the newest snapshot we can find.
		$newsyncsnap = getnewestsnapshot($sourcehost,$sourcefs,$sourceisroot);
		if ($newsyncsnap eq 0) {
			warn "CRITICAL: no snapshots exist on source $sourcefs, and you asked for --no-sync-snap.\n";
			return 0;
		}
	}

	# there is currently (2014-09-01) a bug in ZFS on Linux
	# that causes readonly to always show on if it's EVER
	# been turned on... even when it's off... unless and
	# until the filesystem is zfs umounted and zfs remounted.
	# we're going to do the right thing anyway.
		# dyking this functionality out for the time being due to buggy mount/unmount behavior
		# with ZFS on Linux (possibly OpenZFS in general) when setting/unsetting readonly.
	#my $originaltargetreadonly;

	# sync 'em up.
	if (! $targetexists) {
		# do an initial sync from the oldest source snapshot
		# THEN do an -I to the newest
		if ($debug) {
			if (!defined ($args{'no-stream'}) ) {
				print "DEBUG: target $targetfs does not exist.  Finding oldest available snapshot on source $sourcefs ...\n";
			} else {
				print "DEBUG: target $targetfs does not exist, and --no-stream selected.  Finding newest available snapshot on source $sourcefs ...\n";
			}
		}
		my $oldestsnap = getoldestsnapshot(\%snaps);
		if (! $oldestsnap) {
			# getoldestsnapshot() returned false, so use new sync snapshot
			if ($debug) { print "DEBUG: getoldestsnapshot() returned false, so using $newsyncsnap.\n"; }
			$oldestsnap = $newsyncsnap;
		}

		# if --no-stream is specified, our full needs to be the newest snapshot, not the oldest.
		if (defined $args{'no-stream'}) { $oldestsnap = getnewestsnapshot(\%snaps); }

		my $sendcmd = "$sourcesudocmd $zfscmd send $sourcefs\@$oldestsnap";
		my $recvcmd = "$targetsudocmd $zfscmd receive -F $targetfs";

		my $pvsize = getsendsize($sourcehost,"$sourcefs\@$oldestsnap",0,$sourceisroot);
		my $disp_pvsize = readablebytes($pvsize);
		if ($pvsize == 0) { $disp_pvsize = 'UNKNOWN'; }
		my $synccmd = buildsynccmd($sendcmd,$recvcmd,$pvsize,$sourceisroot,$targetisroot);
		if (!$quiet) {
			if (!defined ($args{'no-stream'}) ) {
				print "INFO: Sending oldest full snapshot $sourcefs\@$oldestsnap (~ $disp_pvsize) to new target filesystem:\n";
			} else {
				print "INFO: --no-stream selected; sending newest full snapshot $sourcefs\@$oldestsnap (~ $disp_pvsize) to new target filesystem:\n";
			}
		}
		if ($debug) { print "DEBUG: $synccmd\n"; }

		# make sure target is (still) not currently in receive.
		if (iszfsbusy($targethost,$targetfs,$targetisroot)) {
			warn "Cannot sync now: $targetfs is already target of a zfs receive process.\n";
			return 0;
		}
		system($synccmd) == 0
			or die "CRITICAL ERROR: $synccmd failed: $?";

		# now do an -I to the new sync snapshot, assuming there were any snapshots
		# other than the new sync snapshot to begin with, of course - and that we
		# aren't invoked with --no-stream, in which case a full of the newest snap
		# available was all we needed to do
		if (!defined ($args{'no-stream'}) && ($oldestsnap ne $newsyncsnap) ) {

			# get current readonly status of target, then set it to on during sync
				# dyking this functionality out for the time being due to buggy mount/unmount behavior
				# with ZFS on Linux (possibly OpenZFS in general) when setting/unsetting readonly.
			# $originaltargetreadonly = getzfsvalue($targethost,$targetfs,$targetisroot,'readonly');
			# setzfsvalue($targethost,$targetfs,$targetisroot,'readonly','on');

			$sendcmd = "$sourcesudocmd $zfscmd send $args{'streamarg'} $sourcefs\@$oldestsnap $sourcefs\@$newsyncsnap";
			$pvsize = getsendsize($sourcehost,"$sourcefs\@$oldestsnap","$sourcefs\@$newsyncsnap",$sourceisroot);
			$disp_pvsize = readablebytes($pvsize);
			if ($pvsize == 0) { $disp_pvsize = "UNKNOWN"; }
			$synccmd = buildsynccmd($sendcmd,$recvcmd,$pvsize,$sourceisroot,$targetisroot);

			# make sure target is (still) not currently in receive.
			if (iszfsbusy($targethost,$targetfs,$targetisroot)) {
				warn "Cannot sync now: $targetfs is already target of a zfs receive process.\n";
				return 0;
			}

			if (!$quiet) { print "INFO: Updating new target filesystem with incremental $sourcefs\@$oldestsnap ... $newsyncsnap (~ $disp_pvsize):\n"; }
			if ($debug) { print "DEBUG: $synccmd\n"; }

			if ($oldestsnap ne $newsyncsnap) {
				system($synccmd) == 0
					or warn "CRITICAL ERROR: $synccmd failed: $?";
					return 0;
			} else {
				if (!$quiet) { print "INFO: no incremental sync needed; $oldestsnap is already the newest available snapshot.\n"; }
			}

			# restore original readonly value to target after sync complete
				# dyking this functionality out for the time being due to buggy mount/unmount behavior
				# with ZFS on Linux (possibly OpenZFS in general) when setting/unsetting readonly.
			# setzfsvalue($targethost,$targetfs,$targetisroot,'readonly',$originaltargetreadonly);
		}
	} else {
		# find most recent matching snapshot and do an -I
		# to the new snapshot

		# get current readonly status of target, then set it to on during sync
			# dyking this functionality out for the time being due to buggy mount/unmount behavior
			# with ZFS on Linux (possibly OpenZFS in general) when setting/unsetting readonly.
		# $originaltargetreadonly = getzfsvalue($targethost,$targetfs,$targetisroot,'readonly');
		# setzfsvalue($targethost,$targetfs,$targetisroot,'readonly','on');

		my $targetsize = getzfsvalue($targethost,$targetfs,$targetisroot,'-p used');

		my $matchingsnap = getmatchingsnapshot($sourcefs, $targetfs, $targetsize, \%snaps);
		if (! $matchingsnap) {
			# no matching snapshot; we whined piteously already, but let's go ahead and return false
			# now in case more child datasets need replication.
			return 0;
		}

		# make sure target is (still) not currently in receive.
		if (iszfsbusy($targethost,$targetfs,$targetisroot)) {
			warn "Cannot sync now: $targetfs is already target of a zfs receive process.\n";
			return 0;
		}

		if ($matchingsnap eq $newsyncsnap) {
			# barf some text but don't touch the filesystem
			if (!$quiet) { print "INFO: no snapshots on source newer than $newsyncsnap on target. Nothing to do, not syncing.\n"; }
		} else {
			# rollback target to matchingsnap
			if ($debug) { print "DEBUG: rolling back target to $targetfs\@$matchingsnap...\n"; }
			if ($targethost ne '') {
				if ($debug) { print "$sshcmd $targethost $targetsudocmd $zfscmd rollback -R $targetfs\@$matchingsnap\n"; }
				system ("$sshcmd $targethost $targetsudocmd $zfscmd rollback -R $targetfs\@$matchingsnap");
			} else {
				if ($debug) { print "$targetsudocmd $zfscmd rollback -R $targetfs\@$matchingsnap\n"; }
				system ("$targetsudocmd $zfscmd rollback -R $targetfs\@$matchingsnap");
			}

			my $sendcmd = "$sourcesudocmd $zfscmd send $args{'streamarg'} $sourcefs\@$matchingsnap $sourcefs\@$newsyncsnap";
			my $recvcmd = "$targetsudocmd $zfscmd receive -F $targetfs";
			my $pvsize = getsendsize($sourcehost,"$sourcefs\@$matchingsnap","$sourcefs\@$newsyncsnap",$sourceisroot);
			my $disp_pvsize = readablebytes($pvsize);
			if ($pvsize == 0) { $disp_pvsize = "UNKNOWN"; }
			my $synccmd = buildsynccmd($sendcmd,$recvcmd,$pvsize,$sourceisroot,$targetisroot);

			if (!$quiet) { print "Sending incremental $sourcefs\@$matchingsnap ... $newsyncsnap (~ $disp_pvsize):\n"; }
			if ($debug) { print "DEBUG: $synccmd\n"; }
			system("$synccmd") == 0
				or die "CRITICAL ERROR: $synccmd failed: $?";

			# restore original readonly value to target after sync complete
				# dyking this functionality out for the time being due to buggy mount/unmount behavior
				# with ZFS on Linux (possibly OpenZFS in general) when setting/unsetting readonly.
			#setzfsvalue($targethost,$targetfs,$targetisroot,'readonly',$originaltargetreadonly);
		}
	}

	# prune obsolete sync snaps on source and target.
	pruneoldsyncsnaps($sourcehost,$sourcefs,$newsyncsnap,$sourceisroot,keys %{ $snaps{'source'}});
	pruneoldsyncsnaps($targethost,$targetfs,$newsyncsnap,$targetisroot,keys %{ $snaps{'target'}});

} # end syncdataset()

sub compressargset {
	my ($value) = @_;
	my $DEFAULT_COMPRESSION = 'lzo';
	my %COMPRESS_ARGS = (
		'none' => {
			rawcmd      => '',
			args        => '',
			decomrawcmd => '',
			decomargs   => '',
		},
		'gzip' => {
			rawcmd      => '/bin/gzip',
			args        => '-3',
			decomrawcmd => '/bin/zcat',
			decomargs   => '',
		},
		'pigz-fast' => {
			rawcmd      => '/usr/bin/pigz',
			args        => '-3',
			decomrawcmd => '/usr/bin/pigz',
			decomargs   => '-dc',
		},
		'pigz-slow' => {
			rawcmd      => '/usr/bin/pigz',
			args        => '-9',
			decomrawcmd => '/usr/bin/pigz',
			decomargs   => '-dc',
		},
		'lzo' => {
			rawcmd      => '/usr/bin/lzop',
			args        => '',
			decomrawcmd => '/usr/bin/lzop',
			decomargs   => '-dfc',
		},
	);

	if ($value eq 'default') {
		$value = $DEFAULT_COMPRESSION;
	} elsif (!(grep $value eq $_, ('gzip', 'pigz-fast', 'pigz-slow', 'lzo', 'default', 'none'))) {
		warn "Unrecognised compression value $value, defaulting to $DEFAULT_COMPRESSION";
		$value = $DEFAULT_COMPRESSION;
	}

	my %comargs = %{$COMPRESS_ARGS{$value}}; # copy
	$comargs{'compress'} = $value;
	$comargs{'cmd'}      = "$comargs{'rawcmd'} $comargs{'args'}";
	$comargs{'decomcmd'} = "$comargs{'decomrawcmd'} $comargs{'decomargs'}";
	return \%comargs;
}

sub checkcommands {
	# make sure compression, mbuffer, and pv are available on
	# source, target, and local hosts as appropriate.

	my %avail;
	my $sourcessh;
	my $targetssh;

	# if --nocommandchecks then assume everything's available and return
	if ($args{'nocommandchecks'}) {
		if ($debug) { print "DEBUG: not checking for command availability due to --nocommandchecks switch.\n"; }
		$avail{'compress'} = 1;
		$avail{'localpv'} = 1;
		$avail{'localmbuffer'} = 1;
		$avail{'sourcembuffer'} = 1;
		$avail{'targetmbuffer'} = 1;
		return %avail;
	}

	if (!defined $sourcehost) { $sourcehost = ''; }
	if (!defined $targethost) { $targethost = ''; }

	if ($sourcehost ne '') { $sourcessh = "$sshcmd $sourcehost"; } else { $sourcessh = ''; }
	if ($targethost ne '') { $targetssh = "$sshcmd $targethost"; } else { $targetssh = ''; }

	# if raw compress command is null, we must have specified no compression. otherwise,
	# make sure that compression is available everywhere we need it
	if ($args{'compress'}{'compress'} eq 'none') {
		if ($debug) { print "DEBUG: compression forced off from command line arguments.\n"; }
	} else {
		if ($debug) { print "DEBUG: checking availability of $args{'compress'}{'rawcmd'} on source...\n"; }
		$avail{'sourcecompress'} = `$sourcessh $lscmd $args{'compress'}{'rawcmd'} 2>/dev/null`;
		if ($debug) { print "DEBUG: checking availability of $args{'compress'}{'rawcmd'} on target...\n"; }
		$avail{'targetcompress'} = `$targetssh $lscmd $args{'compress'}{'rawcmd'} 2>/dev/null`;
		if ($debug) { print "DEBUG: checking availability of $args{'compress'}{'rawcmd'} on local machine...\n"; }
		$avail{'localcompress'} = `$lscmd $args{'compress'}{'rawcmd'} 2>/dev/null`;
	}

	my ($s,$t);
	if ($sourcehost eq '') {
		$s = '[local machine]'
	} else {
		$s = $sourcehost;
		$s =~ s/^\S*\@//;
		$s = "ssh:$s";
	}
	if ($targethost eq '') {
		$t = '[local machine]'
	} else {
		$t = $targethost;
		$t =~ s/^\S*\@//;
		$t = "ssh:$t";
	}

	if (!defined $avail{'sourcecompress'}) { $avail{'sourcecompress'} = ''; }
	if (!defined $avail{'targetcompress'}) { $avail{'targetcompress'} = ''; }
	if (!defined $avail{'sourcembuffer'}) { $avail{'sourcembuffer'} = ''; }
	if (!defined $avail{'targetmbuffer'}) { $avail{'targetmbuffer'} = ''; }


	if ($avail{'sourcecompress'} eq '') {
		if ($args{'compress'}{'rawcmd'} ne '') {
			print "WARN: $args{'compress'}{'rawcmd'} not available on source $s- sync will continue without compression.\n";
		}
		$avail{'compress'} = 0;
	}
	if ($avail{'targetcompress'} eq '') {
		if ($args{'compress'}{'rawcmd'} ne '') {
			print "WARN: $args{'compress'}{'rawcmd'} not available on target $t - sync will continue without compression.\n";
		}
		$avail{'compress'} = 0;
	}
	if ($avail{'targetcompress'} ne '' && $avail{'sourcecompress'} ne '') {
		# compression available - unless source and target are both remote, which we'll check
		# for in the next block and respond to accordingly.
		$avail{'compress'} = 1;
	}

	# corner case - if source AND target are BOTH remote, we have to check for local compress too
	if ($sourcehost ne '' && $targethost ne '' && $avail{'localcompress'} eq '') {
		if ($args{'compress'}{'rawcmd'} ne '') {
			print "WARN: $args{'compress'}{'rawcmd'} not available on local machine - sync will continue without compression.\n";
		}
		$avail{'compress'} = 0;
	}

	if ($debug) { print "DEBUG: checking availability of $mbuffercmd on source...\n"; }
	$avail{'sourcembuffer'} = `$sourcessh $lscmd $mbuffercmd 2>/dev/null`;
	if ($avail{'sourcembuffer'} eq '') {
		print "WARN: $mbuffercmd not available on source $s - sync will continue without source buffering.\n";
		$avail{'sourcembuffer'} = 0;
	} else {
		$avail{'sourcembuffer'} = 1;
	}

	if ($debug) { print "DEBUG: checking availability of $mbuffercmd on target...\n"; }
	$avail{'targetmbuffer'} = `$targetssh $lscmd $mbuffercmd 2>/dev/null`;
	if ($avail{'targetmbuffer'} eq '') {
		print "WARN: $mbuffercmd not available on target $t - sync will continue without target buffering.\n";
		$avail{'targetmbuffer'} = 0;
	} else {
		$avail{'targetmbuffer'} = 1;
	}

	# if we're doing remote source AND remote target, check for local mbuffer as well
	if ($sourcehost ne '' && $targethost ne '') {
		if ($debug) { print "DEBUG: checking availability of $mbuffercmd on local machine...\n"; }
		$avail{'localmbuffer'} = `$lscmd $mbuffercmd 2>/dev/null`;
		if ($avail{'localmbuffer'} eq '') {
			$avail{'localmbuffer'} = 0;
			print "WARN: $mbuffercmd not available on local machine - sync will continue without local buffering.\n";
		}
	}

	if ($debug) { print "DEBUG: checking availability of $pvcmd on local machine...\n"; }
	$avail{'localpv'} = `$lscmd $pvcmd 2>/dev/null`;
	if ($avail{'localpv'} eq '') {
		print "WARN: $pvcmd not available on local machine - sync will continue without progress bar.\n";
		$avail{'localpv'} = 0;
	} else {
		$avail{'localpv'} = 1;
	}

	return %avail;
}

sub iszfsbusy {
	my ($rhost,$fs,$isroot) = @_;
	if ($rhost ne '') { $rhost = "$sshcmd $rhost"; }
	if ($debug) { print "DEBUG: checking to see if $fs on $rhost is already in zfs receive using $rhost $pscmd -Ao args= ...\n"; }

	open PL, "$rhost $pscmd -Ao args= |";
	my @processes = <PL>;
	close PL;

	foreach my $process (@processes) {
		# if ($debug) { print "DEBUG: checking process $process...\n"; }
		if ($process =~ /zfs *(receive|recv).*$fs/) {
			# there's already a zfs receive process for our target filesystem - return true
			if ($debug) { print "DEBUG: process $process matches target $fs!\n"; }
			return 1;
		}
	}

	# no zfs receive processes for our target filesystem found - return false
	return 0;
}

sub setzfsvalue {
	my ($rhost,$fs,$isroot,$property,$value) = @_;
	if ($rhost ne '') { $rhost = "$sshcmd $rhost"; }
	if ($debug) { print "DEBUG: setting $property to $value on $fs...\n"; }
	my $mysudocmd;
	if ($isroot) { $mysudocmd = ''; } else { $mysudocmd = $sudocmd; }
	if ($debug) { print "$rhost $mysudocmd $zfscmd set $property=$value $fs\n"; }
	system("$rhost $mysudocmd $zfscmd set $property=$value $fs") == 0
		or warn "WARNING: $rhost $mysudocmd $zfscmd set $property=$value $fs died: $?, proceeding anyway.\n";
	return;
}

sub getzfsvalue {
	my ($rhost,$fs,$isroot,$property) = @_;
	if ($rhost ne '') { $rhost = "$sshcmd $rhost"; }
	if ($debug) { print "DEBUG: getting current value of $property on $fs...\n"; }
	my $mysudocmd;
	if ($isroot) { $mysudocmd = ''; } else { $mysudocmd = $sudocmd; }
	if ($debug) { print "$rhost $mysudocmd $zfscmd get -H $property $fs\n"; }
	open FH, "$rhost $mysudocmd $zfscmd get -H $property $fs |";
	my $value = <FH>;
	close FH;
	my @values = split(/\s/,$value);
	$value = $values[2];
	return $value;
}

sub readablebytes {
	my $bytes = shift;
	my $disp;

	if ($bytes > 1024*1024*1024) {
		$disp = sprintf("%.1f",$bytes/1024/1024/1024) . ' GB';
	} elsif ($bytes > 1024*1024) {
		$disp = sprintf("%.1f",$bytes/1024/1024) . ' MB';
	} else {
		$disp = sprintf("%d",$bytes/1024) . ' KB';
	}
	return $disp;
}

sub getoldestsnapshot {
	my $snaps = shift;
	foreach my $snap ( sort { $snaps{'source'}{$a}{'creation'}<=>$snaps{'source'}{$b}{'creation'} } keys %{ $snaps{'source'} }) {
		# return on first snap found - it's the oldest
		return $snap;
	}
	# must not have had any snapshots on source - luckily, we already made one, amirite?
	if (defined ($args{'no-sync-snap'}) ) {
		# well, actually we set --no-sync-snap, so no we *didn't* already make one. Whoops.
		die "CRIT: --no-sync-snap is set, and getoldestsnapshot() could not find any snapshots on source!\n";
	}
	return 0;
}

sub getnewestsnapshot {
	my $snaps = shift;
	foreach my $snap ( sort { $snaps{'source'}{$b}{'creation'}<=>$snaps{'source'}{$a}{'creation'} } keys %{ $snaps{'source'} }) {
		# return on first snap found - it's the newest
		print "NEWEST SNAPSHOT: $snap\n";
		return $snap;
	}
	# must not have had any snapshots on source - looks like we'd better create one!
	if (defined ($args{'no-sync-snap'}) ) {
		if (!defined ($args{'recursive'}) ) {
			# well, actually we set --no-sync-snap and we're not recursive, so no we *can't* make one. Whoops.
			die "CRIT: --no-sync-snap is set, and getnewestsnapshot() could not find any snapshots on source!\n";
		}
		# fixme: we need to output WHAT the current dataset IS if we encounter this WARN condition.
		#        we also probably need an argument to mute this WARN, for people who deliberately exclude
		#        datasets from recursive replication this way.
		warn "WARN: --no-sync-snap is set, and getnewestsnapshot() could not find any snapshots on source for current dataset. Continuing.\n";
	}
	return 0;
}

sub buildsynccmd {
	my ($sendcmd,$recvcmd,$pvsize,$sourceisroot,$targetisroot) = @_;
	# here's where it gets fun: figuring out when to compress and decompress.
	# to make this work for all possible combinations, you may have to decompress
	# AND recompress across the pipe viewer. FUN.
	my $synccmd;

	if ($sourcehost eq '' && $targethost eq '') {
		# both sides local. don't compress. do mbuffer, once, on the source side.
		# $synccmd = "$sendcmd | $mbuffercmd | $pvcmd | $recvcmd";
		$synccmd = "$sendcmd |";
		# avoid confusion - accept either source-bwlimit or target-bwlimit as the bandwidth limiting option here
		my $bwlimit = '';
		if (length $args{'bwlimit'}) {
			$bwlimit = $args{'source-bwlimit'};
		} elsif (length $args{'target-bwlimit'}) {
			$bwlimit = $args{'target-bwlimit'};
		}

		if ($avail{'sourcembuffer'}) { $synccmd .= " $mbuffercmd $bwlimit $mbufferoptions |"; }
		if ($avail{'localpv'} && !$quiet) { $synccmd .= " $pvcmd -s $pvsize |"; }
		$synccmd .= " $recvcmd";
	} elsif ($sourcehost eq '') {
		# local source, remote target.
		#$synccmd = "$sendcmd | $pvcmd | $args{'compress'}{'cmd'} | $mbuffercmd | $sshcmd $targethost '$args{'compress'}{'decomcmd'} | $mbuffercmd | $recvcmd'";
		$synccmd = "$sendcmd |";
		if ($avail{'localpv'} && !$quiet) { $synccmd .= " $pvcmd -s $pvsize |"; }
		if ($avail{'compress'}) { $synccmd .= " $args{'compress'}{'cmd'} |"; }
		if ($avail{'sourcembuffer'}) { $synccmd .= " $mbuffercmd $args{'source-bwlimit'} $mbufferoptions |"; }
		$synccmd .= " $sshcmd $targethost '";
		if ($avail{'targetmbuffer'}) { $synccmd .= " $mbuffercmd $args{'target-bwlimit'} $mbufferoptions |"; }
		if ($avail{'compress'}) { $synccmd .= " $args{'compress'}{'decomcmd'} |"; }
		$synccmd .= " $recvcmd'";
	} elsif ($targethost eq '') {
		# remote source, local target.
		#$synccmd = "$sshcmd $sourcehost '$sendcmd | $args{'compress'}{'cmd'} | $mbuffercmd' | $args{'decompress'}{'cmd'} | $mbuffercmd | $pvcmd | $recvcmd";
		$synccmd = "$sshcmd $sourcehost '$sendcmd";
		if ($avail{'compress'}) { $synccmd .= " | $args{'compresscmd'}"; }
		if ($avail{'sourcembuffer'}) { $synccmd .= " | $mbuffercmd $args{'source-bwlimit'} $mbufferoptions"; }
		$synccmd .= "' | ";
		if ($avail{'targetmbuffer'}) { $synccmd .= "$mbuffercmd $args{'target-bwlimit'} $mbufferoptions | "; }
		if ($avail{'compress'}) { $synccmd .= "$args{'decompresscmd'} | "; }
		if ($avail{'localpv'} && !$quiet) { $synccmd .= "$pvcmd -s $pvsize | "; }
		$synccmd .= "$recvcmd";
	} else {
		#remote source, remote target... weird, but whatever, I'm not here to judge you.
		#$synccmd = "$sshcmd $sourcehost '$sendcmd | $args{'compress'}{'cmd'} | $mbuffercmd' | $args{'compress'}{'decomcmd'} | $pvcmd | $args{'compress'}{'cmd'} | $mbuffercmd | $sshcmd $targethost '$args{'compress'}{'decomcmd'} | $mbuffercmd | $recvcmd'";
		$synccmd = "$sshcmd $sourcehost '$sendcmd";
		if ($avail{'compress'}) { $synccmd .= " | $args{'compress'}{'cmd'}"; }
		if ($avail{'sourcembuffer'}) { $synccmd .= " | $mbuffercmd $args{'source-bwlimit'} $mbufferoptions"; }
		$synccmd .= "' | ";
		if ($avail{'compress'}) { $synccmd .= "$args{'compress'}{'decomcmd'} | "; }
		if ($avail{'localpv'} && !$quiet) { $synccmd .= "$pvcmd -s $pvsize | "; }
		if ($avail{'compress'}) { $synccmd .= "$args{'compress'}{'cmd'} | "; }
		if ($avail{'localmbuffer'}) { $synccmd .= "$mbuffercmd $mbufferoptions | "; }
		$synccmd .= "$sshcmd $targethost '";
		if ($avail{'targetmbuffer'}) { $synccmd .= "$mbuffercmd $args{'target-bwlimit'} $mbufferoptions | "; }
		if ($avail{'compress'}) { $synccmd .= "$args{'compress'}{'decomcmd'} | "; }
		$synccmd .= "$recvcmd'";
	}
	return $synccmd;
}

sub pruneoldsyncsnaps {
	my ($rhost,$fs,$newsyncsnap,$isroot,@snaps) = @_;
	if ($rhost ne '') { $rhost = "$sshcmd $rhost"; }
	my $hostid = hostname();

	my $mysudocmd;
	if ($isroot) { $mysudocmd=''; } else { $mysudocmd = $sudocmd; }

	my @prunesnaps;

	# only prune snaps beginning with syncoid and our own hostname
	foreach my $snap(@snaps) {
		if ($snap =~ /^syncoid_$hostid/) {
			# no matter what, we categorically refuse to
			# prune the new sync snap we created for this run
			if ($snap ne $newsyncsnap) {
				push (@prunesnaps,$snap);
			}
		}
	}

	# concatenate pruning commands to ten per line, to cut down
	# auth times for any remote hosts that must be operated via SSH
	my $counter;
	my $maxsnapspercmd = 10;
	my $prunecmd;
	foreach my $snap(@prunesnaps) {
		$counter ++;
		$prunecmd .= "$mysudocmd $zfscmd destroy $fs\@$snap; ";
		if ($counter > $maxsnapspercmd) {
			$prunecmd =~ s/\; $//;
			if ($rhost ne '') { $prunecmd = '"' . $prunecmd . '"'; }
			if ($debug) { print "DEBUG: pruning up to $maxsnapspercmd obsolete sync snapshots...\n"; }
			if ($debug) { print "DEBUG: $rhost $prunecmd\n"; }
			system("$rhost $prunecmd") == 0
				or warn "CRITICAL ERROR: $rhost $prunecmd failed: $?";
			$prunecmd = '';
			$counter = 0;
		}
	}
	# if we still have some prune commands stacked up after finishing
	# the loop, commit 'em now
	if ($counter) {
		$prunecmd =~ s/\; $//;
		if ($rhost ne '') { $prunecmd = '"' . $prunecmd . '"'; }
		if ($debug) { print "DEBUG: pruning up to $maxsnapspercmd obsolete sync snapshots...\n"; }
		if ($debug) { print "DEBUG: $rhost $prunecmd\n"; }
		system("$rhost $prunecmd") == 0
			or warn "WARNING: $rhost $prunecmd failed: $?";
	}
	return;
}

sub getmatchingsnapshot {
	my ($sourcefs, $targetfs, $targetsize, $snaps) = @_;
	foreach my $snap ( sort { $snaps{'source'}{$b}{'creation'}<=>$snaps{'source'}{$a}{'creation'} } keys %{ $snaps{'source'} }) {
		if (defined $snaps{'target'}{$snap}{'guid'}) {
			if ($snaps{'source'}{$snap}{'guid'} == $snaps{'target'}{$snap}{'guid'}) {
				return $snap;
			}
		}
	}

	# if we got this far, we failed to find a matching snapshot.

	print "\n";
	print "CRITICAL ERROR: Target $targetfs exists but has no snapshots matching with $sourcefs!\n";
	print "                Replication to target would require destroying existing\n";
	print "                target. Cowardly refusing to destroy your existing target.\n\n";

	# experience tells me we need a mollyguard for people who try to
	# zfs create targetpool/targetsnap ; syncoid sourcepool/sourcesnap targetpool/targetsnap ...

	if ( $targetsize < (64*1024*1024) ) {
		print "          NOTE: Target $targetfs dataset is < 64MB used - did you mistakenly run\n";
		print "                \`zfs create $args{'target'}\` on the target? ZFS initial\n";
		print "                replication must be to a NON EXISTENT DATASET, which will\n";
		print "                then be CREATED BY the initial replication process.\n\n";
	}
	return 0;
}

sub newsyncsnap {
	my ($rhost,$fs,$isroot) = @_;
	if ($rhost ne '') { $rhost = "$sshcmd $rhost"; }
	my $mysudocmd;
	if ($isroot) { $mysudocmd = ''; } else { $mysudocmd = $sudocmd; }
	my $hostid = hostname();
	my %date = getdate();
	my $snapname = "syncoid\_$hostid\_$date{'stamp'}";
	my $snapcmd = "$rhost $mysudocmd $zfscmd snapshot $fs\@$snapname\n";
	system($snapcmd) == 0
		or die "CRITICAL ERROR: $snapcmd failed: $?";
	return $snapname;
}

sub targetexists {
	my ($rhost,$fs,$isroot) = @_;
	if ($rhost ne '') { $rhost = "$sshcmd $rhost"; }
	my $mysudocmd;
	if ($isroot) { $mysudocmd = ''; } else { $mysudocmd = $sudocmd; }
	my $checktargetcmd = "$rhost $mysudocmd $zfscmd get -H name $fs";
	if ($debug) { print "DEBUG: checking to see if target filesystem exists using \"$checktargetcmd 2>&1 |\"...\n"; }
	open FH, "$checktargetcmd 2>&1 |";
	my $targetexists = <FH>;
	close FH;
	my $exit = $?;
	$targetexists = ( $targetexists =~ /^$fs/ && $exit == 0 );
	return $targetexists;
}

sub getssh {
	my $fs = shift;

	my $rhost;
	my $isroot;
	my $socket;

	# if we got passed something with an @ in it, we assume it's an ssh connection, eg root@myotherbox
	if ($fs =~ /\@/) {
		$rhost = $fs;
		$fs =~ s/^\S*\@\S*://;
		$rhost =~ s/:$fs$//;
		my $remoteuser = $rhost;
		 $remoteuser =~ s/\@.*$//;
		if ($remoteuser eq 'root') { $isroot = 1; } else { $isroot = 0; }
		# now we need to establish a persistent master SSH connection
		$socket = "/tmp/syncoid-$remoteuser-$rhost-" . time();
		open FH, "$sshcmd -M -S $socket -o ControlPersist=1m $args{'sshport'} $rhost exit |";
		close FH;
		$rhost = "-S $socket $rhost";
	} else {
		my $localuid = $<;
		if ($localuid == 0) { $isroot = 1; } else { $isroot = 0; }
	}
	# if ($isroot) { print "this user is root.\n"; } else { print "this user is not root.\n"; }
	return ($rhost,$fs,$isroot);
}

sub dumphash() {
	my $hash = shift;
	$Data::Dumper::Sortkeys = 1;
	print Dumper($hash);
}

sub getsnaps() {
	my ($type,$rhost,$fs,$isroot,%snaps) = @_;
	my $mysudocmd;
	if ($isroot) { $mysudocmd = ''; } else { $mysudocmd = $sudocmd; }

	if ($rhost ne '') { $rhost = "$sshcmd $rhost"; }

	my $getsnapcmd = "$rhost $mysudocmd $zfscmd get -Hpd 1 -t snapshot guid,creation $fs |";
	if ($debug) { print "DEBUG: getting list of snapshots on $fs using $getsnapcmd...\n"; }
	open FH, $getsnapcmd;
	my @rawsnaps = <FH>;
	close FH;

	# this is a little obnoxious. get guid,creation returns guid,creation on two separate lines
	# as though each were an entirely separate get command.

	foreach my $line (@rawsnaps) {
		# only import snap guids from the specified filesystem
		if ($line =~ /$fs\@.*guid/) {
			chomp $line;
			my $guid = $line;
			$guid =~ s/^.*\sguid\s*(\d*).*/$1/;
			my $snap = $line;
			$snap =~ s/^\S*\@(\S*)\s*guid.*$/$1/;
			$snaps{$type}{$snap}{'guid'}=$guid;
		}
	}

	foreach my $line (@rawsnaps) {
		# only import snap creations from the specified filesystem
		if ($line =~ /$fs\@.*creation/) {
			chomp $line;
			my $creation = $line;
			$creation =~ s/^.*\screation\s*(\d*).*/$1/;
			my $snap = $line;
			$snap =~ s/^\S*\@(\S*)\s*creation.*$/$1/;
			$snaps{$type}{$snap}{'creation'}=$creation;
		}
	}

	return %snaps;
}


sub getsendsize {
	my ($sourcehost,$snap1,$snap2,$isroot) = @_;

	my $mysudocmd;
	if ($isroot) { $mysudocmd = ''; } else { $mysudocmd = $sudocmd; }

	my $snaps;
	if ($snap2) {
		# if we got a $snap2 argument, we want an incremental send estimate from $snap1 to $snap2.
		$snaps = "$args{'streamarg'} $snap1 $snap2";
	} else {
		# if we didn't get a $snap2 arg, we want a full send estimate for $snap1.
		$snaps = "$snap1";
	}

	my $sourcessh;
	if ($sourcehost ne '') { $sourcessh = "$sshcmd $sourcehost"; } else { $sourcessh = ''; }

	my $getsendsizecmd = "$sourcessh $mysudocmd $zfscmd send -nP $snaps";
	if ($debug) { print "DEBUG: getting estimated transfer size from source $sourcehost using \"$getsendsizecmd 2>&1 |\"...\n"; }

	open FH, "$getsendsizecmd 2>&1 |";
	my @rawsize = <FH>;
	close FH;
	my $exit = $?;

	# process sendsize: last line of multi-line output is
	# size of proposed xfer in bytes, but we need to remove
	# human-readable crap from it
	my $sendsize = pop(@rawsize);
	$sendsize =~ s/^size\s*//;
	chomp $sendsize;

	# to avoid confusion with a zero size pv, give sendsize
	# a minimum 4K value - or if empty, make sure it reads UNKNOWN
	if ($debug) { print "DEBUG: sendsize = $sendsize\n"; }
	if ($sendsize eq '' || $exit != 0) {
		$sendsize = '0';
	} elsif ($sendsize < 4096) {
		$sendsize = 4096;
	}
	return $sendsize;
}

sub getdate {
	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
	$year += 1900;
	my %date;
	$date{'unix'} = (((((((($year - 1971) * 365) + $yday) * 24) + $hour) * 60) + $min) * 60) + $sec;
	$date{'year'} = $year;
	$date{'sec'} = sprintf ("%02u", $sec);
	$date{'min'} = sprintf ("%02u", $min);
	$date{'hour'} = sprintf ("%02u", $hour);
	$date{'mday'} = sprintf ("%02u", $mday);
	$date{'mon'} = sprintf ("%02u", ($mon + 1));
	$date{'stamp'} = "$date{'year'}-$date{'mon'}-$date{'mday'}:$date{'hour'}:$date{'min'}:$date{'sec'}";
	return %date;
}

__END__

=head1 NAME

syncoid - ZFS snapshot replication tool

=head1 SYNOPSIS

 syncoid [options]... SOURCE TARGET
 or   syncoid [options]... SOURCE [USER@]HOST:TARGET
 or   syncoid [options]... [USER@]HOST:SOURCE [TARGET]
 or   syncoid [options]... [USER@]HOST:SOURCE [USER@]HOST:TARGET

 SOURCE                Source ZFS dataset. Can be either local or remote
 TARGET                Target ZFS dataset. Can be either local or remote

Options:

  --compress=FORMAT     Compresses data during transfer. Currently accepted options are gzip, pigz-fast, pigz-slow, lzo (default) & none
  --recursive|r         Also transfers child datasets
  --source-bwlimit=<limit k|m|g|t>  Bandwidth limit on the source transfer
  --target-bwlimit=<limit k|m|g|t>  Bandwidth limit on the target transfer
  --no-stream           Replicates using newest snapshot instead of intermediates
  --no-sync-snap        Does not create new snapshot, only transfers existing

  --sshkey=FILE         Specifies a ssh public key to use to connect
  --sshport=PORT        Connects to remote on a particular port
  --sshcipher|c=CIPHER  Passes CIPHER to ssh to use a particular cipher set
  --sshoption|o=OPTION  Passes OPTION to ssh for remote usage. Can be specified multiple times

  --help                Prints this helptext
  --verbose             Prints the version number
  --debug               Prints out a lot of additional information during a syncoid run
  --monitor-version     Currently does nothing
  --quiet               Suppresses non-error output
  --dumpsnaps           Dumps a list of snapshots during the run
  --no-command-checks   Do not check command existence before attempting transfer. Not recommended