#! /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 = 0; # if set, will only display the command to be executed

my $config = {
   # compile the regex
   'pattern' => qr/auto-\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'};
   my ($error, $output ) = &run( $command );
   die $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/;
      $return{$dataset}{'snaps'}{$snap}{'refer'} = $refer;
      $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 $config = shift;
   my @return;
   # check for new snapshots to sync
   if ( $config->{'actions'}->{'lastMatch'} ne $config->{'actions'}->{'finalSync'} ) {
      # 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'} . '@' . $config->{'actions'}->{'lastMatch'} . ' ';
      $sourceCommand .= $config->{'source'}->{'dataset'} . '@' . $config->{'actions'}->{'finalSync'};
      $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;
}
   


sub calculate {
   my $config = shift;
   my $return;
   my $allMatch;
   my $lastMatch;
   foreach my $dataset ( sort keys %{$config->{'source'}->{'snapshots'}} ) {
      next unless exists $config->{'source'}->{'snapshots'}->{$dataset};
      die "No matching target for $dataset\n" unless $config->{'target'}->{'snapshots'}->{$dataset};
      $return->{$dataset} = &diffSnaps( 
         $config->{'source'}->{'snapshots'}->{$dataset}->{'snaps'},
         $config->{'target'}->{'snapshots'}->{$dataset}->{'snaps'}
      );
      $allMatch = $return->{$dataset} unless $allMatch;
#      die Dumper( $allMatch ) . "\n";
      next;
      unless ( 
         &arrayEquals( $return->{'allMatch'}->{'deleteTarget'}, $return->{$dataset}->{'deleteTarget'} ) &&
         &arrayEquals( $return->{'allMatch'}->{'addTarget'},    $return->{$dataset}->{'addTarget'} )
         ) {
         warn "Warning: dataset $dataset does not match\n";
         last;
      }
   }
   #print Dumper( $allMatch );
   $return->{'lastMatch'} = $allMatch->{'lastMatch'};
   $return->{'finalSync'} = $allMatch->{'finalSync'};
#   die Dumper( $allMatch->{'deleteTarget'} ) . "\n" ;
   $return->{'deleteTarget'} = $allMatch->{'deleteTarget'};
#   print Dumper( $return ) . "\n"; die;
   return $return;
   #print Dumper( $return ) . "\n"; die;
}

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

#print Dumper( $config ); die;

my $commands = &createCommands( $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;