Rev 170 | Blame | Compare with Previous | Last modification | View Log | Download | RSS feed
#! /usr/bin/env perl
use strict;
use warnings;
use Data::Dumper;
my $source = shift;
my $target = shift;
die "Usage: replicate source target\n" unless $source && $target;
my $dryRun = 1; # if set, will only display the command to be executed
my $config = {
# compile the regex
'pattern' => qr/(\d{4}.\d{2}.\d{2}.\d{2}.\d{2})/
};
sub parseDataSet {
my $data = shift;
my %return;
my ( $server, $dataset ) = split( ':', $data );
if ( $dataset ) { # they passed a server:dataset
$return{'server'} = $server;
$return{'dataset'} = $dataset;
} else { # only passing in dataset, so assume localhost
$return{'server'} = '';
$return{'dataset'} = $server;
}
return \%return;
}
# runs a command, redirecting stderr to stdout (which it ignores)
# then returns 0 and $output on success.
# if error, returns error code and string describing error
sub run {
my $command = shift;
my $output = qx/$command 2>&1/;
if ($? == -1) {
return (-1,"failed to execute: $!");
} elsif ($? & 127) {
return ($?, sprintf "child died with signal %d, %s coredump",
($? & 127), ($? & 128) ? 'with' : 'without' );
} else {
return ($? >> 8, sprintf "child exited with value %d", $? >> 8 ) if $? >> 8;
}
return (0,$output);
}
sub getSnaps {
my ($config,$pattern) = @_;
my %return;
# actual command to run to get all snapshots, recursively, of the dataset
my $command = 'zfs list -r -t snap ' . $config->{'dataset'};
$command = "ssh $config->{server} '$command'" if $config->{'server'};
#die "$command\n";
my ($error, $output ) = &run( $command );
#die "Error running $command with output\n$output" if $error;
my @snaps = split( "\n", $output );
chomp @snaps;
for (my $i = 0; $i < @snaps; $i++ ) {
# parse out the space delmited fields
my ($fullname, $used, $avail, $refer, $mount) = split( /\s+/, $snaps[$i] );
# break the name into dataset and snapname
my ($dataset, $snap) = split( '@', $fullname );
# remove the root dataset name
$dataset =~ s/^$config->{'dataset'}//;
# skip anything not matching our regex
next unless $pattern && $snap && $snap =~ m/$pattern/;
# grab the matched key
$return{$dataset}{'snaps'}{$snap}{'key'} = $1;
# and remove all non-numerics
$return{$dataset}{'snaps'}{$snap}{'key'} =~ s/[^0-9]//g;
# get the transfer size
$return{$dataset}{'snaps'}{$snap}{'refer'} = $refer;
# get the actual disk space used
$return{$dataset}{'snaps'}{$snap}{'used'} = $used;
}
return \%return;
}
sub diffSnaps {
my ( $source, $target ) = @_;
my @source = sort keys %$source;
my @target = sort keys %$target;
# print "===Source\n" . join( "\n", @source ) . "\n===Target\n" . join( "\n", @target ) . "\n";
my $s = 0;
my $t = 0;
my %return;
$return{'deleteTarget'} = [];
$return{'addTarget'} = [];
$return{'lastMatch'} = 0;
$return{'finalSync'} = 0;
while ( $s < @source && $t < @target ) {
if ( $source[$s] eq $target[$t] ) { # matchies, just keep going
# print "Source $s [$source[$s]] matches target $t [$target[$t]]\n";
$return{'lastMatch'} = $source[$s]; # keep track of the largest match
$s++; $t++;
} elsif ( $target[$t] ne $source[$s] ) { # we are processing stuff that needs to be deleted on target
push @{$return{'deleteTarget'}}, $target[$t];
# print "Adding delete target $t [$target[$t]]\n";
$t++;
}
}
die "Could not reconcile snapshots, ran out of source too soon\n" if $s > @source;
# put a value into finalSync to make sure there is one. If we do not have any sync
# to do, final and lastMatch will be the same
$return{'finalSync'} = $return{'lastMatch'};
while ( $s < @source ) {
push @{$return{'addTarget'}}, $source[$s];
$return{'finalSync'} = $source[$s];
$s++;
}
# die Dumper( \%return );
return \%return;
}
sub arrayEquals {
my ($a, $b ) = @_;
return 0 unless @{$a} == @{$b}; # they are different sizes
for ( my $i = 0; $i < @$a; $i++ ) {
if ( $$a[$i] ne $$b[$i] ) {
print STDERR "No Match!\n" . join( "\t", @$a ) . "\n" . join( "\t", @$b ) . "\n";
return 0;
}
}
return 1;
}
sub createCommands {
my ( $source, $target, $config ) = @_;
my @return;
# check for new snapshots to sync
if ( $source ne $target ) {
# first create the replicate command. The send command request recursion (-R)
# and the range of snapshots including all intermediate ones (-I)
my $sourceCommand = 'zfs send -RI ';
$sourceCommand .= $config->{'source'}->{'dataset'} . '@' . $target . ' ';
$sourceCommand .= $config->{'source'}->{'dataset'} . '@' . $source;
$sourceCommand = "ssh $config->{source}->{server} '$sourceCommand'" if $config->{'source'}->{'server'};
my $targetCommand = 'zfs receive -v ';
$targetCommand .= $config->{'target'}->{'dataset'};
$targetCommand = "ssh $config->{target}->{server} '$sourceCommand'" if $config->{'target'}->{'server'};
push @return, $sourceCommand . ' | ' . $targetCommand;
} else {
push @return, '# Nothing new to sync';
}
# now, check for snapshots to remove
#if ( $config->{'actions'}->{'deleteTarget'} ) {
# my $delete = $config->{'actions'}->{'deleteTarget'};
# foreach my $ds ( @$delete ) {
# push @return, "zfs destroy -r $config->{target}->{'dataset'}\@$ds";
# }
#} else {
# push @return, "# No old snapshots to be removed";
#}
return \@return;
}
# find the last snapshot in a hash. The hash is assumed to have a subkey
# 'key'. look for the largest subkey, and return the key for it
sub getLastSnapshot {
my $snapList = shift;
my $lastKey = 0;
my $lastSnap = '';
foreach my $snap ( keys %$snapList ) {
if ( $snapList->{$snap}->{'key'} > $lastKey ) {
$lastKey = $snapList->{$snap}->{'key'};
$lastSnap = $snap;
}
}
return $lastSnap;
}
sub calculate {
my $config = shift;
my @warnings;
# find the last snapshot date in each dataset, on each target
foreach my $machine ( 'source', 'target' ) {
$config->{$machine}->{'last'} = 0; # track the last entry in all children in dataset
$config->{$machine}->{'allOk'} = 1; # assumed to be true, becomes false if some children do not have snapshots
foreach my $child ( keys %{ $config->{$machine}->{'snapshots'} } ) {
$config->{$machine}->{'snapshots'}->{$child}->{'last'} =
&getLastSnapshot( $config->{$machine}->{'snapshots'}->{$child}->{'snaps'} );
# set the machine last if we haven't done so yet
$config->{$machine}->{'last'} = $config->{$machine}->{'snapshots'}->{$child}->{'last'} unless $config->{$machine}->{'last'};
# keep track of the last snapshot for each set
if ( $config->{$machine}->{'last'} ne $config->{$machine}->{'snapshots'}->{$child}->{'last'} ) {
$config->{$machine}->{'allOk'} = 0;
push @warnings, "Warning: $machine does not have consistent snapshots at $child";;
}
}
}
# make sure the source has a corresponding snap for target->last
foreach my $child ( keys %{ $config->{'target'}->{'snapshots'} } ) {
if (! exists ($config->{'source'}->{'snapshots'}->{$child}->{'snaps'}->{$config->{'target'}->{'snapshots'}->{$child}->{'last'}} ) ) {
$config->{'source'}->{'allOk'} = 0;
push @warnings, "Warning: We do not have consistent snapshots";
}
}
my $return;
if ( $config->{'source'}->{'allOk'} and $config->{'target'}->{'allOk'} ) { # whew, they match
return( $config->{'source'}->{'last'}, $config->{'target'}->{'last'}, \@warnings );
} else {
return( '','',\@warnings);
}
}
$config->{'source'} = &parseDataSet( $source );
$config->{'target'} = &parseDataSet( $target );
# both source and target can not have a server portion; one must be local
die "Source and Target can not both be remote\n" if $config->{'source'}->{'server'} && $config->{'target'}->{'server'};
$config->{'source'}->{'snapshots'} = &getSnaps( $config->{'source'}, $config->{'pattern'} );
$config->{'target'}->{'snapshots'} = &getSnaps( $config->{'target'}, $config->{'pattern'} );
# $config->{'actions'} = &calculate( $config );
my ( $lastSource, $lastTarget ) = &calculate( $config );
#print Dumper( $config ) . "\nSource = $lastSource\nTarget = $lastTarget\n"; die;
my $commands = &createCommands( $lastSource, $lastTarget, $config );
for ( my $i = 0; $i < @{$commands}; $i++ ) {
print "$$commands[$i]\n";
if ( $dryRun ) {
print "Dry Run\n";
} else {
print qx/$$commands[$i]/ if $$commands[$i] =~ m/^[a-zA-Z]/;
}
}
#print Dumper( $config );
1;