BaNGHistoryMerger

#!/usr/bin/env perl
use strict;
use warnings;
use forks;
use Cwd qw( abs_path );
use File::Basename;
use Getopt::Long qw( :config no_auto_abbrev );
use IPC::Open3;
use Thread::Queue;
use Time::HiRes qw( gettimeofday );
use POSIX qw( strftime );

use lib dirname( abs_path($0) ) . '/lib';
use BaNG::Config;
use BaNG::BackupServer;
use BaNG::Wipe;

my $version = '1.0';
my $verbose_arg;
my $dryrun_arg;
my $daylimit_arg;
my $nthreads_arg;
my $group_arg;
my $host_arg;
my $old_bkpprefix_arg;
my $prefix_arg;
my @migrate_folders_history;
my @queue;
my $btrfs_snapshot_cmd;
my $rsync_err_check;

#################################
# Main
#
parse_command_options();
get_serverconfig($prefix_arg);
cli_args_override_global_config();

my $btrfs_cmd = $serverconfig{path_btrfs};
my $taskid    = create_timeid( $host_arg, $group_arg );

get_host_config( $host_arg, $group_arg );

my $host              = $host_arg;
my $group             = $group_arg;
my $daylimit          = $daylimit_arg || "3";
my $config            = "$host-$group";
my $hostconfig        = $hosts{$config}->{hostconfig};
my $current_bkpprefix = $hostconfig->{BKP_PREFIX};
my $old_bkpprefix     = $old_bkpprefix_arg;


if ( $serverconfig{verbose} ) {
    print "\tHost: $hosts{$config}->{hostname}\n";
    print "\tGroup: $hosts{$config}->{group}\n";
    print "\tBKP-PREFIX current: $current_bkpprefix\n";
    print "\tBKP-PREFIX old: $old_bkpprefix\n";
    print "\tExclude-File: $serverconfig{path_excludes}/$hostconfig->{BKP_EXCLUDE_FILE}\n";
}

# fill up @migrate_folders_history -> all folders to migrate, excl. 'to wiped' folders
eval_history_folders( $taskid, $hosts{$config}->{hostname}, $hosts{$config}->{group} );

if ( !@migrate_folders_history ) {
    print "Exit because queue is empty.\n" if $serverconfig{verbose};
    exit 1;
}

# Limit migration folders to the last x days (begin with the newest)
@migrate_folders_history = splice( @migrate_folders_history, 0, $daylimit );

logit( $taskid, $host, $group, "START MIGRATION for host $host group $group, migrate $daylimit days" );
$hostconfig->{BKP_PREFIX}  = $current_bkpprefix;
my $btrfs_snapshot_source  = targetpath( $host, $group ) . "/migrate";
my $btrfs_snapshot_current = targetpath( $host, $group ) . "/current";

if ( ! -e $btrfs_snapshot_source ) {
    $btrfs_snapshot_cmd = "$btrfs_cmd subvolume snapshot $btrfs_snapshot_current $btrfs_snapshot_source >/dev/null 2>&1";
    logit( $taskid, $host, $group, "Create migration snapshot folder using:\n\t$btrfs_snapshot_cmd" );

    $btrfs_snapshot_cmd = "echo $btrfs_snapshot_cmd" if $serverconfig{dryrun};
    system($btrfs_snapshot_cmd) and  print "ERROR: creating snapshot for $host-$group: $!\n";
}

# foreach day folder
foreach my $oldfolderpath ( reverse sort @migrate_folders_history ) {
    logit( $taskid, $host, $group, "Work on: $oldfolderpath" );
    print "Work on: $oldfolderpath\n";
    my ($workfolder) = $oldfolderpath =~ /\/([\d._]*)$/;

    my $jobid = create_timeid( $host, $group );

    print "\tSTART queuing\n";
    queue_migration($jobid, $oldfolderpath);

    print "\tSTART threads\n";
    start_threads();

    print "\tREMOVE generic excludefile\n";
    remove_generic_exclude_file($host, $group);

    ### do Snapshot Work
    if ( ! $rsync_err_check ) {
        my $btrfs_snapshot_dest = targetpath( $host, $group ) . "/$workfolder";

        print"\tCREATE btrfs snapshot $btrfs_snapshot_dest\n";

        $btrfs_snapshot_cmd = "$btrfs_cmd subvolume snapshot -r $btrfs_snapshot_source $btrfs_snapshot_dest >/dev/null 2>&1";
        $btrfs_snapshot_cmd = "echo $btrfs_snapshot_cmd" if $serverconfig{dryrun};

        logit( $taskid, $host, $group, "Create btrfs snapshot $oldfolderpath using:\n\t$btrfs_snapshot_cmd" );
        system($btrfs_snapshot_cmd) and  print "ERROR: creating snapshot for $host-$group: $!\n";
        logit( $taskid, $host, $group, "FINISHED migration of $oldfolderpath" );
        print "FINISHED migration of $oldfolderpath\n\n";
    } else {
        logit( $taskid, $host, $group, "FINISHED migration, of $oldfolderpath but with RSYNC ERRORS, no SNAPSHOT done!" );
        print "FINISHED migration, of $oldfolderpath but with RSYNC ERRORS, no SNAPSHOT done!\n\n";
    }
}

exit 0;

#################################
# Sub-Functions
#
sub eval_history_folders {
    my ( $taskid, $host, $group ) = @_;

    logit( $taskid, $host, $group, "Queueing folders for host $host group $group" );

    my @backup_folders;
    my $count = 0;
    my $oldestCurFolder;

    foreach my $bkpprefix ( $current_bkpprefix, $old_bkpprefix ) {
        $hostconfig->{BKP_PREFIX} = $bkpprefix;
        logit( $taskid, $host, $group, "Check available folders for BKP-PREFIX: $bkpprefix" );
        foreach my $folder ( get_backup_folders( $host, $group ) ) {
            if ( $count == 0 ) {
                $oldestCurFolder = $folder;
                chomp $oldestCurFolder;
            }
            $count++;
            print "\tCollect folder for $bkpprefix: $folder" if $serverconfig{verbose};
            push( @backup_folders, $folder );
        }
    }
    logit( $taskid, $host, $group, "OldestCurrentFolder: $oldestCurFolder" );

    # count existing backups
    my $bkpkeep = 0;
    foreach my $type (qw( DAILY WEEKLY MONTHLY )) {
        $bkpkeep += $hostconfig->{"WIPE_KEEP_$type"};
    }
    my $bkpcount = $#backup_folders + 1;

    # get list of folders to wipe
    my %stack = list_folders_to_wipe( $host, $group, @backup_folders );

    logit( $taskid, $host, $group, "Backups existing: $bkpcount, to wipe: " . ( $#{$stack{wipe}} + 1 ) . ", keeping: $bkpkeep for host $host group $group" );

    # generate wipe report with content of stacks
    if ( $serverconfig{verboselevel} >= 2 && $serverconfig{verbose} ) {
        my $wipe_report = "Wipe report\n";
        foreach my $type ( sort keys %stack ) {
            $wipe_report .= "\t" . uc($type) . " : " . ( $#{$stack{$type}} + 1 ) . "\n";
            foreach my $folder ( @{$stack{$type}} ) {
                $wipe_report .= "\t$folder\n";
            }
        }
        print $wipe_report;
    }

    foreach my $type (qw( daily weekly monthly )) {
        foreach my $folder ( @{$stack{$type}} ) {
            next if $folder =~ m/$current_bkpprefix\//;
            push( @migrate_folders_history, $folder );
        }
    }
    @migrate_folders_history = reverse sort @migrate_folders_history;

    if ( $serverconfig{verbose} ) {
        print "Migrate following folders:\n" if $serverconfig{verbose};
        foreach my $folder ( reverse sort @migrate_folders_history ) {
            print "\t$folder\n";
        }
    }
    logit( $taskid, $host, $group, "End of queueing History Merge of host $host group $group" );

    return 1;
}

sub queue_migration {
    my ( $jobid, $oldfolderpath ) = @_;
    undef @queue;

    # get list of source folders to back up
    my (@src_folders) = split( / /, $hosts{"$host-$group"}->{hostconfig}->{BKP_SOURCE_FOLDER} );
    logit( $taskid, $host, $group, 'Number of source folders: ' . ( $#src_folders + 1 ) . " ( @src_folders )" );

    foreach my $folder (@src_folders) {
        $folder =~ s/://;
        my @subfolders = `find ${oldfolderpath}${folder} -xdev -mindepth 1 -maxdepth 1 -type d -printf '/%P\n' | sort`;

        # if @subfolders empty (rsh troubles?) then use the $srcfolder
        if ( $#subfolders == -1 ) {
            push( @subfolders, $oldfolderpath );
            logit( $taskid, $host, $group, "ERROR: eval subfolders failed, use now with:\n @subfolders" );
        } else {
            logit( $taskid, $host, $group, "eval subfolders:\n @subfolders" );
        }

        my $exclsubfolderfile = create_generic_exclude_file($host, $group);

        open(my $fhExcludeFile, '>>', $exclsubfolderfile) unless $serverconfig{dryrun};

        foreach my $subfolder (@subfolders) {
            chomp $subfolder;
            $subfolder =~ s| |\\ |g;
            $subfolder =~ s|\(|\\\(|g;
            $subfolder =~ s|\)|\\\)|g;

            my $migratejob = {
                host      => $host,
                group     => $group,
                jobid     => $jobid,
                path      => "${oldfolderpath}$folder$subfolder",
                folder    => "$folder",
                subfolder => "$subfolder",
                exclsubfolders => 0,
            };
            push( @queue, $migratejob );

            $subfolder =~ s|^/||g;
            my $folder_raw = $folder;
            $folder_raw =~ s|^/||g;

            print $fhExcludeFile "- $subfolder/\n" unless $serverconfig{dryrun};
            print "- $subfolder/\n" if $serverconfig{verbose};
        }
        close $fhExcludeFile unless $serverconfig{dryrun};
        # add bkp job for files only
        my $migratejob = {
            host           => $host,
            group          => $group,
            jobid          => $jobid,
            path           => "${oldfolderpath}${folder}/",
            folder         => "$folder",
            exclsubfolders => 1,
        };
        push( @queue, $migratejob );
    }
    return 1;
}

sub eval_rsync_generic_exclude_cmd {
    my ( $host, $group ) = @_;
    my $exclsubfolderfilename = "generated.${host}_${group}_migrate-$taskid";
    my $exclsubfolderopt      = "--exclude-from=$serverconfig{path_excludes}/$exclsubfolderfilename";

    return $exclsubfolderopt;
}

sub create_generic_exclude_file {
    my ( $host, $group )  = @_;
    my $exclsubfolderfile = generic_exclude_file( $host, $group );

    unless ( $serverconfig{dryrun} ) {
        system("touch \"$exclsubfolderfile\"") and logit( $taskid, $host, $group, "ERROR: could not create generated excludefile $exclsubfolderfile" );
    }
    logit( $taskid, $host, $group, "Create generated exclude file $exclsubfolderfile" );
    return $exclsubfolderfile;
}

sub remove_generic_exclude_file {
    my ( $host, $group )  = @_;
    my $exclsubfolderfile = generic_exclude_file( $host, $group );

    if ( -e $exclsubfolderfile ) {
        unlink "$exclsubfolderfile" unless $serverconfig{dryrun};;
    }
    logit( $taskid, $host, $group, "Remove generated exclude file $exclsubfolderfile" );

    return 1;
}

sub generic_exclude_file {
    my ( $host, $group ) = @_;
    my $exclsubfolderfilename = "generated.${host}_${group}_migrate-$taskid";
    my $exclsubfolderfile     = "$serverconfig{path_excludes}/$exclsubfolderfilename";

    return $exclsubfolderfile;
}

#################################
# Threading
#
sub start_threads {
    # define number of threads
    my $nthreads;
    if ($nthreads_arg) {
        # If nthreads was defined by cli argument, use it
        $nthreads = $nthreads_arg;
        print "Using nthreads = $nthreads from command line argument\n" if $serverconfig{verbose};
    } else {
        $nthreads = 1;
    }

    my $Q = Thread::Queue->new;
    my @threads = map { threads->create( \&thread_work, $Q ) } ( 1 .. $nthreads );
    $Q->enqueue($_) for @queue;
    $Q->enqueue( (undef) x $nthreads );
    $_->join for @threads;

    return 1;
}

sub thread_work {
    my ($Q) = @_;

    while ( my $migratejob = $Q->dequeue ) {
        my $tid            = threads->tid;
        my $host           = $migratejob->{host};
        my $group          = $migratejob->{group};
        my $jobid          = $migratejob->{jobid};
        my $path           = $migratejob->{path};
        my $folder         = $migratejob->{folder};
        my $subfolder      = $migratejob->{subfolder} || "";
        my $exclsubfolders = $migratejob->{'exclsubfolders'} || 0;

        my $random_integer = int( rand(10) ) + 1;
        $random_integer = 0 if ( $dryrun_arg || not $hosts{"$host-$group"}->{hostconfig}->{BKP_THREAD_SUBFOLDERS} );

        return unless create_lockfile( $taskid, $host, $group, "$folder${subfolder}_migration-$jobid" );
        logit( $taskid, $host, $group, "Thread $tid sleep $random_integer sec. for $host-$group ($path)" );
        sleep($random_integer);

        logit( $taskid, $host, $group, "Thread $tid working on $host-$group ($path)" );
        my $rsync_err;
        $rsync_err = execute_rsync( $host, $group, $path, $folder, $subfolder, $exclsubfolders );

        $rsync_err_check = 1 if $rsync_err > 0;

        logit( $taskid, $host, $group, "Thread $tid finished with $host-$group ($path) ErrCode: $rsync_err" );

        remove_lockfile( $taskid, $host, $group, "$folder${subfolder}_migration-$jobid" );
    }

    return 1;
}

sub execute_rsync {
    my ( $host, $group, $path, $folder, $subfolder, $exclsubfolders ) = @_;

    my $rsync_cmd     = $serverconfig{path_rsync};
    my $del_excl      = $exclsubfolders ? '' : "--delete-excluded";
    my $rsync_options = "--stats -a -H --inplace --delete $del_excl --acls -e rsh ";
    my $rsync_target  = targetpath( $host, $group ) . "/migrate$folder";

    if ( $hostconfig->{BKP_EXCLUDE_FILE} ) {
        my $excludefile = "$serverconfig{path_excludes}/$hostconfig->{BKP_EXCLUDE_FILE}";
        if ( -e $excludefile ) {
            $rsync_options .= "--exclude-from=$serverconfig{path_excludes}/$hostconfig->{BKP_EXCLUDE_FILE} ";
        } else {
            print "Warning: could not find excludefile $excludefile.\n";
        }
    }

    my $rsync_generic_exclude = '';
    if ( $exclsubfolders ) {
        $rsync_generic_exclude = eval_rsync_generic_exclude_cmd( $host, $group );
        logit( $taskid, $host, $group, "Apply subfolder excludelist: $rsync_generic_exclude" );
    }

    logit( $taskid, $host, $group, "Rsync Command:\n\t$rsync_cmd $rsync_generic_exclude $rsync_options$path $rsync_target" );
    logit( $taskid, $host, $group, "Executing rsync for host $host group $group path $path" );

    local ( *HIS_IN, *HIS_OUT, *HIS_ERR );
    $rsync_cmd = "echo $rsync_cmd" if $serverconfig{dryrun};
    my $rsyncpid = open3( *HIS_IN, *HIS_OUT, *HIS_ERR, "$rsync_cmd $rsync_generic_exclude $rsync_options$path $rsync_target" );

    logit( $taskid, $host, $group, "Rsync PID: $rsyncpid for host $host group $group path $path" );

    my @outlines = <HIS_OUT>;
    my @errlines = <HIS_ERR>;
    close HIS_IN;
    close HIS_OUT;
    close HIS_ERR;

    waitpid( $rsyncpid, 0 );

    logit( $taskid, $host, $group, "Rsync[$rsyncpid] STDOUT: @outlines" ) if ( @outlines && $serverconfig{verboselevel} >= 1 );
    logit( $taskid, $host, $group, "ERROR: Rsync[$rsyncpid] STDERR: @errlines" ) if @errlines;
    logit( $taskid, $host, $group, "ERROR: Rsync[$rsyncpid] child exited with status of $?" ) if $?;

    my $errcode  = 0;
    my $endstamp = time();
    if (@errlines) {
        foreach my $errline (@errlines) {
            if ( $errline =~ /.* \(code (\d+)/ ) {
                $errcode = $1;
                logit( $taskid, $host, $group, "Rsync errorcode: $errcode" );
            }
        }
    } else {
        logit( $taskid, $host, $group, "Rsync successful for host $host group $group path $path" );
    }

    return $errcode;
}

#################################
# Helper subroutines
#
sub logit {
    my ( $taskid, $host, $group, $msg ) = @_;

    my $timestamp = strftime '%b %d %H:%M:%S', localtime;
    my $logmonth  = strftime '%Y-%m',          localtime;
    my $logdate    = strftime $serverconfig{global_log_date}, localtime;
    my $logfile    = "$serverconfig{path_logs}/historymerger_$logdate.log";
    my $logmessage = "$timestamp $host-$group($taskid) : $msg";
    $logmessage .= "\n" unless ( $logmessage =~ m/\n$/ );

    if ( $serverconfig{verbose} ) {
        if ( $serverconfig{dryrun} ) {
            print $logmessage;
        }
    }

    unless ( $serverconfig{dryrun} ) {
        open my $log, ">>", $logfile or print "ERROR opening logfile $logfile: $!\n";
        print {$log} $logmessage;
        close $log;
    }

    return 1;
}

sub create_timeid {
    my ( $host, $group, $taskid ) = @_;

    my ( $s, $usec ) = gettimeofday;
    my $timeid = `$serverconfig{path_date} +'%Y%m%d%H%M%S'` . $usec;
    $timeid =~ s/\n//g;
    $host   ||= 'SERVER';
    $group  ||= 'GLOBAL';
    $taskid ||= $timeid;
    logit( $taskid, $host, $group, "Created TimeID: $timeid" );

    return $timeid;
}

#################################
# Command line arguments
#
sub parse_command_options {
    GetOptions(
        'help'            => sub { usage('') },
        'v|verbose'       => \$verbose_arg,
        'n|dry-run'       => \$dryrun_arg,
        'daylimit=s'      => \$daylimit_arg,
        't|threads=i'     => \$nthreads_arg,
        'g|group=s'       => \$group_arg,
        'h|host=s'        => \$host_arg,
        'old-bkpprefix=s' => \$old_bkpprefix_arg,
    ) or usage('Invalid commmand line options.');
    usage('Check the arguments!') unless ( $host_arg && $group_arg && $old_bkpprefix_arg );
    usage('Number of threads must be positive') if ( $nthreads_arg && $nthreads_arg <= 0 );

    $verbose_arg = 1 if $dryrun_arg;

    return 1;
}

sub cli_args_override_global_config {

    $serverconfig{verbose} = $verbose_arg if $verbose_arg;
    $serverconfig{dryrun}  = $dryrun_arg  if $dryrun_arg;

    return 1;
}

sub usage {
    my ($message) = @_;

    if ( defined $message && length $message ) {
        $message .= "\n"
            unless $message =~ /\n$/;
    }

    my $command = $0;
    $command =~ s#^.*/##;

    print <<"EOF";
        $message
        Usage Examples:

        $command -h <host> -g <group> --old-bkpprefix <BKP_PREFIX>

        Optional Arguments:

        --daylimit <x>    # migrate only x days, default 3
        -t <nr>           # number of threads, default: 1
        -v                # verbose mode to include debugging messages
        -n                # dry-run without making changes (implies verbose)

EOF

    exit 0;
}