#!/usr/bin/perl
use strict;
use warnings;
use Date::Calc qw(System_Clock Add_Delta_Days);
use Sys::Hostname;

my $rotation_days = 8;
my $svnadmin = "/usr/bin/svnadmin";
my $cur_repos = "/p/vdt/workspace/svn";
my $bu_path = "/nobackup/vdt-svn-backup";
my $afs_bu_path = "/p/vdt/workspace/svn-backups";
my $email_recipients = 'matyas+cron@cs.wisc.edu,blin@cs.wisc.edu,tim@cs.wisc.edu,westphall@wisc.edu';
our $DEBUG = 0;
our $NOREMOVE = 0;
our $RSYNC_RETRIES = 10;
our $RSYNC_RETRY_WAIT = 30;



#### TESTING
#$DEBUG = 1;
#$NOREMOVE = 1;
#$rotation_days = 1;
#$email_recipients = 'matyas@cs.wisc.edu';
#$bu_path = "/nobackup/vdt-svn-backup.matyas";
#$afs_bu_path = "/tmp/vdt-svn-backup";
#### END TESTING

# Exit codes
use constant { EXIT_OK => 0, EXIT_BACKUP_ERROR => 1, EXIT_AFS_ERROR => 2,
               EXIT_NO_LOG => 3, EXIT_BACKUP_EXISTS => 4 };


# Get hour because we might want to make sure backup is after hours
# Get day of week because we might want to archive certain backups (i.e. Friday)
my ($year,$mon,$day,$hour,$min,$sec,$day_of_year,$weekday,$dst) = System_Clock();

my $date = format_date($year,$mon,$day);
my $todays_backup = "$bu_path/svn-backup-$date";
my $todays_backup_afs = "$afs_bu_path/svn-backup-$date";
my $backup_log = "$bu_path/backup-log.$date";
my $backup_log_afs = "$afs_bu_path/backup-log.$date";


# If the backup already exists, don't write to a log file, just send
# an email.
if(-d $todays_backup) {
    email_exit(EXIT_BACKUP_EXISTS, "Warning: Backup $todays_backup already exists\nExiting\n\n");
}

# If we can't even open our logfile, exit.
our $Logfile;
unless(open $Logfile, '>', $backup_log) {
    email_exit(EXIT_NO_LOG, "ERROR: Couldn't write to logfile at $backup_log: $!\nExiting\n\n");
}

# log something to a log file and, if desired, the console
# (needs to be up here for the prototype to work)
sub logmsg($) {
    print $Logfile $_[0];
    print $_[0] if $DEBUG;
}

logmsg "SVN backup script:\n";
logmsg "User " . getpwuid($<) . " running $0\n";
logmsg "Backup to " . hostname . " at $todays_backup\n";
logmsg "Copy to AFS at $todays_backup_afs\n";
logmsg '-' x 70 . "\n";

my $q_cur_repos = quotemeta $cur_repos;
my $q_todays_backup = quotemeta $todays_backup;
logmsg "Running svnadmin hotcopy at " . `date '+%F %T'` . "\n";
if (run_and_log("$svnadmin hotcopy --quiet $q_cur_repos $q_todays_backup 2>&1") != 0) {
    log_email_exit(EXIT_BACKUP_ERROR);
}
logmsg "Backup was successful.\n\n";
remove_oldest($bu_path);


if (! copy_to_afs($todays_backup, $afs_bu_path)) {
    log_email_exit(EXIT_AFS_ERROR);
}
logmsg "Copying to AFS was successful.\n\n";
remove_oldest($afs_bu_path);

log_email_exit(EXIT_OK);

# Done

##################
# Helper functions
##################

# run_and_log($cmd)
# Run $cmd and log all its output. Return the status code.
sub run_and_log {
    my $cmd = shift;

    my $process;
    unless(open $process, '-|', $cmd) {
        logmsg "Couldn't invoke $cmd: $!\n";
        return -1;
    }
    while (my $line = <$process>) {
        logmsg $line;
    }
    close $process;

    if($? != 0) {
        logmsg "$cmd exited with status $?\n";
    }

    return $?;
}

# Check if we have more than $rotation_days backups.  If so, remove the oldest ones
sub remove_oldest {
    my ($backups_dir) = @_;

    my @dirs = get_backups($backups_dir);
    if(@dirs > $rotation_days) {
        my $num_to_remove = scalar(@dirs) - $rotation_days;
        my @to_remove = (sort(@dirs))[0 .. $num_to_remove-1];
        logmsg "Removing the oldest $num_to_remove backup(s) from $backups_dir.\n";
        foreach my $dir (@to_remove) {
            my $this_date = $dir;
            $this_date =~ s/^svn-backup-//;
            my $logfile_to_remove_path = "$backups_dir/backup-log.$this_date";
            my $backup_to_remove_path = "$backups_dir/$dir";

            if ($NOREMOVE) {
                logmsg "Would have removed $logfile_to_remove_path and $backup_to_remove_path\n";
            }
            else {
                logmsg "Removing backup for $dir...";
                my $q_logfile_to_remove_path = quotemeta $logfile_to_remove_path;
                my $q_backup_to_remove_path = quotemeta $backup_to_remove_path;
                logmsg `rm -fR $q_logfile_to_remove_path $q_backup_to_remove_path 2>&1`;
                if ($? == 0) {
                    logmsg " ok\n";
                }
                else {
                    logmsg " failed with status $?\n";
                }
            }
        }
        logmsg "\n\n";
    }
}


sub format_date {
    my ($year,$mon,$day) = @_;
    return sprintf("%04d%02d%02d", $year,$mon,$day);
}

sub get_backups {
    my ($backups_dir) = @_;
    opendir(DIR, $backups_dir);
    my @files = readdir(DIR);
    closedir(DIR);

    return grep(/^svn-backup/ && (-d "$backups_dir/$_"), @files)
}

sub copy_to_afs {
    my $dest = pop;
    my @sources = @_;

    my $retries_left = $RSYNC_RETRIES;
    my $retry_wait = $RSYNC_RETRY_WAIT;
    while(1) {
        my @q_sources = map { quotemeta } @sources;
        my $q_dest = quotemeta $dest;
        my $cmd = "rsync -qr " . join(" ", @q_sources) . " $q_dest";
        my $pipe;
        logmsg "Running rsync at " . `date +'%F %T'` . "\n";
        unless(open $pipe, '-|', "$cmd 2>&1") {
            # Couldn't even run it. Not worth a retry.
            logmsg "Couldn't invoke rsync: $!\n";
            logmsg "Not retrying rsync.\n";
            return 0;
        }
        my @last_20_lines;
        while (my $line = <$pipe>) {
            push @last_20_lines, $line;
            if ($#last_20_lines > 19) {
                shift @last_20_lines;
            }
        }
        close($pipe);
        my $ret = $?;

        if ($ret == 0) {
            return 1;
        }
        logmsg "rsync failed with status $ret. Last 20 lines of output:\n";
        logmsg "@last_20_lines\n";

        $retries_left--;

        if ($retries_left > 0) {
            sleep($retry_wait);
            logmsg "\nRetrying rsync\n";
            $retry_wait *= 2;
        }
        else {
            last;
        }
    }

    logmsg "\nrsync failed and out of retries!\n";

    return 0;
}

# open_mailpipe($subject)
# Open a pipe to a mail process to the recipients from
# $email_recipients and with the first part of the subject (the "[SVN Backup
# $date]" bit) already filled in. $subject should not be quoted.
#
# Caller is responsible for closing the pipe once done writing mail.
sub open_mailpipe {
    my $subject = shift;

    open my $mailpipe, '|-', "mail", "-s", "[SVN Backup $date] - $subject", $email_recipients or die "Can't send mail: $!";

    return $mailpipe;
}

sub get_footer {
    my $footer = '-' x 70;
    $footer .= "\n\nDirectory listing (local disk):\n" . `ls -l $bu_path 2>&1`;
    $footer .= "\n\nDisk usage (local disk):\n" . `du -hs --apparent-size $bu_path/svn-backup* 2>/dev/null`;
    $footer .= "\n\nFree space (local disk):\n" . `df -h $bu_path 2>&1`;
    $footer .= "\n\nDirectory listing (AFS):\n" . `ls -l $afs_bu_path 2>&1`;
    $footer .= "\n\nDisk usage (AFS):\n" . `du -hs --apparent-size $afs_bu_path/svn-backup* 2>/dev/null`;
    $footer .= "\n\nFree quota (AFS):\n" . `fs lq -human $afs_bu_path 2>&1`;
    return $footer;
}


# Send mail on special conditions and exit
sub email_exit {
    my $exit_status = shift;
    my $msg = shift;

    if ($exit_status == EXIT_BACKUP_EXISTS) {
        print $msg if $DEBUG;
        # Send mail
        my $mailpipe = open_mailpipe('Already Exists');
        print $mailpipe $msg;
        print $mailpipe get_footer();
        close $mailpipe;
        # Done sending mail

        # This is fine.
        exit(0);
    }
    elsif ($exit_status == EXIT_NO_LOG) {
        print $msg if $DEBUG;
        # Send mail
        my $mailpipe = open_mailpipe('ERROR');
        print $mailpipe $msg;
        print $mailpipe get_footer();
        close $mailpipe;
        # Done sending mail

        exit(EXIT_NO_LOG);
    }
}

# Finish writing the log; archive it to AFS
# Then, attempt to send an email
# and exit.
sub log_email_exit {
    my $exit_status = shift;

    logmsg get_footer();

    close($Logfile);

    # Copy the log to AFS
    my $cmd = "cp -f " . quotemeta($backup_log) . " " . quotemeta($backup_log_afs) . " 2>&1";
    my $cp_output = `$cmd`;
    my $cp_ret = $?;

    my $status = "UNKNOWN";
    if ($exit_status == EXIT_OK) {
        $status = "Success";
    }
    elsif ($exit_status == EXIT_BACKUP_ERROR) {
        $status = "ERROR";
    }
    elsif ($exit_status == EXIT_AFS_ERROR) {
        $status = "Partial Success";
    }

    # Send mail
    my $mailpipe = open_mailpipe($status);

    if(open my $log, '<', $backup_log) {
        while(my $line = <$log>) {
            print $mailpipe $line;
        }
        close $log;
    }
    else {
        # I just wrote this, how can I not read it? But it can happen, I guess
        my $msg = "\nWarning: Couldn't open logfile at $backup_log: $!\n";
        print $msg if $DEBUG;
        print $mailpipe $msg;
    }

    if ($cp_ret != 0) {
        my $msg = "\nWarning: Copying log to AFS failed with status $cp_ret:\n$cp_output\n";
        print $msg if $DEBUG;
        print $mailpipe $msg;
    }

    close $mailpipe;
    # Done sending mail

    exit($exit_status);
}
