#! /usr/bin/perl -w

# Changelog
# 20110223 RWR
# Added "Dry Run" note on output to summarizeRsyncLog
#
# 20110215 RWR
# fixed syntax error
#
# changed timestamp to YYYYMMDD_HHMMSS if set to 't'
# added sub addSlashToPath
#
# 20180301 RWR
# fixed format in summarizeRsyncLog for newer versions
# of rsync which embed comma's in the stats

$VERSION = '0.1.4';

# function tempFileName
# Description: simple wrapper to create a temporary file. DOES NOT REMOVE
# Parameters: None
# Returns: List containing
#       Open File Handle to temp file
#       File name with path
sub tempFileName {
   use File::Temp qw/ tempfile tempdir /;
   ($fh, $filename) = tempfile();
   return ($fh, $filename);
}

# function sendLogs
# Description: Sends a log to the recipient. Log is attached as a MIME encoded message
# Parameters $logFile -- Full path/filename of log file. DOES NOT COMPRESS
#            $mailTo -- single e-mail address of recipient
#            $message -- This will be placed in the body of the e-mail
#            $TEST_CONDITIONS -- If non-zero, will only print to STDOUT what would happen
#            $MAILER_SCRIPT -- Used if $MPACK does not exist.
#            $from -- Put into the From: field
#            $mailServer -- URL of mail server to use. Defaults to localhost
#            $subject -- Placed in the subject line
# Returns: Nothing

sub sendLogs {
   my ($logFile,$mailTo, $message, $TEST_CONDITIONS, $MAILER_SCRIPT, $from, $mailServer, $subject ) = @_;
   $mailServer = 'localhost' unless $mailServer;
   my $MPACK = qx/which mpack/; chomp $MPACK;
   if ($MPACK) {
      my ( $fh, $filename ) = &tempFileName();
      print $fh $message;
      close $fh;
      if ($TEST_CONDITIONS) {
         print qq/$MPACK -d $filename -s "$subject" "$logFile" $mailTo/ . "\n";
      } else {
         qx( $MPACK -d $filename -s "$subject" "$logFile" $mailTo);
         unlink $filename;
      }
   } elsif (-e $MAILER_SCRIPT) {
      if ($TEST_CONDITIONS) {
         print qq/$MAILER_SCRIPT -f $from -t $mailTo -s $mailServer -m "$body" -u "$subject" -a "$logFile"/ . "\n";
      } else {
         qx/$MAILER_SCRIPT -f $from -t $mailTo -s $mailServer -m "$body" -u "$subject" -a "$logFile"/;
      }
   } else {
      print "No way to email logs\n";
   }
}

# function compressFile
# Description: compresses a file using either gzip or internal library
# Parameters: $filename - name of file to compressed
#             $TEST_CONDITIONS - if non-zero, will only send result to STDOUT, will not actually compress file
# Returns: File name created
sub compressFile {
   my ($filename,$TEST_CONDITIONS) = @_;
   my $COMPRESSED_FILE_EXTENSION = 'gz';
   my $resultFile = $filename . '.' . $COMPRESSED_FILE_EXTENSION;
   my $GZIP = qx/which gzip/;
   chomp $GZIP;
   if ($GZIP) {
      if ($TEST_CONDITIONS) {
         print qq( $GZIP $filename );
         print "\n";
      } else {
         if ( -e $resultFile ) {
            print "Removing $resultFile as it already exists. DATA LOST\n";
            unlink $resultFile;
         }
         qx( $GZIP $filename );
      }
   } else {
      use IO::Zlib;
      if ($TEST_CONDITIONS) {
         print "Compressing using library\n";
      } else {
         # now, we compress the log file for mailing
         open logFile,"<$filename" or die "could not open $filename for reading: $!";
         # open the same file, with a .gz suffix (just like the gzip command)
         $fh = IO::Zlib->new("$resultFile", "wb9") or die "could not create archive $resultFile: $!";
         # log files can be quite large, so lets process one line at a time.
         while ($line = <logFile>) { # read a line
               print $fh $line; # write it to the compressed image
         }
         close logFile;
         # Add some stats at the end of the compressed file (I don't do this for the main log file)
         print $fh 'Started: ' . &dateTimeStamp('t',$startTime) . "\nEnded: " .  &dateTimeStamp('t',$endTime) . "\nDuration: " . ($endTime - $startTime) . " seconds)\n";
         $fh->close;
      }
   }
   return $resultFile;
}

# function dateTimeStamp
# Description: simple sub that retrieves the date time stamp.
# Parameters: $format Type of data you want to receive, either 'u' for a simple unix number, 't' for yyyymmddhhmmss, and anything else for yyyymmdd
#             $theTime -- If passed, this is assumed to be the unix time you want to use. If not passed in, will take current time from computer
# Defaults:   $format = 'YYYYMMDD'
#             $theTime = system time
# Returns:    String containg the date/time
sub dateTimeStamp {
   $format = lc shift; # what format do they want
   $theTime = shift; # optional timestamp to process
   $theTime = time unless $theTime; # they did not pass in a timestamp, so get the one from the system
   if ($format eq 'u') { # only unix time, just return time
      return $theTime;
   }
   # all other requires we parse out the time into a gregorian calendar
   my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime($theTime);
   if ($format eq 't') { # they want the time included
      return sprintf "%4d%02d%02d_%02d%02d%02d",$year+1900,$mon+1,$mday,$hour,$min,$sec;
   } else { # don't want time included, so simply get YYYYMMDD (the default)
      return sprintf "%4d%02d%02d",$year+1900,$mon+1,$mday;
   }
}

# function time2HHMMSS
# Description: Takes a number of seconds passed in and returns it as HH:MM:SS. used to "pretty print" time to execute
# Parameters:  $seconds - An integer number of seconds
# Returns:     Above in HH:MM:SS (HH can not exceed 99)
sub time2HHMMSS {
   my $seconds = shift;
   return sprintf( "%02d:%02d:%02d", $seconds / 3600, ($seconds / 60) % 60, $seconds % 60 );
}

# Function runScript
# Description: Runs a script as a forked process, capturing exit status and any output generated on STDOUT (NOT STDERR)
# Parameters: $scriptName - fully qualified path/file of script to run
# Returns: Array containing
#          $returnCode - Exit code of script
#          $scriptResult - STDOUT capture from script
sub runScript {
   my $scriptName = shift;
   return 1 unless $scriptName;
   my $scriptResult = qx( $scriptName );
   my $returnCode = $? >> 8; # (other options are $? & 127 is signal, if any process died from, and $? & 128 is true if a core dump)
   return ( $returnCode, $scriptResult );
}

# function humanReadable
# Description: converts a number to its "Human Readable" form by dividing by 1024 until the "number" is below 1024 the returning
#              that with the appropriate modifier (kMGT). optional second power allows you to use 1000's instead of 1024
# Parameters:  $number - the number to be worked on
#              $power  - the power used to divide by
# Defaults:    $power  - 1024
# Returns:     The result as a 7 digit string containing a 1-3 digit number followed by zero or one of kMGT
sub humanReadable {
   my ($number,$power) = @_;
   $power = 1024 unless $power;
   my @modifiers = ( 'k', 'M', 'G', 'T');
   my $modifier = 0;
   while ( $number / $power >= 1 ) {
      $modifier = shift (@modifiers);
      $number /= $power;
   }
   return sprintf( "%7d$modifier", $number);
}

# function rsyncErrorCode
# Description: Convert rsync error code into descriptive string
# Parameters:  $code - rsync exit status
# Returns:     String containing descriptive error message, taken from rsync man page
sub rsyncErrorCode {
   my $code = shift;
     if    ($code == 0 )  { return 'Exited Normally' }
     elsif ($code == 1 )  { return 'Syntax or usage error' }
     elsif ($code == 2 )  { return 'Protocol incompatibility' }
     elsif ($code == 3 )  { return 'Errors selecting input/output files, dirs' }
     elsif ($code == 4 )  { return 'Requested action not supported: an attempt was made to manipulate 64-bit files on a platform that cannot support them; or an option was specified that iis supported by the client and not by the server.' }
     elsif ($code == 5 )  { return 'Error starting client-server protocol' }
     elsif ($code == 6 )  { return 'Daemon unable to append to log-file' }
     elsif ($code == 10)  { return 'Error in socket I/O' }
     elsif ($code == 11)  { return 'Error in file I/O' }
     elsif ($code == 12)  { return 'Error in rsync protocol data stream' }
     elsif ($code == 13)  { return 'Errors with program diagnostics' }
     elsif ($code == 14)  { return 'Error in IPC code' }
     elsif ($code == 20)  { return 'Received SIGUSR1 or SIGINT' }
     elsif ($code == 21)  { return 'Some error returned by waitpid()' }
     elsif ($code == 22)  { return 'Error allocating core memory buffers' }
     elsif ($code == 23)  { return 'Partial transfer due to error' }
     elsif ($code == 24)  { return 'Partial transfer due to vanished source files' }
     elsif ($code == 25)  { return 'The --max-delete limit stopped deletions' }
     elsif ($code == 30)  { return 'Timeout in data send/receive' }
     elsif ($code == 35)  { return 'Timeout waiting for daemon connection' }
}

# function summarizeRsyncLog
# Description: Reads output of rsync -v --stats command and returns a summary.
# Parameters: $fh - open file handle to rsync log
#             $rsyncReturn - the status code returned by rsync (defaults to 0)
#             $outputFormat - an sprintf format string (see default in second line of code)
# Returns: A multi-line summary of the rsync file, including number of files added/deleted, etc...
# $outputFormat is simply a sprintf format string for the following parameters, in order
#    filesDeleted
#    filesAdded
#    bytesReceived
#    humanReadable bytesReceived
#    bytesSent
#    humanReadable bytesSent
#    humanReadable rsyncErrorCode string

sub summarizeRsyncLog {
   my ( $fh, $rsyncReturn, $outputFormat ) = @_;
   $outputFormat = "%15d Files Deleted\n%15d Files Updated/Added\n%15d bytes Sent (%4s)\n%15d bytes Received (%4s)\n%15d bytes/sec (%4sb/s)\nStatus: %s\n" unless $outputFormat;


   # Counters for each type of entry
   my $deleted = 0;
   my $added = 0;
   my $sent = 0;
   my $received = 0;
   my $speed = 0;
   my $dryRun = 0;

   # bypass the header lines
   while ( <$fh> ) {
      last if m/((sending|receiving) incremental file list)|(building file list ... done)/; # look for this line to start processing
   }

   # now, process each line until we get to the end. We terminate when a line has a colon it it
   # This will fail if a file name has a colon in it.
   while ( <$fh> ) {
      chomp;
      last if m/:/; # if it has a colon in it, we are down to the summary, generally Number of files:
      next if m/\/$/; # if the line ends in a forward slash, it is a directory, not a file
      next if m/^\s*$/; # skip blank lines
      if ( /^delet/ ) { # we are deleting a file
         $deleted++;
      } else {
         $added++;
      }
   }

   # We should be at the end of the verbose log, so use the rest as the statistics generated
   # by rsync
   while ( <$fh> ) {
      if ( /sent\s*([0-9,]+)\s*bytes\s*received\s*([0-9,]+)\s*bytes\s*([0-9,\.]+)\s*bytes.sec/ ) { # is this the line telling us bytes sent/received?
         $sent = $1;
         $received = $2;
         $speed = $3;
      } elsif ( /sent\s*(\d+)\s*bytes\s*received\s*(\d+)\s*bytes/ ) { # older format without speed
         $sent = $1;
         $received = $2;
         $speed = 0;
      } elsif ( /DRY RUN/ ) {
         $dryRun = 1;
      }
   }
   # the new format inserts commas, so we must remove them.
   $sent =~ s/,//g;
   $received =~ s/,//g;
   $speed =~ s/,//g;
   $speed = int $speed;
   return ($dryRun ? "DRY RUN\n" : '') . 
            sprintf( $outputFormat,
            $deleted, $added, $sent, humanReadable( $sent ), $received, humanReadable( $received ), $speed, humanReadable( $speed * 8), &rsyncErrorCode($rsyncReturn) );
}

#
# simply adds a / if one does not exist at the end of the string
#
sub addSlashToPath {
   my $path = shift;
   my $slash = shift;
   $slash = '/' unless $slash;
   return $path . ( ( substr( $path, length( $path )-1,1) eq $slash ) ? '' : $slash );
}

sub loadConfigurationFile {
   use File::Spec::Functions qw(rel2abs);
   use File::Basename;
   use Cwd;
   use Cwd qw(realpath);
   # calculate the name of the configuration file, as basename.conf
   # and get the path to the program at the same time.
   my $suffix;
   ($scriptName, $MY_PATH, $suffix) = fileparse(realpath($0),('.pl'));
   
   my $configuration_file = $scriptName . '.conf';
   my @configurationFiles; # store the names of configuration files found, in correct order.
   # implementing a queue, using push to place things into the queue, and shift to bring them out in the same order
   # Note: This is sloppy as, if we are running from the app directory, the conf file is run twice
   # /etc has lowest priority, so it is run first
   if ( $testConfigurationFile ) {
      print "Loading configuration file from command line, $testConfigurationFile\n";
      push @configurationFiles, $testConfigurationFile;
   } else {
      push @configurationFiles, "/etc/$configuration_file" if ( -e "/etc/$configuration_file" );
      # now, try for the "real" configuration file in /etc/$scriptName
      push @configurationFiles, "/etc/$scriptName/$configuration_file" if ( -e "/etc/$scriptName/$configuration_file" );
      # or configuration file in /etc/camp/$scriptName
      push @configurationFiles, "/etc/camp/$scriptName/$configuration_file" if ( -e "/etc/camp/$scriptName/$configuration_file" );
      # application directory is next higher priority
      push @configurationFiles, $MY_PATH . $configuration_file if ( -e "$MY_PATH/$configuration_file" );
      # current working directory has highest priority
      push @configurationFiles, getcwd . "/$configuration_file" if ( -e getcwd . "/$configuration_file" );
      return '' unless @configurationFiles; # require at least one configuration file
      # now, see if the control file exists and, if it does, add it at the tail end of the queue (giving it priority)
      push @configurationFiles, '/etc/rsbackup/rsbackup_control.conf' if ( -e '/etc/rsbackup/rsbackup_control.conf' );
   }
   # Now, read the contents into a string, in the correct order, so they can be returned to the calling routine
   my $confFileContents;
   my $lastConfig = ''; # total hack to work around the fact that we load multiple copies of the same file
   while (my $filename = shift @configurationFiles) {
      next if $lastConfig eq $filename;
      $lastConfig = $filename;
      print "Processing Configuration File [$filename]\n" if $configuration{'TEST_CONDITIONS'};
      open CONFFILE, "<$filename" or die "Can not open configuration file $filename";
      $confFileContents .= join( '', <CONFFILE> );
      close CONFFILE;
   }
   return $confFileContents;
}



1;
