git.rot13.org Git - sysadmin-cookbook/blob - recepies/zfs/zfs-replicate-pool.pl

   1 #!/usr/bin/perl
   2 use warnings;
   3 use strict;
   4
   5 use Net::OpenSSH;
   6 use Data::Dump qw(dump);
   7 use List::Util qw(first);
   8 use Time::HiRes;
   9
  10 my $compress = '| lzop -c';
  11 my $decompress = 'lzop -d |';
  12
  13 my $arh = Net::OpenSSH->new('root@10.60.0.204');
  14 my $dev = Net::OpenSSH->new('root@10.60.0.202');
  15
  16 sub on {
  17         my ($ssh,$command) = @_;
  18         warn "## ", $ssh->get_host, "> $command\n" if $ENV{DEBUG};
  19         if ( $command =~ m/zfs list/ ) {
  20                 map {
  21                         chomp; $_;
  22                 } $ssh->capture($command);
  23         } else {
  24                 $ssh->capture($command);
  25         }
  26 }
  27
  28 print on $arh => 'zpool status';
  29 print on $dev => 'zpool status';
  30
  31 my @arh = on $arh => 'zfs list -H -o name';
  32 my @dev = on $dev => 'zfs list -H -o name';
  33
  34 warn "# ",dump( \@arh, \@dev );
  35
  36 my $from_pool = $arh[0];
  37 my $to_pool   = $dev[0];
  38
  39 sub snapshots_from {
  40         my ($ssh) = @_;
  41         my $host = $ssh->get_host;
  42
  43         my $snapshot;
  44
  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;
  50         }
  51
  52 #       warn "snapshots_from $host ",dump($snapshot),$/;
  53
  54         return $snapshot;
  55 }
  56
  57 foreach my $fs ( @arh ) {
  58
  59         my $name = $fs;
  60         $name =~ s{^$from_pool/}{} || next; # FIXME skip top-level fs
  61         warn "? $name";
  62
  63         my $arh_snapshot = snapshots_from $arh;
  64         if ( ! exists( $arh_snapshot->{$fs} ) ) {
  65
  66                 my $snapshot = $fs . '@send';
  67                 print on $arh => "zfs snapshot $snapshot";
  68                 die $arh->error if $arh->error;
  69                 $arh_snapshot = snapshots_from $arh;
  70         }
  71
  72         my $max_snapshot = $#{ $arh_snapshot->{$fs} };
  73         warn "$fs has ",$max_snapshot+1," snapshots\n";
  74
  75         my $to_dev = "$to_pool/$name";
  76
  77         foreach my $i ( 0 .. $max_snapshot ) {
  78                 my $snap = $arh_snapshot->{$fs}->[$i] || die "no snap";
  79
  80                 my $dev_snapshot = snapshots_from $dev;
  81                 if ( exists $dev_snapshot->{$to_dev} ) {
  82                         if ( first { /^\Q$snap\E$/ } @{ $dev_snapshot->{$to_dev} } ) {
  83                                 warn "+ $name @ $snap exists\n";
  84                                 next;
  85                         } else {
  86                                 warn "- $name @ $snap missing\n";
  87                         }
  88                 } else {
  89                         warn "$name not found on target yet";
  90                 }
  91
  92                 my $snapshot;
  93                 if ( $i == 0 ) {
  94                         $snapshot = "$from_pool/$name\@$snap";
  95                 } else {
  96                         my $prev = $arh_snapshot->{$fs}->[$i-1] || die "no prev";
  97                         $snapshot = "-i $from_pool/$name\@$prev $from_pool/$name\@$snap";
  98                 }
  99
 100                 warn "zfs transfer $snapshot -> $to_dev\n";
 101
 102                 my $t = time();
 103
 104                 my $recv = "nc -w 3 -l -p 8888 | $decompress zfs receive $to_dev";
 105                 warn ">> $recv\n";
 106                 my ($rin1,$pid1) = $dev->pipe_in($recv);
 107                 warn ">> pid: $pid1";
 108
 109                 sleep 1; # FIXME wait for netcat to start
 110
 111                 my $send = "zfs send $snapshot $compress | nc -q 0 -w 2 10.60.0.202 8888";
 112                 warn "<< $send\n";
 113                 $arh->system($send);
 114                 die $arh->error if $arh->error;
 115
 116                 $t = time() - $t;
 117                 warn "took $t seconds to complete\n";
 118
 119                 $dev->system("zfs set readonly=on $to_pool/$name") if $i == 0;
 120                 warn "ERROR: ",$dev->error if $dev->error;
 121
 122                 sleep 1;
 123                 $dev_snapshot = snapshots_from $dev;
 124                 die "can't find new snapshot $snap" unless $dev_snapshot->{$to_dev};
 125
 126         }
 127
 128 }