create view backups_on_dvds needed for archive
[BackupPC.git] / bin / BackupPC_archive
1 #!/usr/bin/perl
2 #============================================================= -*-perl-*-
3 #
4 # BackupPC_archive: Archive files for an archive client.
5 #
6 # DESCRIPTION
7 #
8 #   Usage: BackupPC_archive <user> <archiveclient> <reqFileName>
9 #
10 # AUTHOR
11 #   Josh Marshall
12 #
13 # COPYRIGHT
14 #   Copyright (C) 2001-2009  Craig Barratt
15 #
16 #   This program is free software; you can redistribute it and/or modify
17 #   it under the terms of the GNU General Public License as published by
18 #   the Free Software Foundation; either version 2 of the License, or
19 #   (at your option) any later version.
20 #
21 #   This program is distributed in the hope that it will be useful,
22 #   but WITHOUT ANY WARRANTY; without even the implied warranty of
23 #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
24 #   GNU General Public License for more details.
25 #
26 #   You should have received a copy of the GNU General Public License
27 #   along with this program; if not, write to the Free Software
28 #   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
29 #
30 #========================================================================
31 #
32 # Version 3.2.0, released 31 Jul 2010.
33 #
34 # See http://backuppc.sourceforge.net.
35 #
36 #========================================================================
37
38 use strict;
39 no  utf8;
40 use lib "/usr/local/BackupPC/lib";
41 use BackupPC::Lib;
42 use BackupPC::FileZIO;
43 use BackupPC::Xfer::Archive;
44
45 use vars qw( %ArchiveReq );
46
47 ###########################################################################
48 # Initialize
49 ###########################################################################
50
51 die("BackupPC::Lib->new failed\n") if ( !(my $bpc = BackupPC::Lib->new) );
52 my $TopDir = $bpc->TopDir();
53 my $BinDir = $bpc->BinDir();
54 my %Conf   = $bpc->Conf();
55 my $NeedPostCmd;
56
57 my($user, $host, $client, $reqFileName, %stat);
58
59 $bpc->ChildInit();
60
61 if ( @ARGV != 3 ) {
62     print("usage: $0 <user> <archiveclient> <reqFileName>\n");
63     exit(1);
64 }
65 $user = $1 if ( $ARGV[0] =~ /(.+)/ );
66 $client = $1 if ( $ARGV[1] =~ /(.+)/ );
67 if ( $ARGV[2] !~ /^([\w\.\s-]+)$/ ) {
68     print("$0: bad reqFileName (arg #3): $ARGV[2]\n");
69     exit(1);
70 }
71 $reqFileName = $1;
72
73 my $startTime = time();
74
75 my $Dir     = "$TopDir/pc/$client";
76 my @xferPid = ();
77
78 #
79 # Catch various signals
80 #
81 $SIG{INT}  = \&catch_signal;
82 $SIG{ALRM} = \&catch_signal;
83 $SIG{TERM} = \&catch_signal;
84 $SIG{PIPE} = \&catch_signal;
85 $SIG{STOP} = \&catch_signal;
86 $SIG{TSTP} = \&catch_signal;
87 $SIG{TTIN} = \&catch_signal;
88 my $Pid = $$;
89
90 mkpath($Dir, 0, 0777) if ( !-d $Dir );
91 if ( !-f "$Dir/LOCK" ) {
92     open(LOCK, ">", "$Dir/LOCK") && close(LOCK);
93 }
94
95 my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
96 my $logPath = sprintf("$Dir/LOG.%02d%04d", $mon + 1, $year + 1900);
97
98 if ( !-f $logPath ) {
99     #
100     # Compress and prune old log files
101     #
102     my $lastLog = $Conf{MaxOldPerPCLogFiles} - 1;
103     foreach my $file ( $bpc->sortedPCLogFiles($client) ) {
104         if ( $lastLog <= 0 ) {
105             unlink($file);
106             next;
107         }
108         $lastLog--;
109         next if ( $file =~ /\.z$/ || !$Conf{CompressLevel} );
110         BackupPC::FileZIO->compressCopy($file,
111                                         "$file.z",
112                                         undef,
113                                         $Conf{CompressLevel}, 1);
114     }
115 }
116 open(LOG, ">>", $logPath);
117 select(LOG); $| = 1; select(STDOUT);
118
119 #
120 # Read the request file
121 #
122
123 if ( !(my $ret = do "$Dir/$reqFileName") ) {
124     my $err;
125     if ( $@ ) {
126         $err = "couldn't parse $Dir/$reqFileName: $@";
127     } elsif ( !defined($ret) ) {
128         $err = "couldn't do $Dir/$reqFileName: $!";
129     } else {
130         $err = "couldn't run $Dir/$reqFileName";
131     }
132     $stat{hostError} = $err;
133     exit(ArchiveCleanup($client));
134 }
135
136 #
137 # Re-read config file, so we can include the PC-specific config
138 #
139 if ( defined(my $error = $bpc->ConfigRead($client)) ) {
140     $stat{hostError} = "Can't read PC's config file: $error";
141     exit(ArchiveCleanup($client));
142 }
143 %Conf = $bpc->Conf();
144
145 #
146 # Make sure we eventually timeout if there is no activity from
147 # the data transport program.
148 #
149 alarm($Conf{ClientTimeout});
150
151 #
152 # See if the host name is aliased
153 #
154 if ( $Conf{ClientNameAlias} ne "" ) {
155     $host = $Conf{ClientNameAlias};
156 } else {
157     $host = $client;
158 }
159
160 #
161 # Setup file extension for compression and open ArchiveLOG output file
162 #
163 if ( $Conf{CompressLevel} && !BackupPC::FileZIO->compOk ) {
164     $stat{hostError} = "Compress::Zlib not found";
165     exit(ArchiveCleanup($client));
166 }
167 my $fileExt = $Conf{CompressLevel} > 0 ? ".z" : "";
168 my $ArchiveLOG = BackupPC::FileZIO->open("$Dir/ArchiveLOG$fileExt", 1,
169                                      $Conf{CompressLevel});
170 my($logMsg, $xfer);
171
172 $stat{xferOK} = 1;
173 $stat{hostAbort} = undef;
174 $stat{hostError} = $stat{lastOutputLine} = undef;
175 local(*RH, *WH);
176
177 #
178 # Run an optional pre-archive command
179 #
180 UserCommandRun("ArchivePreUserCmd");
181 if ( $? && $Conf{UserCmdCheckStatus} ) {
182     $stat{hostError} = "ArchivePreUserCmd returned error status $?";
183     exit(ArchiveCleanup($client));
184 }
185 $NeedPostCmd = 1;
186
187 $xfer = BackupPC::Xfer::Archive->new($bpc);
188
189 #
190 # Run the transport program
191 #
192
193 my $xferArgs = {
194     client       => $client,
195     host         => $host,
196     user         => $ArchiveReq{user},
197     type         => "archive",
198     XferLOG      => $ArchiveLOG,
199     XferMethod   => $Conf{XferMethod},
200     pathHdrSrc   => $ArchiveReq{pathHdrSrc},
201     pathHdrDest  => $ArchiveReq{pathHdrDest},
202     HostList     => \@{$ArchiveReq{HostList}},
203     BackupList   => \@{$ArchiveReq{BackupList}},
204     archiveloc   => $ArchiveReq{archiveloc},
205     parfile      => $ArchiveReq{parfile},
206     compression  => $ArchiveReq{compression},
207     compext      => $ArchiveReq{compext},
208     splitsize    => $ArchiveReq{splitsize},
209     pidHandler   => \&pidHandler,
210 };
211
212 $xfer->args($xferArgs);
213
214 if ( !defined($logMsg = $xfer->start()) ) {
215     UserCommandRun("ArchivePostUserCmd") if ( $NeedPostCmd );
216     $stat{hostError} = "xfer start failed: ", $xfer->errStr;
217     exit(ArchiveCleanup($client));
218 }
219
220 print(LOG $bpc->timeStamp, "Starting archive\n");
221 print("started_archive\n");
222 $xfer->run();
223 $stat{xferOK} = 0 if ( defined($stat{hostError} = $xfer->errStr) );
224 alarm(0);
225
226 exit(ArchiveCleanup($client));
227
228 ###########################################################################
229 # Subroutines
230 ###########################################################################
231
232 sub catch_signal
233 {
234     my $signame = shift;
235
236     #
237     # Children quit quietly on ALRM
238     #
239     exit(1) if ( $Pid != $$ && $signame eq "ALRM" );
240
241     #
242     # Ignore signals in children
243     #
244     return if ( $Pid != $$ );
245
246     #
247     # Note: needs to be tested for each kind of XferMethod
248     #
249     print(LOG $bpc->timeStamp, "cleaning up after signal $signame\n");
250     $SIG{$signame} = 'IGNORE';
251     $ArchiveLOG->write(\"exiting after signal $signame\n");
252     $stat{xferOK} = 0;
253     if ( $signame eq "INT" ) {
254         $stat{hostError} = "aborted by user (signal=$signame)";
255     } else {
256         $stat{hostError} = "aborted by signal=$signame";
257     }
258     exit(ArchiveCleanup($client));
259 }
260
261 #
262 # Cleanup and update the archive status
263 #
264 sub ArchiveCleanup
265 {
266     my($client) = @_;
267
268     $stat{xferOK} = 0 if ( $stat{hostError} || $stat{hostAbort} );
269
270     if ( !$stat{xferOK} ) {
271         #
272         # Kill off the tranfer program, first nicely then forcefully.
273         # We use negative PIDs to make sure all processes in each
274         # group get the signal.
275         #
276         if ( @xferPid ) {
277             foreach my $pid ( @xferPid ) {
278                 kill($bpc->sigName2num("INT"), -$pid);
279             }
280             sleep(1);
281             foreach my $pid ( @xferPid ) {
282                 kill($bpc->sigName2num("KILL"), -$pid);
283             }
284         }
285     }
286
287     my $lastNum  = -1;
288     my @Archives;
289
290     @Archives = $bpc->ArchiveInfoRead($client);
291     for ( my $i = 0 ; $i < @Archives ; $i++ ) {
292         $lastNum = $Archives[$i]{num} if ( $lastNum < $Archives[$i]{num} );
293     }
294     $lastNum++;
295
296     #
297     # Run an optional post-archive command
298     #
299     if ( $NeedPostCmd ) {
300         UserCommandRun("ArchivePostUserCmd");
301         if ( $? && $Conf{UserCmdCheckStatus} ) {
302             $stat{hostError} = "RestorePreUserCmd returned error status $?";
303             $stat{xferOK} = 0;
304         }
305     }
306
307     rename("$Dir/ArchiveLOG$fileExt", "$Dir/ArchiveLOG.$lastNum$fileExt");
308     rename("$Dir/$reqFileName", "$Dir/ArchiveInfo.$lastNum");
309     my $endTime = time();
310
311     #
312     # If the archive failed, clean up
313     #
314     if ( !$stat{xferOK} ) {
315         $stat{hostError} = $stat{lastOutputLine} if ( $stat{hostError} eq "" );
316         $stat{hostAbort} = 1;
317         $ArchiveLOG->write(\"Archive failed: $stat{hostError}")
318                                             if ( defined($ArchiveLOG) );
319     }
320
321     $ArchiveLOG->close() if ( defined($ArchiveLOG) );
322
323     #
324     # Add the new archive information to the archive file
325     #
326     @Archives = $bpc->ArchiveInfoRead($client);
327     my $i = @Archives;
328     $Archives[$i]{num}           = $lastNum;
329     $Archives[$i]{startTime}     = $startTime;
330     $Archives[$i]{endTime}       = $endTime;
331     $Archives[$i]{result}        = $stat{xferOK} ? "ok" : "failed";
332     $Archives[$i]{errorMsg}      = $stat{hostError};
333
334     while ( @Archives > $Conf{ArchiveInfoKeepCnt} ) {
335         my $num = $Archives[0]{num};
336         unlink("$Dir/ArchiveLOG.$num.z");
337         unlink("$Dir/ArchiveLOG.$num");
338         unlink("$Dir/ArchiveInfo.$num");
339         shift(@Archives);
340     }
341     $bpc->ArchiveInfoWrite($client, @Archives);
342
343     if ( !$stat{xferOK} ) {
344         print(LOG $bpc->timeStamp, "Archive failed ($stat{hostError})\n");
345         print("archive failed: $stat{hostError}\n");
346         return 1;
347     } else {
348         print(LOG $bpc->timeStamp, "Archive Complete\n");
349         print("archive complete\n");
350         return;
351     }
352 }
353
354 #
355 # The Xfer method might tell us from time to time about processes
356 # it forks.  We tell BackupPC about this (for status displays) and
357 # keep track of the pids in case we cancel the backup
358 #
359 sub pidHandler
360 {
361     @xferPid = @_;
362     @xferPid = grep(/./, @xferPid);
363     return if ( !@xferPid );
364     my @pids = @xferPid;
365     my $str = join(",", @pids);
366     $ArchiveLOG->write(\"Xfer PIDs are now $str\n") if ( defined($ArchiveLOG) );
367     print("xferPids $str\n");
368 }
369
370 #
371 # Run an optional pre- or post-dump command
372 #
373 sub UserCommandRun
374 {
375     my($cmdType) = @_;
376
377     return if ( !defined($Conf{$cmdType}) );
378     my $vars = {
379         xfer         => $xfer,
380         client       => $client,
381         host         => $host,
382         user         => $user,
383         share        => $ArchiveReq{shareDest},
384         XferMethod   => $Conf{XferMethod},
385         HostList     => \@{$ArchiveReq{HostList}},
386         BackupList   => \@{$ArchiveReq{BackupList}},
387         archiveloc   => $ArchiveReq{archiveloc},
388         parfile      => $ArchiveReq{parfile},
389         compression  => $ArchiveReq{compression},
390         compext      => $ArchiveReq{compext},
391         splitsize    => $ArchiveReq{splitsize},
392         sshPath      => $Conf{SshPath},
393         LOG          => *LOG,
394         XferLOG      => $ArchiveLOG,
395         stat         => \%stat,
396         xferOK       => $stat{xferOK} || 0,
397         type         => "archive",
398         cmdType      => $cmdType,
399     };
400     my $cmd = $bpc->cmdVarSubstitute($Conf{$cmdType}, $vars);
401     $ArchiveLOG->write(\"Executing $cmdType: @$cmd\n");
402     #
403     # Run the user's command, dumping the stdout/stderr into the
404     # Xfer log file.  Also supply the optional $vars and %Conf in
405     # case the command is really perl code instead of a shell
406     # command.
407     #
408     $bpc->cmdSystemOrEval($cmd,
409             sub {
410                 $ArchiveLOG->write(\$_[0]);
411             },
412             $vars, \%Conf);
413 }