#!/usr/bin/perl #============================================================= -*-perl-*- # # BackupPC_archiveStart: start an archive request from the # command line. # # DESCRIPTION # # Usage: BackupPC_archiveStart archiveHost userName hosts... # # Initiates an archive request on archive host archiveHost # for the listed hosts. The latest backup for each host is # archived. The userName is name of the requesting user, # which appears in the log files. # # AUTHOR # Craig Barratt # Dobrica Pavlinusic # # COPYRIGHT # Copyright (C) 2007-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 Getopt::Std; use BackupPC::Lib; use DBI; use Data::Dump qw(dump); die("BackupPC::Lib->new failed\n") if ( !(my $bpc = BackupPC::Lib->new) ); my %opts; # no options currently if ( !getopts("", \%opts) || @ARGV < 2 ) { print STDERR <Conf(); my $dbh = DBI->connect($Conf{SearchDSN}, $Conf{SearchUser}, "", { RaiseError => 1, AutoCommit => 0 }); my $sth = $dbh->prepare(qq{ select backups.id as backup_id, hosts.name as host, backups.num as num from backups join hosts on hosts.id = hostid where hosts.name = ? and inc_size < 0 and size > 0 and not inc_deleted }); my $Hosts = $bpc->HostInfoRead(); my $ArchiveHost = shift @ARGV; my $UserName = shift @ARGV; my @HostFilter = @ARGV; my $TopDir = $bpc->{Conf}{TopDir}; if ( !defined($Hosts->{$ArchiveHost}) ) { print(STDERR "$0: archive host $ArchiveHost doesn't exist... quitting\n"); exit(1); } $bpc->ConfigRead($ArchiveHost); if ( ! @HostFilter ) { @HostFilter = keys %$Hosts; } warn "archiving hosts ",dump(@HostFilter); my(@HostList, @BackupList); foreach ( @HostFilter ) { my ($host,$num) = split(/:/,$_,2); if ( !defined($Hosts->{$host}) ) { print(STDERR "$0: host $host doesn't exist... quitting\n"); exit(1); } my @backups = $bpc->BackupInfoRead($host); if ( !@backups ) { warn "$0: host $host doesn't have any backups... skipping\n"; next; } $sth->execute( $host ); if ( $sth->rows == 0 ) { warn "no backups to archive on $host\n"; push @HostList, $host; push @BackupList, 0; # fake, but will make full-text update } while ( my $row = $sth->fetchrow_hashref ) { warn "+ ", $row->{host}, " ", $row->{num}, "\n"; push(@HostList, $host); push(@BackupList, $row->{num}); } } $dbh->disconnect; my $ReqFileName; for ( my $i = 0 ; ; $i++ ) { $ReqFileName="archiveReq.$$.$i"; last if ( !-f "$TopDir/pc/$ArchiveHost/$ReqFileName" ); } my %ArchiveReq = ( archiveloc => $bpc->{Conf}{ArchiveDest}, archtype => 0, compression => $bpc->{Conf}{ArchiveComp} eq 'none' ? $bpc->{Conf}{CatPath} : ($bpc->{Conf}{ArchiveComp} eq 'gzip' ? $bpc->{Conf}{GzipPath} : $bpc->{Conf}{Bzip2Path}), compext => $bpc->{Conf}{ArchiveComp} eq 'none' ? '' : ($bpc->{Conf}{ArchiveComp} eq 'gzip' ? '.gz' : '.bz2'), parfile => $bpc->{Conf}{ArchivePar}, splitsize => $bpc->{Conf}{ArchiveSplit}, host => $ArchiveHost, HostList => \@HostList, BackupList => \@BackupList, user => $UserName, reqTime => time, ); my $archive = Data::Dumper->new([\%ArchiveReq], [qw(*ArchiveReq)]); $archive->Indent(1); if ( !open(REQ, ">", "$TopDir/pc/$ArchiveHost/$ReqFileName") ) { print(STDERR "$0: can't open/write request file $TopDir/pc/$ArchiveHost/$ReqFileName... quitting\n"); exit(1); } binmode(REQ); print REQ $archive->Dump; close(REQ); $bpc->ServerConnect($bpc->{Conf}{ServerHost}, $bpc->{Conf}{ServerPort}); my $reply = $bpc->ServerMesg("archive $UserName $ArchiveHost $ReqFileName"); $bpc->ServerDisconnect(); print("Sent archive request, reply: $reply\n"); exit(0);