#! /usr/bin/env perl

use strict;
use warnings;


BEGIN {
   use FindBin;
   use File::Spec;
   # use libraries from the directory this script is in
   use Cwd 'abs_path';
   use File::Basename;
   use lib dirname( abs_path( __FILE__ ) );
}

use YAML::Tiny; # pkg install p5-YAML-Tiny-1.74
use Data::Dumper;

my $cwd = $FindBin::RealBin;
my $configFileName = $cwd . '/sync.yaml';
my $replicateScript = $cwd . '/replicate';

my $configuration;
   

# load Configuration File
# read the config file and return it
sub readConfig {
   my $filename = shift;
   die "Config file $filename not found: $!" unless -f $filename;
   my $yaml = YAML::Tiny->new( {} );
   if ( -f $filename ) {
      $yaml = YAML::Tiny->read( $filename );
   }
   return $yaml->[0];
}

sub logit {
   open LOG, ">>/tmp/replicate.log" or die "Could not open replicate.log: $!\n";
   print LOG join( "\n", @_ ) . "\n";
   close LOG;
}


# this calls gshred which will overwrite the file 3 times, then
# remove it.
# NOTE: this will not work on ZFS, since ZFS is CopyOnWrite (COW)
# so assuming file is on a ramdisk
sub shredFile {
   my $filename = shift;
   if ( `which gshred` ) {
      `/usr/local/bin/gshred -u -f $filename`;
   } else {
      warn "gshred not installed, simply deleting $filename\n";
      unlink $filename;
   }
}


# runs a command, redirecting stderr to stdout (which it ignores)
# then returns 0 on success.
# if error, returns string describing error
sub runCommand {
   my $command = shift;
   #logit( $command );
   my $output = qx/$command 2>&1/;
   if ($? == -1) {
      return (-1, "failed to execute: $!" );
   } elsif ($? & 127) {
      return (-1,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);
}

# Checks if a zpool is available. If not, retrieves the geli key from a remote server,
# decrypts the drives, and mounts the zpool.
# Params:
#   $zpool         - Name of the zpool
#   $local_key     - Local path to store the geli key
#   $remote_server - Remote server to fetch the key from (user@host)
#   $remote_key    - Path to the geli key on the remote server
#   $drives_ref    - Arrayref of drives to decrypt (e.g., ['/dev/ada0p3', '/dev/ada1p3'])
sub mountGeliZpool {
    my ($zpool, $local_key, $remote_server, $remote_key, $drives_ref) = @_;

    # Check if the zpool is available
    my ($error, $output) = runCommand("zpool list $zpool");
    return 0 unless $error; # zpool is available

    #die "zpool=$zpool\nlocalKey=$local_key\nserver=$remote_server\nremotekey=$remote_key\n" . Dumper( $drives_ref ) . "\n";
    # Retrieve geli key from remote server
    ($error, $output) = runCommand("scp $remote_server:$remote_key $local_key");
    return ($error, "Failed to retrieve geli key from $remote_server:$remote_key" ) if $error;

    # Attach geli key to each drive
    foreach my $drive (@$drives_ref) {
        ($error, $output) = runCommand("geli attach -k $local_key -p $drive");
         return ($error, "Failed to attach geli key to $drive: $output" ) if $error;
    }

    # Import the zpool
    ($error, $output) = runCommand("zpool import $zpool");
    return ( $error, "Failed to import zpool $zpool: $output" ) if $error;

    # Optionally, mount all datasets in the zpool
    ($error, $output) = runCommand("zfs mount -a");
     return( $error,"Failed to mount datasets in zpool $zpool: $output" ) if $error;

    # Shred the key file after use
    shredFile($local_key) if -f $local_key;

    return 1;
}

# a very simple mailer, just send information to sendmail
sub sendMail {
   my ($message, $configuration, $subject ) = @_;
   if ( $message ) {
      open MAIL,"|sendmail -t" or die "Could not open sendmail: $!\n";
      print MAIL "To: $configuration->{email}->{notify}\n";
      print MAIL "From: $configuration->{email}->{from}\n";
      print MAIL "Subject: " . 
                 ($configuration->{'email'}->{'subject'} . ( $subject ? " - $subject" : '' ) ) .
                 "\n\n";
      print MAIL $message;
      close MAIL;
   } else {
      warn "no message in outgoing email\n";
   }
}

# checks to see if we should be in maintenance mode
# if $remoteMachine->{'maintenanceMode'} exists, set mode
# otherwise, wait localMachine->{'waittime'} minutes, then check
# $localMachine->{'maintenanceMode'}.
# if neither exists, begin sync
sub checkMaintenance {
   my $configuration = shift;
   #print "Target\t$configuration->{target}->{maintenanceFlag}\nSource\t$configuration->{'source'}->{'maintenanceFlag'}\nRemote\t$configuration->{source}->{server}\n";
   #print "Remote is: " . $configuration->{'source'}->{'up'} ? "up\n" : "down\n";

   return 0 unless # exit if maintenanceFlag has not been set at all
     ( defined( $configuration->{'target'}->{'maintenanceFlag'} ) && $configuration->{'target'}->{'maintenanceFlag'} ) ||
     ( defined( $configuration->{'source'}->{'maintenanceFlag'} ) && $configuration->{'source'}->{'maintenanceFlag'} );
   # see if maintenance is set on remote. If so, simply return the message
   if ( $configuration->{'source'}->{'up'} ) {
      #print "Checking for remote flag\n";
      my ($error, $output) = &runCommand( "ssh $configuration->{source}->{server} 'ls $configuration->{source}->{maintenanceFlag}'" );
      if ( ! $error ) {
         # remove the file from the remote server
         &runCommand( "ssh $configuration->{source}->{server} 'rm $configuration->{source}->{maintenanceFlag}'" );
         # create a valid return, which will exit the program
         return "Maintenance Flag found on remote machine";
      }
   }
   # not on remote machine, so give them waitTime seconds to put it here
   # we'll loop, checking every $sleepTime seconds until our wait time
   # ($configuration->{'target'}->{'waitTime'}) has expired
   #print "Did not find flag, checking local\n";
   my $sleepTime = 60; # time between checks
   # default one minute if waitTime not set
   $configuration->{'target'}->{'waitTime'} = 60 unless $configuration->{'target'}->{'waitTime'};
   for ( my $i = $configuration->{'target'}->{'waitTime'}; $i > 0; $i -= $sleepTime ) {
      sleep $sleepTime;
      # then look for the maintenance flag file on the local machine
      return "Maintenance Flag found on local machine" if -f $configuration->{'target'}->{'maintenanceFlag'};
   }
   # no maintenance flags found, so return false
   return 0;
}

sub shutdownMachine {
   my $configuration = shift;
   exit unless $configuration->{'shutdown'};
   # do not actually shut down the server unless we are told to
   &runCommand( "poweroff" ) unless $configuration->{'testing'};
}

# returns the current time as a string
sub currentTime {
   my $format = shift;
   # default to YY-MM-DD HH-MM-SS
   $format = '%Y-%m-%d %H:%M:%S' unless $format;
   use POSIX;
   return POSIX::strftime( $format, localtime() );
}

# verify a remote machine is up and running
sub checkRemoteUp {
   my $configuration = shift;
   my $ip;
   if ( defined( $configuration->{'target'}->{'server'} ) && $configuration->{'target'}->{'server'} ) {
      $ip = $configuration->{'target'}->{'server'};
   } else {
      $ip = $configuration->{'source'}->{'server'};
   }
   my ($error, $message ) =  $ip ? &runCommand( "ping -c 1 -t 5 $ip" ) : (0,'No address defined for either target or server' );
#   $message = "Checking IP $ip\n"  . $message;
   #die "error is $error, message is $message for $ip\n";
   return ($error, $message);
}

sub updateStats {
   my ( $label, $filename, $output ) = @_;
   if ( $output =~ m/bytes\t(\d+).*seconds\t(\d+)/gms ) { # global, multiline, . matches newlines
      my $seconds = $2;
      my $bytes = $1;
      open STATS,">>$filename" or warn "Could not create file $filename: $!\n";
      print STATS &currentTime('') . "\t$label\t$seconds\t$bytes\n";
      close STATS
   } else {
      warn "updateStats called with invalid report\n" if $configuration->{'verbose'}>1;
   }
}

my @status;   
my $error = 0;
my $output = '';

$configuration = &readConfig($configFileName);

# die Dumper( $configuration ) . "\n";

my $servername = `hostname`;
chomp $servername;

if ( $configuration->{'verbose'} > 1 ) {
   push @status, "Replication on $servername has been started at " . &currentTime();
   &sendMail( "Replication on $servername has been started, " . &currentTime(), $configuration, "Replication on $servername started" );
}

# see if remote machine is up by sending one ping. Expect response in 5 seconds
( $error,$output) = &checkRemoteUp( $configuration );
$configuration->{'source'}->{'up'} = ! $error;
push @status, "remote machine is " . ( $configuration->{'source'}->{'up'} ? 'Up' : 'Down' ) . "\n";
if ( ! $configuration->{'source'}->{'up'} ) {
   # we can not connect to the remote server, so just shut down
   sendMail( join( "\n", @status ), $configuration, "No connection to remote machine" );
   &shutdownMachine( $configuration );
}

# check for maintenance flags, exit if we should go into mainteance mode
if ( my $result = &checkMaintenance( $configuration ) ) {
   push @status,$result;
   &sendMail( join( "\n", @status), $configuration, "Maintenance Mode" );
   exit 1;
}

# die "Maintenance flag not found\n";

# if the zpool is encrypted with geli, make sure it is available
($error, $output) = &mountGeliZpool (
   $configuration->{'geli'}->{'zpool'},
   $configuration->{'geli'}->{'keyPath'},
   $configuration->{'geli'}->{'server'},
   $configuration->{'geli'}->{'remoteKeyPath'},
   [ split( /\s+/, $configuration->{'geli'}->{'drives'} ) ]
   ) 
   if exists ( $configuration->{'geli'} );
   
if ( $error) { # could not mount datasets
   push @status, $output;
   &sendMail( join( "\n", @status ), $configuration, "Mount Drive Error: [$output]" );
   &shutdownMachine( $configuration );
}

#&sendMail( "Backup has been started at " . &currentTime(), $configuration, "Backup Starting" );
push @status, &currentTime() . ' Backup started' if $configuration->{'verbose'};

$configuration->{'source'}->{'server'} = $configuration->{'source'}->{'server'} ? $configuration->{'source'}->{'server'} . ':' : '';
$configuration->{'target'}->{'server'} = $configuration->{'target'}->{'server'} ? $configuration->{'target'}->{'server'} . ':' : '';

my @flags;
push @flags, '--dryrun' if $configuration->{'dryrun'};
push @flags, '--recurse' if $configuration->{'recurse'};
push @flags, '-' . 'v'x$configuration->{verbose} if $configuration->{'verbose'};
push @flags, "--bwlimit=$configuration->{bandwidth}" if $configuration->{'bandwidth'};
push @flags, "--filter='$configuration->{filter}'" if $configuration->{'filter'};

# die join( ' ', @flags ) . "\n";

# prepend the current working directory to stats if it does not have a path
$configuration->{'stats'} = $cwd . "/" . $configuration->{'stats'}
   if $configuration->{'stats'} && $configuration->{'stats'} !~ m/\//;

# For each dataset, let's find the snapshots we need
foreach my $sourceDir ( keys %{$configuration->{'source'}->{'dataset'}} ) {
   print "Working on $sourceDir\n" if $configuration->{'testing'};
   print "Looking for $sourceDir\n" if $configuration->{'testing'} > 2;
   print "syncing to $configuration->{target}->{dataset}\n" if $configuration->{'testing'} > 2;
   my $command = $replicateScript . ' ' . join( ' ', @flags ) . ' ' .
                 '--source=' .
                 $configuration->{'source'}->{'server'} . 
                 $configuration->{'source'}->{'dataset'}->{$sourceDir} . '/' . $sourceDir . ' ' .
                 '--target=' .
                 $configuration->{'target'}->{'server'} . 
                 $configuration->{'target'}->{'dataset'} . '/' . $sourceDir;
   print "Command is $command\n" if $configuration->{'testing'};
   push @status, &currentTime() . " Running $command" if $configuration->{'verbose'} > 1;
   if ( ! $configuration->{'testing'} ) {
      ($error, $output) = &runCommand( $command );
      push @status, "Dataset\t$sourceDir\n$output";
      # update stats file if they have requested it
      &updateStats( $sourceDir, $configuration->{'stats'}, $output ) if $configuration->{'stats'};
   }
   push @status, &currentTime() . " Completed command, with status $error" if $configuration->{'verbose'} > 1;;
}

#print "Finished processing\n";
#print "testing is " . $configuration->{'testing'} . "\n";

push @status, &currentTime() . ' Backup finished';

if ($configuration->{'testing'}) {
   print join( "\n", @status ) . "\n";
} else {
   #print "Sending final email\n";
   &sendMail( join( "\n", @status ), $configuration, "Backup Complete" );
   #print "Running shutdown\n";
   &shutdownMachine( $configuration ) if $configuration->{'shutdown'};
}

1;