Subversion Repositories zfs_utils

#! /usr/bin/env perl

# very simple script to replicate a ZFS snapshot to another server.

# no fancy bells and whistles, does not create snapshots, and does

# not prune them. No major error checking either

use strict;

use warnings;

use Data::Dumper;

use Getopt::Long;

Getopt::Long::Configure ("bundling");

# create our configuration, with some defaults

# these are overridden by command line stuff

my $config = {

   # the source, where we're coming from

   'source' => '',

   # the target, where we want to replicate to

   'target' => '',

   # compile the regex

   'filter' => qr/(\d{4}.\d{2}.\d{2}.\d{2}.\d{2})/,

   # if non-zero, just display the commands we'd use, don't run them

   'dryrun' => 0,

   # whether to do all child datasets also (default)

   'recurse' => 1,

   # show more information

   'verbose' => 0

   };

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 ( $config->{'source'}, $config->{'target'} ) = @_;

#   my @source = sort keys %$config->{'source'};

#   my @target = sort keys %$config->{'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 ( $config->{'source'}[$s] eq $config->{'target'}[$t] ) { # matchies, just keep going

#         print "Source $s [$config->{'source'}[$s]] matches target $t [$config->{'target'}[$t]]\n";

#         $return{'lastMatch'} = $config->{'source'}[$s]; # keep track of the largest match

#         $s++; $t++;

#      } elsif ( $config->{'target'}[$t] ne $config->{'source'}[$s] ) { # we are processing stuff that needs to be deleted on target

#         push @{$return{'deleteTarget'}}, $config->{'target'}[$t];

#         print "Adding delete target $t [$config->{'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'}}, $config->{'source'}[$s];

#      $return{'finalSync'} = $config->{'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 ( $config->{'source'}, $config->{'target'}, $config ) = @_;

   my @return;

   # check for new snapshots to sync

   if ( $config->{'source'} ne $config->{'target'} ) {

      # first create the replicate command. The send command request recursion (-R)

      # and the range of snapshots including all intermediate ones (-I)

      my $config->{'source'}Command = 'zfs send -RI ';

      $config->{'source'}Command .= $config->{'source'}->{'dataset'} . '@' . $config->{'target'} . ' ';

      $config->{'source'}Command .= $config->{'source'}->{'dataset'} . '@' . $config->{'source'};

      $config->{'source'}Command = "ssh $config->{source}->{server} '$config->{'source'}Command'" if $config->{'source'}->{'server'};

      my $config->{'target'}Command = 'zfs receive -v ';

      $config->{'target'}Command .= $config->{'target'}->{'dataset'};

      $config->{'target'}Command = "ssh $config->{target}->{server} '$config->{'source'}Command'" if $config->{'target'}->{'server'};

      push @return, $config->{'source'}Command . ' | ' . $config->{'target'}Command;

   } 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);

   }

} # sub calculate

GetOptions( $config,

   'source|s=s',

   'target|t=s',

   'filter|f=s',

   'dryrun|n',

   'recurse|r',

   'verbose|v',

   'help|h'

);

# allow them to use positional, without flags, such as

# replicate source target --filter='regex' -n

$config->{'source'} = shift unless $config->{'source'};

$config->{'target'} = shift unless $config->{'target'};

die "You must enter a source and a target, at a minimum\n" unless $config->{'source'} && $config->{'target'};

# WARNING: this converts source and targets from a string to a hash

# '10.0.0.1:data/set' becomes ( 'server' => '10.0.0.1', 'dataset' => 'data/set')

# and 'data/set' becomes ( 'server' => '', 'dataset' => 'data/set')

$config->{'source'} = &parseDataSet( $config->{'source'} );

$config->{'target'} = &parseDataSet( $config->{'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->{'filter'} );

$config->{'target'}->{'snapshots'} = &getSnaps( $config->{'target'}, $config->{'filter'} );

# we sync from last snap on target machine to last snap on source machine

my ( $lastSource, $lastTarget ) = &calculate( $config );

#print Dumper( $config ) . "\nSource = $lastSource\nTarget = $lastTarget\n"; die;

# actually creates the commands to do the replicate

my $commands = &createCommands( $lastSource, $lastTarget, $config );

for ( my $i = 0; $i < @{$commands}; $i++ ) {

   print "$$commands[$i]\n" if $config->{'verbose'} or $config->{'dryrun'};

   if ( $config->{'dryrun'} ) {

      print "Dry Run\n";

   } else {

      print qx/$$commands[$i]/ if $$commands[$i] =~ m/^[a-zA-Z]/;

   }

}

#print Dumper( $config );

1;