#!/usr/bin/perl
#============================================================= -*-perl-*-
#
# BackupPC_archive: Archive files for an archive client.
#
# DESCRIPTION
#
#   Usage: BackupPC_archive <user> <archiveclient> <reqFileName>
#
# AUTHOR
#   Josh Marshall
#
# COPYRIGHT
#   Copyright (C) 2001-2009  Craig Barratt
#
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; either version 2 of the License, or
#   (at your option) any later version.
#
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software
#   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
#========================================================================
#
# Version 3.2.0, released 31 Jul 2010.
#
# See http://backuppc.sourceforge.net.
#
#========================================================================

use strict;
no  utf8;
use lib "/usr/local/BackupPC/lib";
use BackupPC::Lib;
use BackupPC::FileZIO;
use BackupPC::Xfer::Archive;

use vars qw( %ArchiveReq );

###########################################################################
# Initialize
###########################################################################

die("BackupPC::Lib->new failed\n") if ( !(my $bpc = BackupPC::Lib->new) );
my $TopDir = $bpc->TopDir();
my $BinDir = $bpc->BinDir();
my %Conf   = $bpc->Conf();
my $NeedPostCmd;

my($user, $host, $client, $reqFileName, %stat);

$bpc->ChildInit();

if ( @ARGV != 3 ) {
    print("usage: $0 <user> <archiveclient> <reqFileName>\n");
    exit(1);
}
$user = $1 if ( $ARGV[0] =~ /(.+)/ );
$client = $1 if ( $ARGV[1] =~ /(.+)/ );
if ( $ARGV[2] !~ /^([\w\.\s-]+)$/ ) {
    print("$0: bad reqFileName (arg #3): $ARGV[2]\n");
    exit(1);
}
$reqFileName = $1;

my $startTime = time();

my $Dir     = "$TopDir/pc/$client";
my @xferPid = ();

#
# Catch various signals
#
$SIG{INT}  = \&catch_signal;
$SIG{ALRM} = \&catch_signal;
$SIG{TERM} = \&catch_signal;
$SIG{PIPE} = \&catch_signal;
$SIG{STOP} = \&catch_signal;
$SIG{TSTP} = \&catch_signal;
$SIG{TTIN} = \&catch_signal;
my $Pid = $$;

mkpath($Dir, 0, 0777) if ( !-d $Dir );
if ( !-f "$Dir/LOCK" ) {
    open(LOCK, ">", "$Dir/LOCK") && close(LOCK);
}

my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
my $logPath = sprintf("$Dir/LOG.%02d%04d", $mon + 1, $year + 1900);

if ( !-f $logPath ) {
    #
    # Compress and prune old log files
    #
    my $lastLog = $Conf{MaxOldPerPCLogFiles} - 1;
    foreach my $file ( $bpc->sortedPCLogFiles($client) ) {
        if ( $lastLog <= 0 ) {
            unlink($file);
            next;
        }
        $lastLog--;
        next if ( $file =~ /\.z$/ || !$Conf{CompressLevel} );
        BackupPC::FileZIO->compressCopy($file,
                                        "$file.z",
                                        undef,
                                        $Conf{CompressLevel}, 1);
    }
}
open(LOG, ">>", $logPath);
select(LOG); $| = 1; select(STDOUT);

#
# Read the request file
#

if ( !(my $ret = do "$Dir/$reqFileName") ) {
    my $err;
    if ( $@ ) {
        $err = "couldn't parse $Dir/$reqFileName: $@";
    } elsif ( !defined($ret) ) {
	$err = "couldn't do $Dir/$reqFileName: $!";
    } else {
	$err = "couldn't run $Dir/$reqFileName";
    }
    $stat{hostError} = $err;
    exit(ArchiveCleanup($client));
}

#
# Re-read config file, so we can include the PC-specific config
#
if ( defined(my $error = $bpc->ConfigRead($client)) ) {
    $stat{hostError} = "Can't read PC's config file: $error";
    exit(ArchiveCleanup($client));
}
%Conf = $bpc->Conf();

#
# Make sure we eventually timeout if there is no activity from
# the data transport program.
#
alarm($Conf{ClientTimeout});

#
# See if the host name is aliased
#
if ( $Conf{ClientNameAlias} ne "" ) {
    $host = $Conf{ClientNameAlias};
} else {
    $host = $client;
}

#
# Setup file extension for compression and open ArchiveLOG output file
#
if ( $Conf{CompressLevel} && !BackupPC::FileZIO->compOk ) {
    $stat{hostError} = "Compress::Zlib not found";
    exit(ArchiveCleanup($client));
}
my $fileExt = $Conf{CompressLevel} > 0 ? ".z" : "";
my $ArchiveLOG = BackupPC::FileZIO->open("$Dir/ArchiveLOG$fileExt", 1,
                                     $Conf{CompressLevel});
my($logMsg, $xfer);

$stat{xferOK} = 1;
$stat{hostAbort} = undef;
$stat{hostError} = $stat{lastOutputLine} = undef;
local(*RH, *WH);

#
# Run an optional pre-archive command
#
UserCommandRun("ArchivePreUserCmd");
if ( $? && $Conf{UserCmdCheckStatus} ) {
    $stat{hostError} = "ArchivePreUserCmd returned error status $?";
    exit(ArchiveCleanup($client));
}
$NeedPostCmd = 1;

$xfer = BackupPC::Xfer::Archive->new($bpc);

#
# Run the transport program
#

my $xferArgs = {
    client       => $client,
    host         => $host,
    user         => $ArchiveReq{user},
    type         => "archive",
    XferLOG      => $ArchiveLOG,
    XferMethod   => $Conf{XferMethod},
    pathHdrSrc   => $ArchiveReq{pathHdrSrc},
    pathHdrDest  => $ArchiveReq{pathHdrDest},
    HostList     => \@{$ArchiveReq{HostList}},
    BackupList   => \@{$ArchiveReq{BackupList}},
    archiveloc   => $ArchiveReq{archiveloc},
    parfile      => $ArchiveReq{parfile},
    compression  => $ArchiveReq{compression},
    compext      => $ArchiveReq{compext},
    splitsize    => $ArchiveReq{splitsize},
    pidHandler   => \&pidHandler,
};

$xfer->args($xferArgs);

if ( !defined($logMsg = $xfer->start()) ) {
    UserCommandRun("ArchivePostUserCmd") if ( $NeedPostCmd );
    $stat{hostError} = "xfer start failed: ", $xfer->errStr;
    exit(ArchiveCleanup($client));
}

print(LOG $bpc->timeStamp, "Starting archive\n");
print("started_archive\n");
$xfer->run();
$stat{xferOK} = 0 if ( defined($stat{hostError} = $xfer->errStr) );
alarm(0);

exit(ArchiveCleanup($client));

###########################################################################
# Subroutines
###########################################################################

sub catch_signal
{
    my $signame = shift;

    #
    # Children quit quietly on ALRM
    #
    exit(1) if ( $Pid != $$ && $signame eq "ALRM" );

    #
    # Ignore signals in children
    #
    return if ( $Pid != $$ );

    #
    # Note: needs to be tested for each kind of XferMethod
    #
    print(LOG $bpc->timeStamp, "cleaning up after signal $signame\n");
    $SIG{$signame} = 'IGNORE';
    $ArchiveLOG->write(\"exiting after signal $signame\n");
    $stat{xferOK} = 0;
    if ( $signame eq "INT" ) {
	$stat{hostError} = "aborted by user (signal=$signame)";
    } else {
	$stat{hostError} = "aborted by signal=$signame";
    }
    exit(ArchiveCleanup($client));
}

#
# Cleanup and update the archive status
#
sub ArchiveCleanup
{
    my($client) = @_;

    $stat{xferOK} = 0 if ( $stat{hostError} || $stat{hostAbort} );

    if ( !$stat{xferOK} ) {
	#
	# Kill off the tranfer program, first nicely then forcefully.
	# We use negative PIDs to make sure all processes in each
	# group get the signal.
	#
	if ( @xferPid ) {
	    foreach my $pid ( @xferPid ) {
		kill($bpc->sigName2num("INT"), -$pid);
	    }
	    sleep(1);
	    foreach my $pid ( @xferPid ) {
		kill($bpc->sigName2num("KILL"), -$pid);
	    }
	}
    }

    my $lastNum  = -1;
    my @Archives;

    @Archives = $bpc->ArchiveInfoRead($client);
    for ( my $i = 0 ; $i < @Archives ; $i++ ) {
	$lastNum = $Archives[$i]{num} if ( $lastNum < $Archives[$i]{num} );
    }
    $lastNum++;

    #
    # Run an optional post-archive command
    #
    if ( $NeedPostCmd ) {
        UserCommandRun("ArchivePostUserCmd");
        if ( $? && $Conf{UserCmdCheckStatus} ) {
            $stat{hostError} = "RestorePreUserCmd returned error status $?";
            $stat{xferOK} = 0;
        }
    }

    rename("$Dir/ArchiveLOG$fileExt", "$Dir/ArchiveLOG.$lastNum$fileExt");
    rename("$Dir/$reqFileName", "$Dir/ArchiveInfo.$lastNum");
    my $endTime = time();

    #
    # If the archive failed, clean up
    #
    if ( !$stat{xferOK} ) {
	$stat{hostError} = $stat{lastOutputLine} if ( $stat{hostError} eq "" );
	$stat{hostAbort} = 1;
	$ArchiveLOG->write(\"Archive failed: $stat{hostError}")
					    if ( defined($ArchiveLOG) );
    }

    $ArchiveLOG->close() if ( defined($ArchiveLOG) );

    #
    # Add the new archive information to the archive file
    #
    @Archives = $bpc->ArchiveInfoRead($client);
    my $i = @Archives;
    $Archives[$i]{num}           = $lastNum;
    $Archives[$i]{startTime}     = $startTime;
    $Archives[$i]{endTime}       = $endTime;
    $Archives[$i]{result}        = $stat{xferOK} ? "ok" : "failed";
    $Archives[$i]{errorMsg}      = $stat{hostError};

    while ( @Archives > $Conf{ArchiveInfoKeepCnt} ) {
	my $num = $Archives[0]{num};
	unlink("$Dir/ArchiveLOG.$num.z");
	unlink("$Dir/ArchiveLOG.$num");
	unlink("$Dir/ArchiveInfo.$num");
	shift(@Archives);
    }
    $bpc->ArchiveInfoWrite($client, @Archives);

    if ( !$stat{xferOK} ) {
	print(LOG $bpc->timeStamp, "Archive failed ($stat{hostError})\n");
	print("archive failed: $stat{hostError}\n");
	return 1;
    } else {
        print(LOG $bpc->timeStamp, "Archive Complete\n");
	print("archive complete\n");
	return;
    }
}

#
# The Xfer method might tell us from time to time about processes
# it forks.  We tell BackupPC about this (for status displays) and
# keep track of the pids in case we cancel the backup
#
sub pidHandler
{
    @xferPid = @_;
    @xferPid = grep(/./, @xferPid);
    return if ( !@xferPid );
    my @pids = @xferPid;
    my $str = join(",", @pids);
    $ArchiveLOG->write(\"Xfer PIDs are now $str\n") if ( defined($ArchiveLOG) );
    print("xferPids $str\n");
}

#
# Run an optional pre- or post-dump command
#
sub UserCommandRun
{
    my($cmdType) = @_;

    return if ( !defined($Conf{$cmdType}) );
    my $vars = {
        xfer         => $xfer,
        client       => $client,
        host         => $host,
        user         => $user,
        share        => $ArchiveReq{shareDest},
        XferMethod   => $Conf{XferMethod},
        HostList     => \@{$ArchiveReq{HostList}},
        BackupList   => \@{$ArchiveReq{BackupList}},
        archiveloc   => $ArchiveReq{archiveloc},
        parfile      => $ArchiveReq{parfile},
        compression  => $ArchiveReq{compression},
        compext      => $ArchiveReq{compext},
        splitsize    => $ArchiveReq{splitsize},
        sshPath      => $Conf{SshPath},
        LOG          => *LOG,
        XferLOG      => $ArchiveLOG,
        stat         => \%stat,
        xferOK       => $stat{xferOK} || 0,
	type	     => "archive",
	cmdType	     => $cmdType,
    };
    my $cmd = $bpc->cmdVarSubstitute($Conf{$cmdType}, $vars);
    $ArchiveLOG->write(\"Executing $cmdType: @$cmd\n");
    #
    # Run the user's command, dumping the stdout/stderr into the
    # Xfer log file.  Also supply the optional $vars and %Conf in
    # case the command is really perl code instead of a shell
    # command.
    #
    $bpc->cmdSystemOrEval($cmd,
	    sub {
		$ArchiveLOG->write(\$_[0]);
	    },
	    $vars, \%Conf);
}