6 use Data::Dump qw(dump);
7 use List::Util qw(first);
10 my $compress = '| lzop -c';
11 my $decompress = 'lzop -d |';
13 my $from = Net::OpenSSH->new('root@10.60.0.90');
14 my $to = Net::OpenSSH->new('root@10.60.0.202');
17 my ($ssh,$command) = @_;
18 warn "## ", $ssh->get_host, "> $command\n" if $ENV{DEBUG};
19 if ( $command =~ m/zfs list/ ) {
22 } $ssh->capture($command);
24 $ssh->capture($command);
28 print on $from => 'zpool status';
29 print on $to => 'zpool status';
31 my @from = on $from => 'zfs list -H -o name';
32 my @to = on $to => 'zfs list -H -o name';
34 warn "# ",dump( \@from, \@to );
36 my $from_pool = $from[0];
41 my $host = $ssh->get_host;
45 my @snapshots = on $ssh => 'zfs list -H -t snapshot -o name';
46 die $ssh->error if $ssh->error;
47 foreach my $s (@snapshots) {
48 my ($fs,$name) = split(/\@/,$s);
49 push @{ $snapshot->{$fs} }, $name;
52 # warn "snapshots_from $host ",dump($snapshot),$/;
57 foreach my $fs ( @from ) {
60 $name =~ s{^$from_pool/}{} || next; # FIXME skip top-level fs
63 my $from_snapshot = snapshots_from $from;
64 if ( ! exists( $from_snapshot->{$fs} ) ) {
66 my $snapshot = $fs . '@send';
67 print on $from => "zfs snapshot $snapshot";
68 die $from->error if $from->error;
69 $from_snapshot = snapshots_from $from;
72 my $max_snapshot = $#{ $from_snapshot->{$fs} };
73 warn "$fs has ",$max_snapshot+1," snapshots\n";
75 my $to_to = "$to_pool/$name";
77 foreach my $i ( 0 .. $max_snapshot ) {
78 my $snap = $from_snapshot->{$fs}->[$i] || die "no snap";
80 my $to_snapshot = snapshots_from $to;
81 if ( exists $to_snapshot->{$to_to} ) {
82 if ( first { /^\Q$snap\E$/ } @{ $to_snapshot->{$to_to} } ) {
83 warn "+ $name @ $snap exists\n";
86 warn "- $name @ $snap missing\n";
89 warn "$name not found on target yet";
94 $snapshot = "$from_pool/$name\@$snap";
96 my $prev = $from_snapshot->{$fs}->[$i-1] || die "no prev";
97 $snapshot = "-i $from_pool/$name\@$prev $from_pool/$name\@$snap";
100 warn "zfs transfer $snapshot -> $to_to\n";
104 my $recv = "nc -w 3 -l -p 8888 | $decompress zfs receive $to_to";
106 my ($rin1,$pid1) = $to->pipe_in($recv);
107 warn ">> pid: $pid1";
109 sleep 1; # FIXME wait for netcat to start
111 my $send = "zfs send $snapshot $compress | nc -q 0 -w 2 10.60.0.202 8888";
113 $from->system($send);
114 die $from->error if $from->error;
117 warn "took $t seconds to complete\n";
119 $to->system("zfs set readonly=on $to_pool/$name") if $i == 0;
120 warn "ERROR: ",$to->error if $to->error;
123 $to_snapshot = snapshots_from $to;
124 die "can't find new snapshot $snap" unless $to_snapshot->{$to_to};