Revision 267

Date:
2011/09/05 22:02:00
Author:
dpavlin
Revision Log:
replicate all filesystems and snapshots to another machine
Files:

Legend:

 
Added
 
Removed
 
Modified
  • 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
    9 my $arh = Net::OpenSSH->new('root@10.60.0.204');
    10 my $dev = Net::OpenSSH->new('root@10.60.0.202');
    11
    12 sub on {
    13 my ($ssh,$command) = @_;
    14 warn "## ", $ssh->get_host, "> $command\n";
    15 if ( $command =~ m/zfs list/ ) {
    16 map {
    17 chomp; $_;
    18 } $ssh->capture($command);
    19 } else {
    20 $ssh->capture($command);
    21 }
    22 }
    23
    24 print on $arh => 'zpool status';
    25 print on $dev => 'zpool status';
    26
    27 my @arh = on $arh => 'zfs list -H -o name';
    28 my @dev = on $dev => 'zfs list -H -o name';
    29
    30 warn "# ",dump( \@arh, \@dev );
    31
    32 my $from_pool = $arh[0];
    33 my $to_pool = $dev[0];
    34
    35 sub snapshots_from {
    36 my ($ssh) = @_;
    37 my $host = $ssh->get_host;
    38
    39 my $snapshot;
    40
    41 my @snapshots = on $ssh => 'zfs list -H -t snapshot -o name';
    42 die $ssh->error if $ssh->error;
    43 foreach my $s (@snapshots) {
    44 my ($fs,$name) = split(/\@/,$s);
    45 push @{ $snapshot->{$fs} }, $name;
    46 }
    47
    48 warn "snapshots_from $host ",dump($snapshot),$/;
    49
    50 return $snapshot;
    51 }
    52
    53 foreach my $fs ( @arh ) {
    54
    55 my $name = $fs;
    56 $name =~ s{^$from_pool/}{} || next; # FIXME skip top-level fs
    57 warn "? $name";
    58
    59 my $arh_snapshot = snapshots_from $arh;
    60 if ( ! exists( $arh_snapshot->{$fs} ) ) {
    61
    62 my $snapshot = $fs . '@send';
    63 print on $arh => "zfs snapshot $snapshot";
    64 die $arh->error if $arh->error;
    65 $arh_snapshot = snapshots_from $arh;
    66 }
    67
    68 my $max_snapshot = $#{ $arh_snapshot->{$fs} };
    69 warn "$max_snapshot snapshots of $fs on arh\n";
    70
    71 my $to_dev = "$to_pool/$name";
    72
    73 foreach my $i ( 0 .. $max_snapshot ) {
    74 my $snap = $arh_snapshot->{$fs}->[$i] || die "no snap";
    75
    76 my $dev_snapshot = snapshots_from $dev;
    77 if ( exists $dev_snapshot->{$to_dev} ) {
    78 if ( first { /^\Q$snap\E$/ } @{ $dev_snapshot->{$to_dev} } ) {
    79 warn "+ $name exists\n";
    80 next;
    81 } else {
    82 warn "- $name missing\n";
    83 }
    84 } else {
    85 warn "$name not found on target yet";
    86 }
    87
    88 my $snapshot;
    89 if ( $i == 0 ) {
    90 $snapshot = "$from_pool/$name\@$snap";
    91 } else {
    92 my $prev = $arh_snapshot->{$fs}->[$i-1] || die "no prev";
    93 $snapshot = "-i $from_pool/$name\@$prev $from_pool/$name\@$snap";
    94 }
    95
    96 warn "zfs transfer $snapshot -> $to_dev";
    97
    98 my $t = time();
    99
    100 my $recv = "nc -w 5 -l -p 8888 | zfs receive $to_dev";
    101 warn ">> $recv\n";
    102 my ($rin1,$pid1) = $dev->pipe_in($recv);
    103 warn ">> pid: $pid1";
    104
    105 my $send = "zfs send $snapshot | nc -q 0 -w 5 10.60.0.202 8888";
    106 warn "<< $send\n";
    107 $arh->system($send);
    108
    109 $t = time() - $t;
    110 warn "took $t seconds to complete\n";
    111
    112 $dev->system("zfs set readonly=on $to_pool/$name") if $i == 0;
    113 die $dev->error if $dev->error;
    114
    115 }
    116
    117 }