fix backup selection
[BackupPC.git] / bin / BackupPC_ASA_ArchiveStart
1 #!/usr/bin/perl
2 #============================================================= -*-perl-*-
3 #
4 # BackupPC_archiveStart: start an archive request from the
5 # command line.
6 #
7 # DESCRIPTION
8 #  
9 #   Usage: BackupPC_archiveStart archiveHost userName hosts...
10 #
11 #   Initiates an archive request on archive host archiveHost
12 #   for the listed hosts.  The latest backup for each host is
13 #   archived.  The userName is name of the requesting user,
14 #   which appears in the log files.
15 #
16 # AUTHOR
17 #   Craig Barratt  <cbarratt@users.sourceforge.net>
18 #   Dobrica Pavlinusic <dpavlin@rot13.org>
19 #
20 # COPYRIGHT
21 #   Copyright (C) 2007-2009  Craig Barratt
22 #
23 #   This program is free software; you can redistribute it and/or modify
24 #   it under the terms of the GNU General Public License as published by
25 #   the Free Software Foundation; either version 2 of the License, or
26 #   (at your option) any later version.
27 #
28 #   This program is distributed in the hope that it will be useful,
29 #   but WITHOUT ANY WARRANTY; without even the implied warranty of
30 #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
31 #   GNU General Public License for more details.
32 #
33 #   You should have received a copy of the GNU General Public License
34 #   along with this program; if not, write to the Free Software
35 #   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
36 #
37 #========================================================================
38 #
39 # Version 3.2.0, released 31 Jul 2010.
40 #
41 # See http://backuppc.sourceforge.net.
42 #
43 #========================================================================
44
45 use strict;
46 no  utf8;
47 use lib "/usr/local/BackupPC/lib";
48 use Getopt::Std;
49 use BackupPC::Lib;
50
51 use DBI;
52 use Data::Dump qw(dump);
53
54 die("BackupPC::Lib->new failed\n") if ( !(my $bpc = BackupPC::Lib->new) );
55
56 my %opts;
57
58 # no options currently
59 if ( !getopts("", \%opts) || @ARGV < 2 ) {
60     print STDERR <<EOF;
61 usage: $0 archiveHost userName [hosts[:num]...]
62 EOF
63     exit(1);
64 }
65
66 my %Conf = $bpc->Conf();
67
68 my $dbh = DBI->connect($Conf{SearchDSN}, $Conf{SearchUser}, "", { RaiseError => 1, AutoCommit => 0 });
69
70 my $sth = $dbh->prepare(qq{
71         select
72                 backups.id as backup_id,
73                 hosts.name as host,
74                 backups.num as num
75         from backups
76         join hosts on hosts.id = hostid
77         where hosts.name = ? and inc_size < 0 and size > 0 and not inc_deleted
78 });
79
80 my $Hosts       = $bpc->HostInfoRead();
81 my $ArchiveHost = shift @ARGV;
82 my $UserName    = shift @ARGV;
83 my @HostFilter  = @ARGV;
84 my $TopDir      = $bpc->{Conf}{TopDir};
85
86 if ( !defined($Hosts->{$ArchiveHost}) ) {
87     print(STDERR "$0: archive host $ArchiveHost doesn't exist... quitting\n");
88     exit(1);
89 }
90 $bpc->ConfigRead($ArchiveHost);
91
92 if ( ! @HostFilter ) {
93         @HostFilter = keys %$Hosts;
94 }
95
96 warn "archiving hosts ",dump(@HostFilter);
97
98 my(@HostList, @BackupList);
99 foreach ( @HostFilter ) {
100     my ($host,$num) = split(/:/,$_,2);
101     if ( !defined($Hosts->{$host}) ) {
102         print(STDERR "$0: host $host doesn't exist... quitting\n");
103         exit(1);
104     }
105     my @backups = $bpc->BackupInfoRead($host);
106     if ( !@backups ) {
107         warn "$0: host $host doesn't have any backups... skipping\n";
108         next;
109     }
110
111     $sth->execute( $host );
112     if ( $sth->rows == 0 ) {
113         warn "no backups to archive on $host\n";
114         push @HostList, $host;
115         push @BackupList, 0; # fake, but will make full-text update
116     }
117
118     while ( my $row = $sth->fetchrow_hashref ) {
119         warn "+ ", $row->{host}, " ", $row->{num}, "\n";
120         push(@HostList, $host);
121         push(@BackupList, $row->{num});
122     }
123 }
124
125 $dbh->disconnect;
126
127 my $ReqFileName;
128 for ( my $i = 0 ; ; $i++ ) {
129     $ReqFileName="archiveReq.$$.$i";
130     last if ( !-f "$TopDir/pc/$ArchiveHost/$ReqFileName" );
131 }
132 my %ArchiveReq = (
133     archiveloc  => $bpc->{Conf}{ArchiveDest},
134     archtype    => 0,
135     compression => $bpc->{Conf}{ArchiveComp} eq 'none' ? $bpc->{Conf}{CatPath}
136                     : ($bpc->{Conf}{ArchiveComp} eq 'gzip'
137                       ? $bpc->{Conf}{GzipPath} : $bpc->{Conf}{Bzip2Path}),
138     compext     => $bpc->{Conf}{ArchiveComp} eq 'none' ? ''
139                     : ($bpc->{Conf}{ArchiveComp} eq 'gzip' ? '.gz' : '.bz2'),
140     parfile     => $bpc->{Conf}{ArchivePar},
141     splitsize   => $bpc->{Conf}{ArchiveSplit} . '000000', # mb -> bytes
142     host        => $ArchiveHost,
143     HostList    => \@HostList,
144     BackupList  => \@BackupList,
145     user        => $UserName,
146     reqTime     => time,
147 );
148 my $archive = Data::Dumper->new([\%ArchiveReq], [qw(*ArchiveReq)]);
149 $archive->Indent(1);
150 if ( !open(REQ, ">", "$TopDir/pc/$ArchiveHost/$ReqFileName") ) {
151     print(STDERR "$0: can't open/write request file $TopDir/pc/$ArchiveHost/$ReqFileName... quitting\n");
152     exit(1);
153 }
154 binmode(REQ);
155 print REQ $archive->Dump;
156 close(REQ);
157 $bpc->ServerConnect($bpc->{Conf}{ServerHost}, $bpc->{Conf}{ServerPort});
158 my $reply = $bpc->ServerMesg("archive $UserName $ArchiveHost $ReqFileName");
159 $bpc->ServerDisconnect();
160 print("Sent archive request, reply: $reply\n");
161 exit(0);