#!/usr/bin/perl
use warnings;
use strict;

use Net::OpenSSH;
use Data::Dump qw(dump);
use List::Util qw(first);
use Time::HiRes;

my $compress = '| lzop -c';
my $decompress = 'lzop -d |';

my $from = Net::OpenSSH->new('root@10.60.0.90');
my $to = Net::OpenSSH->new('root@10.60.0.202');

sub on {
	my ($ssh,$command) = @_;
	warn "## ", $ssh->get_host, "> $command\n" if $ENV{DEBUG};
	if ( $command =~ m/zfs list/ ) {
		map {
			chomp; $_;
		} $ssh->capture($command);
	} else {
		$ssh->capture($command);
	}
}

print on $from => 'zpool status';
print on $to => 'zpool status';

my @from = on $from => 'zfs list -H -o name';
my @to = on $to => 'zfs list -H -o name';

warn "# ",dump( \@from, \@to );

my $from_pool = $from[0];
my $to_pool   = $to[0];

sub snapshots_from {
	my ($ssh) = @_;
	my $host = $ssh->get_host;

	my $snapshot;

	my @snapshots = on $ssh => 'zfs list -H -t snapshot -o name';
	die $ssh->error if $ssh->error;
	foreach my $s (@snapshots) {
		my ($fs,$name) = split(/\@/,$s);
		push @{ $snapshot->{$fs} }, $name;
	}

#	warn "snapshots_from $host ",dump($snapshot),$/;

	return $snapshot;
}

foreach my $fs ( @from ) {

	my $name = $fs;
	$name =~ s{^$from_pool/}{} || next; # FIXME skip top-level fs
	warn "? $name";

	my $from_snapshot = snapshots_from $from;
	if ( ! exists( $from_snapshot->{$fs} ) ) {

		my $snapshot = $fs . '@send';
		print on $from => "zfs snapshot $snapshot";
		die $from->error if $from->error;
		$from_snapshot = snapshots_from $from;
	}

	my $max_snapshot = $#{ $from_snapshot->{$fs} };
	warn "$fs has ",$max_snapshot+1," snapshots\n";

	my $to_to = "$to_pool/$name";

	foreach my $i ( 0 .. $max_snapshot ) {
		my $snap = $from_snapshot->{$fs}->[$i] || die "no snap";

		my $to_snapshot = snapshots_from $to;
		if ( exists $to_snapshot->{$to_to} ) {
			if ( first { /^\Q$snap\E$/ } @{ $to_snapshot->{$to_to} } ) {
				warn "+ $name @ $snap exists\n";
				next;
			} else {
				warn "- $name @ $snap missing\n";
			}
		} else {
			warn "$name not found on target yet";
		}

		my $snapshot;
		if ( $i == 0 ) {
			$snapshot = "$from_pool/$name\@$snap";
		} else {
			my $prev = $from_snapshot->{$fs}->[$i-1] || die "no prev";
			$snapshot = "-i $from_pool/$name\@$prev $from_pool/$name\@$snap";
		}

		warn "zfs transfer $snapshot -> $to_to\n";

		my $t = time();

		my $recv = "nc -w 3 -l -p 8888 | $decompress zfs receive $to_to";
		warn ">> $recv\n";
		my ($rin1,$pid1) = $to->pipe_in($recv);
		warn ">> pid: $pid1";

		sleep 1; # FIXME wait for netcat to start

		my $send = "zfs send $snapshot $compress | nc -q 0 -w 2 10.60.0.202 8888";
		warn "<< $send\n";
		$from->system($send);
		die $from->error if $from->error;

		$t = time() - $t;
		warn "took $t seconds to complete\n";

		$to->system("zfs set readonly=on $to_pool/$name") if $i == 0;
		warn "ERROR: ",$to->error if $to->error;

		sleep 1;
		$to_snapshot = snapshots_from $to;
		die "can't find new snapshot $snap" unless $to_snapshot->{$to_to};

	}

}	
