1 |
#!/bin/perl |
2 |
#============================================================= -*-perl-*- |
3 |
# |
4 |
# BackupPC_dump: Dump a single client. |
5 |
# |
6 |
# DESCRIPTION |
7 |
# |
8 |
# Usage: BackupPC_dump [-i] [-f] [-d] [-e] [-v] <client> |
9 |
# |
10 |
# Flags: |
11 |
# |
12 |
# -i Do an incremental dump, overriding any scheduling (but a full |
13 |
# dump will be done if no dumps have yet succeeded) |
14 |
# |
15 |
# -f Do a full dump, overriding any scheduling. |
16 |
# |
17 |
# -d Host is a DHCP pool address, and the client argument |
18 |
# just an IP address. We lookup the NetBios name from |
19 |
# the IP address. |
20 |
# |
21 |
# -e Just do an dump expiry check for the client. Don't do anything |
22 |
# else. This is used periodically by BackupPC to make sure that |
23 |
# dhcp hosts have correctly expired old backups. Without this, |
24 |
# dhcp hosts that are no longer on the network will not expire |
25 |
# old backups. |
26 |
# |
27 |
# -v verbose. for manual usage: prints failure reasons in more detail. |
28 |
# |
29 |
# BackupPC_dump is run periodically by BackupPC to backup $client. |
30 |
# The file $TopDir/pc/$client/backups is read to decide whether a |
31 |
# full or incremental backup needs to be run. If no backup is |
32 |
# scheduled, or a ping to $client fails, then BackupPC_dump quits. |
33 |
# |
34 |
# The backup is done using the selected XferMethod (smb, tar, rsync etc), |
35 |
# extracting the dump into $TopDir/pc/$client/new. The xfer output is |
36 |
# put into $TopDir/pc/$client/XferLOG. |
37 |
# |
38 |
# If the dump succeeds (based on parsing the output of the XferMethod): |
39 |
# - $TopDir/pc/$client/new is renamed to $TopDir/pc/$client/nnn, where |
40 |
# nnn is the next sequential dump number. |
41 |
# - $TopDir/pc/$client/XferLOG is renamed to $TopDir/pc/$client/XferLOG.nnn. |
42 |
# - $TopDir/pc/$client/backups is updated. |
43 |
# |
44 |
# If the dump fails: |
45 |
# - $TopDir/pc/$client/new is moved to $TopDir/trash for later removal. |
46 |
# - $TopDir/pc/$client/XferLOG is renamed to $TopDir/pc/$client/XferLOG.bad |
47 |
# for later viewing. |
48 |
# |
49 |
# BackupPC_dump communicates to BackupPC via printing to STDOUT. |
50 |
# |
51 |
# AUTHOR |
52 |
# Craig Barratt <cbarratt@users.sourceforge.net> |
53 |
# |
54 |
# COPYRIGHT |
55 |
# Copyright (C) 2001-2003 Craig Barratt |
56 |
# |
57 |
# This program is free software; you can redistribute it and/or modify |
58 |
# it under the terms of the GNU General Public License as published by |
59 |
# the Free Software Foundation; either version 2 of the License, or |
60 |
# (at your option) any later version. |
61 |
# |
62 |
# This program is distributed in the hope that it will be useful, |
63 |
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
64 |
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
65 |
# GNU General Public License for more details. |
66 |
# |
67 |
# You should have received a copy of the GNU General Public License |
68 |
# along with this program; if not, write to the Free Software |
69 |
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
70 |
# |
71 |
#======================================================================== |
72 |
# |
73 |
# Version 2.1.2, released 5 Sep 2005. |
74 |
# |
75 |
# See http://backuppc.sourceforge.net. |
76 |
# |
77 |
#======================================================================== |
78 |
|
79 |
use strict; |
80 |
no utf8; |
81 |
use lib "__INSTALLDIR__/lib"; |
82 |
use BackupPC::Lib; |
83 |
use BackupPC::FileZIO; |
84 |
use BackupPC::Xfer::Smb; |
85 |
use BackupPC::Xfer::Tar; |
86 |
use BackupPC::Xfer::Rsync; |
87 |
use Socket; |
88 |
use File::Path; |
89 |
use File::Find; |
90 |
use Getopt::Std; |
91 |
|
92 |
########################################################################### |
93 |
# Initialize |
94 |
########################################################################### |
95 |
|
96 |
die("BackupPC::Lib->new failed\n") if ( !(my $bpc = BackupPC::Lib->new) ); |
97 |
my $TopDir = $bpc->TopDir(); |
98 |
my $BinDir = $bpc->BinDir(); |
99 |
my %Conf = $bpc->Conf(); |
100 |
my $NeedPostCmd; |
101 |
my $Hosts; |
102 |
my $SigName; |
103 |
my $Abort; |
104 |
|
105 |
$bpc->ChildInit(); |
106 |
|
107 |
my %opts; |
108 |
if ( !getopts("defiv", \%opts) || @ARGV != 1 ) { |
109 |
print("usage: $0 [-d] [-e] [-f] [-i] [-v] <client>\n"); |
110 |
exit(1); |
111 |
} |
112 |
if ( $ARGV[0] !~ /^([\w\.\s-]+)$/ ) { |
113 |
print("$0: bad client name '$ARGV[0]'\n"); |
114 |
exit(1); |
115 |
} |
116 |
my $client = $1; # BackupPC's client name (might not be real host name) |
117 |
my $hostIP; # this is the IP address |
118 |
my $host; # this is the real host name |
119 |
|
120 |
my($clientURI, $user); |
121 |
|
122 |
$bpc->verbose(1) if ( $opts{v} ); |
123 |
|
124 |
if ( $opts{d} ) { |
125 |
# |
126 |
# The client name $client is simply a DHCP address. We need to check |
127 |
# if there is any machine at this address, and if so, get the actual |
128 |
# host name via NetBios using nmblookup. |
129 |
# |
130 |
$hostIP = $client; |
131 |
if ( $bpc->CheckHostAlive($hostIP) < 0 ) { |
132 |
print(STDERR "Exiting because CheckHostAlive($hostIP) failed\n") |
133 |
if ( $opts{v} ); |
134 |
exit(1); |
135 |
} |
136 |
if ( $Conf{NmbLookupCmd} eq "" ) { |
137 |
print(STDERR "Exiting because \$Conf{NmbLookupCmd} is empty\n") |
138 |
if ( $opts{v} ); |
139 |
exit(1); |
140 |
} |
141 |
($client, $user) = $bpc->NetBiosInfoGet($hostIP); |
142 |
if ( $client !~ /^([\w\.\s-]+)$/ ) { |
143 |
print(STDERR "Exiting because NetBiosInfoGet($hostIP) returned" |
144 |
. " '$client', an invalid host name\n") if ( $opts{v} ); |
145 |
exit(1) |
146 |
} |
147 |
$Hosts = $bpc->HostInfoRead($client); |
148 |
$host = $client; |
149 |
} else { |
150 |
$Hosts = $bpc->HostInfoRead($client); |
151 |
} |
152 |
if ( !defined($Hosts->{$client}) ) { |
153 |
print(STDERR "Exiting because host $client does not exist in the" |
154 |
. " hosts file\n") if ( $opts{v} ); |
155 |
exit(1) |
156 |
} |
157 |
|
158 |
my $Dir = "$TopDir/pc/$client"; |
159 |
my @xferPid = (); |
160 |
my $tarPid = -1; |
161 |
|
162 |
# |
163 |
# Re-read config file, so we can include the PC-specific config |
164 |
# |
165 |
$clientURI = $bpc->uriEsc($client); |
166 |
if ( defined(my $error = $bpc->ConfigRead($client)) ) { |
167 |
print("dump failed: Can't read PC's config file: $error\n"); |
168 |
exit(1); |
169 |
} |
170 |
%Conf = $bpc->Conf(); |
171 |
|
172 |
# |
173 |
# Catch various signals |
174 |
# |
175 |
$SIG{INT} = \&catch_signal; |
176 |
$SIG{ALRM} = \&catch_signal; |
177 |
$SIG{TERM} = \&catch_signal; |
178 |
$SIG{PIPE} = \&catch_signal; |
179 |
$SIG{STOP} = \&catch_signal; |
180 |
$SIG{TSTP} = \&catch_signal; |
181 |
$SIG{TTIN} = \&catch_signal; |
182 |
my $Pid = $$; |
183 |
|
184 |
# |
185 |
# Make sure we eventually timeout if there is no activity from |
186 |
# the data transport program. |
187 |
# |
188 |
alarm($Conf{ClientTimeout}); |
189 |
|
190 |
mkpath($Dir, 0, 0777) if ( !-d $Dir ); |
191 |
if ( !-f "$Dir/LOCK" ) { |
192 |
open(LOCK, ">", "$Dir/LOCK") && close(LOCK); |
193 |
} |
194 |
open(LOG, ">>", "$Dir/LOG"); |
195 |
select(LOG); $| = 1; select(STDOUT); |
196 |
|
197 |
# |
198 |
# For the -e option we just expire backups and quit |
199 |
# |
200 |
if ( $opts{e} ) { |
201 |
BackupExpire($client); |
202 |
exit(0); |
203 |
} |
204 |
|
205 |
# |
206 |
# For archive hosts we don't bother any further |
207 |
# |
208 |
if ($Conf{XferMethod} eq "archive" ) { |
209 |
print(STDERR "Exiting because the XferMethod is set to archive\n") |
210 |
if ( $opts{v} ); |
211 |
exit(0); |
212 |
} |
213 |
|
214 |
if ( !$opts{d} ) { |
215 |
# |
216 |
# In the non-DHCP case, make sure the host can be looked up |
217 |
# via NS, or otherwise find the IP address via NetBios. |
218 |
# |
219 |
if ( $Conf{ClientNameAlias} ne "" ) { |
220 |
$host = $Conf{ClientNameAlias}; |
221 |
} else { |
222 |
$host = $client; |
223 |
} |
224 |
if ( !defined(gethostbyname($host)) ) { |
225 |
# |
226 |
# Ok, NS doesn't know about it. Maybe it is a NetBios name |
227 |
# instead. |
228 |
# |
229 |
print(STDERR "Name server doesn't know about $host; trying NetBios\n") |
230 |
if ( $opts{v} ); |
231 |
if ( !defined($hostIP = $bpc->NetBiosHostIPFind($host)) ) { |
232 |
print(LOG $bpc->timeStamp, "Can't find host $host via netbios\n"); |
233 |
print("host not found\n"); |
234 |
exit(1); |
235 |
} |
236 |
} else { |
237 |
$hostIP = $host; |
238 |
} |
239 |
} |
240 |
|
241 |
########################################################################### |
242 |
# Figure out what to do and do it |
243 |
########################################################################### |
244 |
|
245 |
# |
246 |
# See if we should skip this host during a certain range |
247 |
# of times. |
248 |
# |
249 |
my $err = $bpc->ServerConnect($Conf{ServerHost}, $Conf{ServerPort}); |
250 |
if ( $err ne "" ) { |
251 |
print("Can't connect to server ($err)\n"); |
252 |
print(LOG $bpc->timeStamp, "Can't connect to server ($err)\n"); |
253 |
exit(1); |
254 |
} |
255 |
my $reply = $bpc->ServerMesg("status host($clientURI)"); |
256 |
$reply = $1 if ( $reply =~ /(.*)/s ); |
257 |
my(%StatusHost); |
258 |
eval($reply); |
259 |
$bpc->ServerDisconnect(); |
260 |
|
261 |
# |
262 |
# For DHCP tell BackupPC which host this is |
263 |
# |
264 |
if ( $opts{d} ) { |
265 |
if ( $StatusHost{activeJob} ) { |
266 |
# oops, something is already running for this host |
267 |
print(STDERR "Exiting because backup is already running for $client\n") |
268 |
if ( $opts{v} ); |
269 |
exit(0); |
270 |
} |
271 |
print("DHCP $hostIP $clientURI\n"); |
272 |
} |
273 |
|
274 |
my($needLink, @Backups, $type, $lastBkupNum, $lastFullBkupNum); |
275 |
my $lastFull = 0; |
276 |
my $lastIncr = 0; |
277 |
my $partialIdx = -1; |
278 |
my $partialNum; |
279 |
my $lastPartial = 0; |
280 |
|
281 |
if ( $Conf{FullPeriod} == -1 && !$opts{f} && !$opts{i} |
282 |
|| $Conf{FullPeriod} == -2 ) { |
283 |
print(STDERR "Exiting because backups are disabled with" |
284 |
. " \$Conf{FullPeriod} = $Conf{FullPeriod}\n") if ( $opts{v} ); |
285 |
# |
286 |
# Tell BackupPC to ignore old failed backups on hosts that |
287 |
# have backups disabled. |
288 |
# |
289 |
print("backups disabled\n") |
290 |
if ( defined($StatusHost{errorTime}) |
291 |
&& $StatusHost{reason} ne "Reason_backup_done" |
292 |
&& time - $StatusHost{errorTime} > 4 * 24 * 3600 ); |
293 |
NothingToDo($needLink); |
294 |
} |
295 |
|
296 |
if ( !$opts{i} && !$opts{f} && $Conf{BlackoutGoodCnt} >= 0 |
297 |
&& $StatusHost{aliveCnt} >= $Conf{BlackoutGoodCnt} ) { |
298 |
my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); |
299 |
my($currHours) = $hour + $min / 60 + $sec / 3600; |
300 |
my $blackout; |
301 |
|
302 |
# |
303 |
# Handle backward compatibility with original separate scalar |
304 |
# parameters. |
305 |
# |
306 |
if ( defined($Conf{BlackoutHourBegin}) ) { |
307 |
push(@{$Conf{BlackoutPeriods}}, |
308 |
{ |
309 |
hourBegin => $Conf{BlackoutHourBegin}, |
310 |
hourEnd => $Conf{BlackoutHourEnd}, |
311 |
weekDays => $Conf{BlackoutWeekDays}, |
312 |
} |
313 |
); |
314 |
} |
315 |
foreach my $p ( @{$Conf{BlackoutPeriods}} ) { |
316 |
# |
317 |
# Allow blackout to span midnight (specified by BlackoutHourBegin |
318 |
# being greater than BlackoutHourEnd) |
319 |
# |
320 |
next if ( ref($p->{weekDays}) ne "ARRAY" |
321 |
|| !defined($p->{hourBegin}) |
322 |
|| !defined($p->{hourEnd}) |
323 |
); |
324 |
if ( $p->{hourBegin} > $p->{hourEnd} ) { |
325 |
$blackout = $p->{hourBegin} <= $currHours |
326 |
|| $currHours <= $p->{hourEnd}; |
327 |
if ( $currHours <= $p->{hourEnd} ) { |
328 |
# |
329 |
# This is after midnight, so decrement the weekday for the |
330 |
# weekday check (eg: Monday 11pm-1am means Monday 2300 to |
331 |
# Tuesday 0100, not Monday 2300-2400 plus Monday 0000-0100). |
332 |
# |
333 |
$wday--; |
334 |
$wday += 7 if ( $wday < 0 ); |
335 |
} |
336 |
} else { |
337 |
$blackout = $p->{hourBegin} <= $currHours |
338 |
&& $currHours <= $p->{hourEnd}; |
339 |
} |
340 |
if ( $blackout && grep($_ == $wday, @{$p->{weekDays}}) ) { |
341 |
# print(LOG $bpc->timeStamp, "skipping because of blackout" |
342 |
# . " (alive $StatusHost{aliveCnt} times)\n"); |
343 |
print(STDERR "Skipping $client because of blackout\n") |
344 |
if ( $opts{v} ); |
345 |
NothingToDo($needLink); |
346 |
} |
347 |
} |
348 |
} |
349 |
|
350 |
if ( !$opts{i} && !$opts{f} && $StatusHost{backoffTime} > time ) { |
351 |
printf(LOG "%sskipping because of user requested delay (%.1f hours left)\n", |
352 |
$bpc->timeStamp, ($StatusHost{backoffTime} - time) / 3600); |
353 |
NothingToDo($needLink); |
354 |
} |
355 |
|
356 |
# |
357 |
# Now see if there are any old backups we should delete |
358 |
# |
359 |
BackupExpire($client); |
360 |
|
361 |
# |
362 |
# Read Backup information, and find times of the most recent full and |
363 |
# incremental backups |
364 |
# |
365 |
@Backups = $bpc->BackupInfoRead($client); |
366 |
for ( my $i = 0 ; $i < @Backups ; $i++ ) { |
367 |
$needLink = 1 if ( $Backups[$i]{nFilesNew} eq "" |
368 |
|| -f "$Dir/NewFileList.$Backups[$i]{num}" ); |
369 |
$lastBkupNum = $Backups[$i]{num}; |
370 |
if ( $Backups[$i]{type} eq "full" ) { |
371 |
if ( $lastFull < $Backups[$i]{startTime} ) { |
372 |
$lastFull = $Backups[$i]{startTime}; |
373 |
$lastFullBkupNum = $Backups[$i]{num}; |
374 |
} |
375 |
} elsif ( $Backups[$i]{type} eq "incr" ) { |
376 |
$lastIncr = $Backups[$i]{startTime} |
377 |
if ( $lastIncr < $Backups[$i]{startTime} ); |
378 |
} elsif ( $Backups[$i]{type} eq "partial" ) { |
379 |
$partialIdx = $i; |
380 |
$lastPartial = $Backups[$i]{startTime}; |
381 |
$partialNum = $Backups[$i]{num}; |
382 |
} |
383 |
} |
384 |
|
385 |
# |
386 |
# Decide whether we do nothing, or a full or incremental backup. |
387 |
# |
388 |
if ( @Backups == 0 |
389 |
|| $opts{f} |
390 |
|| (!$opts{i} && (time - $lastFull > $Conf{FullPeriod} * 24*3600 |
391 |
&& time - $lastIncr > $Conf{IncrPeriod} * 24*3600)) ) { |
392 |
$type = "full"; |
393 |
} elsif ( $opts{i} || (time - $lastIncr > $Conf{IncrPeriod} * 24*3600 |
394 |
&& time - $lastFull > $Conf{IncrPeriod} * 24*3600) ) { |
395 |
$type = "incr"; |
396 |
} else { |
397 |
NothingToDo($needLink); |
398 |
} |
399 |
|
400 |
# |
401 |
# Check if $host is alive |
402 |
# |
403 |
my $delay = $bpc->CheckHostAlive($hostIP); |
404 |
if ( $delay < 0 ) { |
405 |
print(LOG $bpc->timeStamp, "no ping response\n"); |
406 |
print("no ping response\n"); |
407 |
print("link $clientURI\n") if ( $needLink ); |
408 |
exit(1); |
409 |
} elsif ( $delay > $Conf{PingMaxMsec} ) { |
410 |
printf(LOG "%sping too slow: %.4gmsec\n", $bpc->timeStamp, $delay); |
411 |
printf("ping too slow: %.4gmsec (threshold is %gmsec)\n", |
412 |
$delay, $Conf{PingMaxMsec}); |
413 |
print("link $clientURI\n") if ( $needLink ); |
414 |
exit(1); |
415 |
} |
416 |
|
417 |
# |
418 |
# Make sure it is really the machine we expect (only for fixed addresses, |
419 |
# since we got the DHCP address above). |
420 |
# |
421 |
if ( !$opts{d} && (my $errMsg = CorrectHostCheck($hostIP, $host)) ) { |
422 |
print(LOG $bpc->timeStamp, "dump failed: $errMsg\n"); |
423 |
print("dump failed: $errMsg\n"); |
424 |
exit(1); |
425 |
} elsif ( $opts{d} ) { |
426 |
print(LOG $bpc->timeStamp, "$host is dhcp $hostIP, user is $user\n"); |
427 |
} |
428 |
|
429 |
# |
430 |
# Get a clean directory $Dir/new |
431 |
# |
432 |
$bpc->RmTreeDefer("$TopDir/trash", "$Dir/new") if ( -d "$Dir/new" ); |
433 |
|
434 |
# |
435 |
# Setup file extension for compression and open XferLOG output file |
436 |
# |
437 |
if ( $Conf{CompressLevel} && !BackupPC::FileZIO->compOk ) { |
438 |
print(LOG $bpc->timeStamp, "dump failed: can't find Compress::Zlib\n"); |
439 |
print("dump failed: can't find Compress::Zlib\n"); |
440 |
exit(1); |
441 |
} |
442 |
my $fileExt = $Conf{CompressLevel} > 0 ? ".z" : ""; |
443 |
my $XferLOG = BackupPC::FileZIO->open("$Dir/XferLOG$fileExt", 1, |
444 |
$Conf{CompressLevel}); |
445 |
if ( !defined($XferLOG) ) { |
446 |
print(LOG $bpc->timeStamp, "dump failed: unable to open/create" |
447 |
. " $Dir/XferLOG$fileExt\n"); |
448 |
print("dump failed: unable to open/create $Dir/XferLOG$fileExt\n"); |
449 |
exit(1); |
450 |
} |
451 |
|
452 |
# |
453 |
# Ignore the partial dump in the case of an incremental |
454 |
# or when the partial is too old. A partial is a partial full. |
455 |
# |
456 |
if ( $type ne "full" || time - $lastPartial > $Conf{PartialAgeMax} * 24*3600 ) { |
457 |
$partialNum = undef; |
458 |
$partialIdx = -1; |
459 |
} |
460 |
|
461 |
# |
462 |
# If this is a partial, copy the old XferLOG file |
463 |
# |
464 |
if ( $partialNum ) { |
465 |
my($compress, $fileName); |
466 |
if ( -f "$Dir/XferLOG.$partialNum.z" ) { |
467 |
$fileName = "$Dir/XferLOG.$partialNum.z"; |
468 |
$compress = 1; |
469 |
} elsif ( -f "$Dir/XferLOG.$partialNum" ) { |
470 |
$fileName = "$Dir/XferLOG.$partialNum"; |
471 |
$compress = 0; |
472 |
} |
473 |
if ( my $oldLOG = BackupPC::FileZIO->open($fileName, 0, $compress) ) { |
474 |
my $data; |
475 |
while ( $oldLOG->read(\$data, 65536) > 0 ) { |
476 |
$XferLOG->write(\$data); |
477 |
} |
478 |
$oldLOG->close; |
479 |
} |
480 |
} |
481 |
|
482 |
$XferLOG->writeTeeStderr(1) if ( $opts{v} ); |
483 |
unlink("$Dir/NewFileList") if ( -f "$Dir/NewFileList" ); |
484 |
|
485 |
my $startTime = time(); |
486 |
my $tarErrs = 0; |
487 |
my $nFilesExist = 0; |
488 |
my $sizeExist = 0; |
489 |
my $sizeExistComp = 0; |
490 |
my $nFilesTotal = 0; |
491 |
my $sizeTotal = 0; |
492 |
my($logMsg, %stat, $xfer, $ShareNames, $noFilesErr); |
493 |
my $newFilesFH; |
494 |
|
495 |
if ( $Conf{XferMethod} eq "tar" ) { |
496 |
$ShareNames = $Conf{TarShareName}; |
497 |
} elsif ( $Conf{XferMethod} eq "rsync" || $Conf{XferMethod} eq "rsyncd" ) { |
498 |
$ShareNames = $Conf{RsyncShareName}; |
499 |
} else { |
500 |
$ShareNames = $Conf{SmbShareName}; |
501 |
} |
502 |
|
503 |
$ShareNames = [ $ShareNames ] unless ref($ShareNames) eq "ARRAY"; |
504 |
|
505 |
# |
506 |
# Run an optional pre-dump command |
507 |
# |
508 |
UserCommandRun("DumpPreUserCmd"); |
509 |
$NeedPostCmd = 1; |
510 |
|
511 |
# |
512 |
# Now backup each of the shares |
513 |
# |
514 |
for my $shareName ( @$ShareNames ) { |
515 |
local(*RH, *WH); |
516 |
|
517 |
$stat{xferOK} = $stat{hostAbort} = undef; |
518 |
$stat{hostError} = $stat{lastOutputLine} = undef; |
519 |
if ( -d "$Dir/new/$shareName" ) { |
520 |
print(LOG $bpc->timeStamp, |
521 |
"unexpected repeated share name $shareName skipped\n"); |
522 |
next; |
523 |
} |
524 |
|
525 |
if ( $Conf{XferMethod} eq "tar" ) { |
526 |
# |
527 |
# Use tar (eg: tar/ssh) as the transport program. |
528 |
# |
529 |
$xfer = BackupPC::Xfer::Tar->new($bpc); |
530 |
} elsif ( $Conf{XferMethod} eq "rsync" || $Conf{XferMethod} eq "rsyncd" ) { |
531 |
# |
532 |
# Use rsync as the transport program. |
533 |
# |
534 |
if ( !defined($xfer = BackupPC::Xfer::Rsync->new($bpc)) ) { |
535 |
my $errStr = BackupPC::Xfer::Rsync::errStr; |
536 |
print(LOG $bpc->timeStamp, "dump failed: $errStr\n"); |
537 |
print("dump failed: $errStr\n"); |
538 |
UserCommandRun("DumpPostUserCmd") if ( $NeedPostCmd ); |
539 |
exit(1); |
540 |
} |
541 |
} else { |
542 |
# |
543 |
# Default is to use smbclient (smb) as the transport program. |
544 |
# |
545 |
$xfer = BackupPC::Xfer::Smb->new($bpc); |
546 |
} |
547 |
|
548 |
my $useTar = $xfer->useTar; |
549 |
|
550 |
if ( $useTar ) { |
551 |
# |
552 |
# This xfer method outputs a tar format file, so we start a |
553 |
# BackupPC_tarExtract to extract the data. |
554 |
# |
555 |
# Create a socketpair to connect the Xfer method to BackupPC_tarExtract |
556 |
# WH is the write handle for writing, provided to the transport |
557 |
# program, and RH is the other end of the socket for reading, |
558 |
# provided to BackupPC_tarExtract. |
559 |
# |
560 |
if ( socketpair(RH, WH, AF_UNIX, SOCK_STREAM, PF_UNSPEC) ) { |
561 |
shutdown(RH, 1); # no writing to this socket |
562 |
shutdown(WH, 0); # no reading from this socket |
563 |
setsockopt(RH, SOL_SOCKET, SO_RCVBUF, 8 * 65536); |
564 |
setsockopt(WH, SOL_SOCKET, SO_SNDBUF, 8 * 65536); |
565 |
} else { |
566 |
# |
567 |
# Default to pipe() if socketpair() doesn't work. |
568 |
# |
569 |
pipe(RH, WH); |
570 |
} |
571 |
|
572 |
# |
573 |
# fork a child for BackupPC_tarExtract. TAR is a file handle |
574 |
# on which we (the parent) read the stdout & stderr from |
575 |
# BackupPC_tarExtract. |
576 |
# |
577 |
if ( !defined($tarPid = open(TAR, "-|")) ) { |
578 |
print(LOG $bpc->timeStamp, "can't fork to run tar\n"); |
579 |
print("can't fork to run tar\n"); |
580 |
close(RH); |
581 |
close(WH); |
582 |
last; |
583 |
} |
584 |
binmode(TAR); |
585 |
if ( !$tarPid ) { |
586 |
# |
587 |
# This is the tar child. Close the write end of the pipe, |
588 |
# clone STDERR to STDOUT, clone STDIN from RH, and then |
589 |
# exec BackupPC_tarExtract. |
590 |
# |
591 |
setpgrp 0,0; |
592 |
close(WH); |
593 |
close(STDERR); |
594 |
open(STDERR, ">&STDOUT"); |
595 |
close(STDIN); |
596 |
open(STDIN, "<&RH"); |
597 |
alarm(0); |
598 |
exec("$BinDir/BackupPC_tarExtract", $client, $shareName, |
599 |
$Conf{CompressLevel}); |
600 |
print(LOG $bpc->timeStamp, |
601 |
"can't exec $BinDir/BackupPC_tarExtract\n"); |
602 |
exit(0); |
603 |
} |
604 |
} elsif ( !defined($newFilesFH) ) { |
605 |
# |
606 |
# We need to create the NewFileList output file |
607 |
# |
608 |
local(*NEW_FILES); |
609 |
open(NEW_FILES, ">", "$TopDir/pc/$client/NewFileList") |
610 |
|| die("can't open $TopDir/pc/$client/NewFileList"); |
611 |
$newFilesFH = *NEW_FILES; |
612 |
binmode(NEW_FILES); |
613 |
} |
614 |
|
615 |
# |
616 |
# Run the transport program |
617 |
# |
618 |
$xfer->args({ |
619 |
host => $host, |
620 |
client => $client, |
621 |
hostIP => $hostIP, |
622 |
shareName => $shareName, |
623 |
pipeRH => *RH, |
624 |
pipeWH => *WH, |
625 |
XferLOG => $XferLOG, |
626 |
newFilesFH => $newFilesFH, |
627 |
outDir => $Dir, |
628 |
type => $type, |
629 |
lastFull => $lastFull, |
630 |
lastBkupNum => $lastBkupNum, |
631 |
lastFullBkupNum => $lastFullBkupNum, |
632 |
backups => \@Backups, |
633 |
compress => $Conf{CompressLevel}, |
634 |
XferMethod => $Conf{XferMethod}, |
635 |
logLevel => $Conf{XferLogLevel}, |
636 |
pidHandler => \&pidHandler, |
637 |
partialNum => $partialNum, |
638 |
}); |
639 |
|
640 |
if ( !defined($logMsg = $xfer->start()) ) { |
641 |
print(LOG $bpc->timeStamp, "xfer start failed: ", $xfer->errStr, "\n"); |
642 |
print("dump failed: ", $xfer->errStr, "\n"); |
643 |
print("link $clientURI\n") if ( $needLink ); |
644 |
# |
645 |
# kill off the tar process, first nicely then forcefully |
646 |
# |
647 |
if ( $tarPid > 0 ) { |
648 |
kill($bpc->sigName2num("INT"), $tarPid); |
649 |
sleep(1); |
650 |
kill($bpc->sigName2num("KILL"), $tarPid); |
651 |
} |
652 |
if ( @xferPid ) { |
653 |
kill($bpc->sigName2num("INT"), @xferPid); |
654 |
sleep(1); |
655 |
kill($bpc->sigName2num("KILL"), @xferPid); |
656 |
} |
657 |
UserCommandRun("DumpPostUserCmd") if ( $NeedPostCmd ); |
658 |
exit(1); |
659 |
} |
660 |
|
661 |
@xferPid = $xfer->xferPid; |
662 |
|
663 |
if ( $useTar ) { |
664 |
# |
665 |
# The parent must close both handles on the pipe since the children |
666 |
# are using these handles now. |
667 |
# |
668 |
close(RH); |
669 |
close(WH); |
670 |
} |
671 |
print(LOG $bpc->timeStamp, $logMsg, "\n"); |
672 |
print("started $type dump, share=$shareName\n"); |
673 |
|
674 |
pidHandler(@xferPid); |
675 |
|
676 |
if ( $useTar ) { |
677 |
# |
678 |
# Parse the output of the transfer program and BackupPC_tarExtract |
679 |
# while they run. Since we might be reading from two or more children |
680 |
# we use a select. |
681 |
# |
682 |
my($FDread, $tarOut, $mesg); |
683 |
vec($FDread, fileno(TAR), 1) = 1 if ( $useTar ); |
684 |
$xfer->setSelectMask(\$FDread); |
685 |
|
686 |
SCAN: while ( 1 ) { |
687 |
my $ein = $FDread; |
688 |
last if ( $FDread =~ /^\0*$/ ); |
689 |
select(my $rout = $FDread, undef, $ein, undef); |
690 |
if ( $useTar ) { |
691 |
if ( vec($rout, fileno(TAR), 1) ) { |
692 |
if ( sysread(TAR, $mesg, 8192) <= 0 ) { |
693 |
vec($FDread, fileno(TAR), 1) = 0; |
694 |
close(TAR); |
695 |
} else { |
696 |
$tarOut .= $mesg; |
697 |
} |
698 |
} |
699 |
while ( $tarOut =~ /(.*?)[\n\r]+(.*)/s ) { |
700 |
$_ = $1; |
701 |
$tarOut = $2; |
702 |
if ( /^ / ) { |
703 |
$XferLOG->write(\"$_\n"); |
704 |
} else { |
705 |
$XferLOG->write(\"tarExtract: $_\n"); |
706 |
} |
707 |
if ( /^BackupPC_tarExtact aborting \((.*)\)/ ) { |
708 |
$stat{hostError} = $1; |
709 |
} |
710 |
if ( /^Done: (\d+) errors, (\d+) filesExist, (\d+) sizeExist, (\d+) sizeExistComp, (\d+) filesTotal, (\d+) sizeTotal/ ) { |
711 |
$tarErrs += $1; |
712 |
$nFilesExist += $2; |
713 |
$sizeExist += $3; |
714 |
$sizeExistComp += $4; |
715 |
$nFilesTotal += $5; |
716 |
$sizeTotal += $6; |
717 |
} |
718 |
} |
719 |
} |
720 |
last if ( !$xfer->readOutput(\$FDread, $rout) ); |
721 |
while ( my $str = $xfer->logMsgGet ) { |
722 |
print(LOG $bpc->timeStamp, "xfer: $str\n"); |
723 |
} |
724 |
if ( $xfer->getStats->{fileCnt} == 1 ) { |
725 |
# |
726 |
# Make sure it is still the machine we expect. We do this while |
727 |
# the transfer is running to avoid a potential race condition if |
728 |
# the ip address was reassigned by dhcp just before we started |
729 |
# the transfer. |
730 |
# |
731 |
if ( my $errMsg = CorrectHostCheck($hostIP, $host) ) { |
732 |
$stat{hostError} = $errMsg if ( $stat{hostError} eq "" ); |
733 |
last SCAN; |
734 |
} |
735 |
} |
736 |
} |
737 |
} else { |
738 |
# |
739 |
# otherwise the xfer module does everything for us |
740 |
# |
741 |
my @results = $xfer->run(); |
742 |
$tarErrs += $results[0]; |
743 |
$nFilesExist += $results[1]; |
744 |
$sizeExist += $results[2]; |
745 |
$sizeExistComp += $results[3]; |
746 |
$nFilesTotal += $results[4]; |
747 |
$sizeTotal += $results[5]; |
748 |
} |
749 |
|
750 |
# |
751 |
# Merge the xfer status (need to accumulate counts) |
752 |
# |
753 |
my $newStat = $xfer->getStats; |
754 |
if ( $newStat->{fileCnt} == 0 ) { |
755 |
$noFilesErr ||= "No files dumped for share $shareName"; |
756 |
} |
757 |
foreach my $k ( (keys(%stat), keys(%$newStat)) ) { |
758 |
next if ( !defined($newStat->{$k}) ); |
759 |
if ( $k =~ /Cnt$/ ) { |
760 |
$stat{$k} += $newStat->{$k}; |
761 |
delete($newStat->{$k}); |
762 |
next; |
763 |
} |
764 |
if ( !defined($stat{$k}) ) { |
765 |
$stat{$k} = $newStat->{$k}; |
766 |
delete($newStat->{$k}); |
767 |
next; |
768 |
} |
769 |
} |
770 |
$stat{xferOK} = 0 if ( $stat{hostError} || $stat{hostAbort} ); |
771 |
if ( !$stat{xferOK} ) { |
772 |
# |
773 |
# kill off the tranfer program, first nicely then forcefully |
774 |
# |
775 |
if ( @xferPid ) { |
776 |
kill($bpc->sigName2num("INT"), @xferPid); |
777 |
sleep(1); |
778 |
kill($bpc->sigName2num("KILL"), @xferPid); |
779 |
} |
780 |
# |
781 |
# kill off the tar process, first nicely then forcefully |
782 |
# |
783 |
if ( $tarPid > 0 ) { |
784 |
kill($bpc->sigName2num("INT"), $tarPid); |
785 |
sleep(1); |
786 |
kill($bpc->sigName2num("KILL"), $tarPid); |
787 |
} |
788 |
# |
789 |
# don't do any more shares on this host |
790 |
# |
791 |
last; |
792 |
} |
793 |
} |
794 |
|
795 |
# |
796 |
# If this is a full, and any share had zero files then consider the dump bad |
797 |
# |
798 |
if ( $type eq "full" && $stat{hostError} eq "" |
799 |
&& length($noFilesErr) && $Conf{BackupZeroFilesIsFatal} ) { |
800 |
$stat{hostError} = $noFilesErr; |
801 |
$stat{xferOK} = 0; |
802 |
} |
803 |
|
804 |
$stat{xferOK} = 0 if ( $Abort ); |
805 |
|
806 |
# |
807 |
# Do one last check to make sure it is still the machine we expect. |
808 |
# |
809 |
if ( $stat{xferOK} && (my $errMsg = CorrectHostCheck($hostIP, $host)) ) { |
810 |
$stat{hostError} = $errMsg; |
811 |
$stat{xferOK} = 0; |
812 |
} |
813 |
|
814 |
UserCommandRun("DumpPostUserCmd") if ( $NeedPostCmd ); |
815 |
close($newFilesFH) if ( defined($newFilesFH) ); |
816 |
|
817 |
my $endTime = time(); |
818 |
|
819 |
# |
820 |
# If the dump failed, clean up |
821 |
# |
822 |
if ( !$stat{xferOK} ) { |
823 |
$stat{hostError} = $stat{lastOutputLine} if ( $stat{hostError} eq "" ); |
824 |
if ( $stat{hostError} ) { |
825 |
print(LOG $bpc->timeStamp, |
826 |
"Got fatal error during xfer ($stat{hostError})\n"); |
827 |
$XferLOG->write(\"Got fatal error during xfer ($stat{hostError})\n"); |
828 |
} |
829 |
if ( !$Abort ) { |
830 |
# |
831 |
# wait a short while and see if the system is still alive |
832 |
# |
833 |
sleep(5); |
834 |
if ( $bpc->CheckHostAlive($hostIP) < 0 ) { |
835 |
$stat{hostAbort} = 1; |
836 |
} |
837 |
if ( $stat{hostAbort} ) { |
838 |
$stat{hostError} = "lost network connection during backup"; |
839 |
} |
840 |
print(LOG $bpc->timeStamp, "Backup aborted ($stat{hostError})\n"); |
841 |
$XferLOG->write(\"Backup aborted ($stat{hostError})\n"); |
842 |
} else { |
843 |
$XferLOG->write(\"Backup aborted by user signal\n"); |
844 |
} |
845 |
|
846 |
# |
847 |
# Close the log file and call BackupFailCleanup, which exits. |
848 |
# |
849 |
BackupFailCleanup(); |
850 |
} |
851 |
|
852 |
my $newNum = BackupSave(); |
853 |
|
854 |
my $otherCount = $stat{xferErrCnt} - $stat{xferBadFileCnt} |
855 |
- $stat{xferBadShareCnt}; |
856 |
print(LOG $bpc->timeStamp, |
857 |
"$type backup $newNum complete, $stat{fileCnt} files," |
858 |
. " $stat{byteCnt} bytes," |
859 |
. " $stat{xferErrCnt} xferErrs ($stat{xferBadFileCnt} bad files," |
860 |
. " $stat{xferBadShareCnt} bad shares, $otherCount other)\n"); |
861 |
|
862 |
BackupExpire($client); |
863 |
|
864 |
print("$type backup complete\n"); |
865 |
|
866 |
########################################################################### |
867 |
# Subroutines |
868 |
########################################################################### |
869 |
|
870 |
sub NothingToDo |
871 |
{ |
872 |
my($needLink) = @_; |
873 |
|
874 |
print("nothing to do\n"); |
875 |
print("link $clientURI\n") if ( $needLink ); |
876 |
exit(0); |
877 |
} |
878 |
|
879 |
sub catch_signal |
880 |
{ |
881 |
my $sigName = shift; |
882 |
|
883 |
# |
884 |
# The first time we receive a signal we try to gracefully |
885 |
# abort the backup. This allows us to keep a partial dump |
886 |
# with the in-progress file deleted and attribute caches |
887 |
# flushed to disk etc. |
888 |
# |
889 |
if ( !length($SigName) ) { |
890 |
my $reason; |
891 |
if ( $sigName eq "INT" ) { |
892 |
$reason = "aborted by user (signal=$sigName)"; |
893 |
} else { |
894 |
$reason = "aborted by signal=$sigName"; |
895 |
} |
896 |
if ( $Pid == $$ ) { |
897 |
# |
898 |
# Parent logs a message |
899 |
# |
900 |
print(LOG $bpc->timeStamp, |
901 |
"Aborting backup up after signal $sigName\n"); |
902 |
|
903 |
# |
904 |
# Tell xfer to abort |
905 |
# |
906 |
$xfer->abort($reason); |
907 |
|
908 |
# |
909 |
# Send ALRMs to BackupPC_tarExtract if we are using it |
910 |
# |
911 |
if ( $tarPid > 0 ) { |
912 |
kill($bpc->sigName2num("ARLM"), $tarPid); |
913 |
} |
914 |
|
915 |
# |
916 |
# Schedule a 20 second timer in case the clean |
917 |
# abort doesn't complete |
918 |
# |
919 |
alarm(20); |
920 |
} else { |
921 |
# |
922 |
# Children ignore anything other than ALRM and INT |
923 |
# |
924 |
if ( $sigName ne "ALRM" && $sigName ne "INT" ) { |
925 |
return; |
926 |
} |
927 |
|
928 |
# |
929 |
# The child also tells xfer to abort |
930 |
# |
931 |
$xfer->abort($reason); |
932 |
|
933 |
# |
934 |
# Schedule a 15 second timer in case the clean |
935 |
# abort doesn't complete |
936 |
# |
937 |
alarm(15); |
938 |
} |
939 |
$SigName = $sigName; |
940 |
$Abort = 1; |
941 |
return; |
942 |
} |
943 |
|
944 |
# |
945 |
# This is a second signal: time to clean up. |
946 |
# |
947 |
if ( $Pid != $$ && ($sigName eq "ALRM" || $sigName eq "INT") ) { |
948 |
# |
949 |
# Children quit quietly on ALRM or INT |
950 |
# |
951 |
exit(1) |
952 |
} |
953 |
|
954 |
# |
955 |
# Ignore other signals in children |
956 |
# |
957 |
return if ( $Pid != $$ ); |
958 |
|
959 |
$SIG{$sigName} = 'IGNORE'; |
960 |
UserCommandRun("DumpPostUserCmd") if ( $NeedPostCmd ); |
961 |
$XferLOG->write(\"exiting after signal $sigName\n"); |
962 |
if ( @xferPid ) { |
963 |
kill($bpc->sigName2num("INT"), @xferPid); |
964 |
sleep(1); |
965 |
kill($bpc->sigName2num("KILL"), @xferPid); |
966 |
} |
967 |
if ( $tarPid > 0 ) { |
968 |
kill($bpc->sigName2num("INT"), $tarPid); |
969 |
sleep(1); |
970 |
kill($bpc->sigName2num("KILL"), $tarPid); |
971 |
} |
972 |
if ( $sigName eq "INT" ) { |
973 |
$stat{hostError} = "aborted by user (signal=$sigName)"; |
974 |
} else { |
975 |
$stat{hostError} = "received signal=$sigName"; |
976 |
} |
977 |
BackupFailCleanup(); |
978 |
} |
979 |
|
980 |
sub CheckForNewFiles |
981 |
{ |
982 |
if ( -f _ && $File::Find::name !~ /\/fattrib$/ ) { |
983 |
$nFilesTotal++; |
984 |
} elsif ( -d _ ) { |
985 |
# |
986 |
# No need to check entire tree |
987 |
# |
988 |
$File::Find::prune = 1 if ( $nFilesTotal ); |
989 |
} |
990 |
} |
991 |
|
992 |
sub BackupFailCleanup |
993 |
{ |
994 |
my $fileExt = $Conf{CompressLevel} > 0 ? ".z" : ""; |
995 |
my $keepPartial = 0; |
996 |
|
997 |
# |
998 |
# We keep this backup if it is a full and we actually backed |
999 |
# up some files. |
1000 |
# |
1001 |
if ( $type eq "full" ) { |
1002 |
if ( $nFilesTotal == 0 && $xfer->getStats->{fileCnt} == 0 ) { |
1003 |
# |
1004 |
# Xfer didn't report any files, but check in the new |
1005 |
# directory just in case. |
1006 |
# |
1007 |
find(\&CheckForNewFiles, "$Dir/new"); |
1008 |
$keepPartial = 1 if ( $nFilesTotal ); |
1009 |
} else { |
1010 |
# |
1011 |
# Xfer reported some files |
1012 |
# |
1013 |
$keepPartial = 1; |
1014 |
} |
1015 |
} |
1016 |
|
1017 |
# |
1018 |
# Don't keep partials if they are disabled |
1019 |
# |
1020 |
$keepPartial = 0 if ( $Conf{PartialAgeMax} < 0 ); |
1021 |
|
1022 |
if ( !$keepPartial ) { |
1023 |
# |
1024 |
# No point in saving this dump; get rid of eveything. |
1025 |
# |
1026 |
$XferLOG->close(); |
1027 |
unlink("$Dir/timeStamp.level0") if ( -f "$Dir/timeStamp.level0" ); |
1028 |
unlink("$Dir/SmbLOG.bad") if ( -f "$Dir/SmbLOG.bad" ); |
1029 |
unlink("$Dir/SmbLOG.bad$fileExt") if ( -f "$Dir/SmbLOG.bad$fileExt" ); |
1030 |
unlink("$Dir/XferLOG.bad") if ( -f "$Dir/XferLOG.bad" ); |
1031 |
unlink("$Dir/XferLOG.bad$fileExt") if ( -f "$Dir/XferLOG.bad$fileExt" ); |
1032 |
unlink("$Dir/NewFileList") if ( -f "$Dir/NewFileList" ); |
1033 |
rename("$Dir/XferLOG$fileExt", "$Dir/XferLOG.bad$fileExt"); |
1034 |
$bpc->RmTreeDefer("$TopDir/trash", "$Dir/new") if ( -d "$Dir/new" ); |
1035 |
print("dump failed: $stat{hostError}\n"); |
1036 |
$XferLOG->close(); |
1037 |
print("link $clientURI\n") if ( $needLink ); |
1038 |
exit(1); |
1039 |
} |
1040 |
# |
1041 |
# Ok, now we should save this as a partial dump |
1042 |
# |
1043 |
$type = "partial"; |
1044 |
my $newNum = BackupSave(); |
1045 |
print("dump failed: $stat{hostError}\n"); |
1046 |
print("link $clientURI\n") if ( $needLink ); |
1047 |
print(LOG $bpc->timeStamp, "Saved partial dump $newNum\n"); |
1048 |
exit(2); |
1049 |
} |
1050 |
|
1051 |
# |
1052 |
# Decide which old backups should be expired by moving them |
1053 |
# to $TopDir/trash. |
1054 |
# |
1055 |
sub BackupExpire |
1056 |
{ |
1057 |
my($client) = @_; |
1058 |
my($Dir) = "$TopDir/pc/$client"; |
1059 |
my(@Backups) = $bpc->BackupInfoRead($client); |
1060 |
my($cntFull, $cntIncr, $firstFull, $firstIncr, $oldestIncr, $oldestFull); |
1061 |
|
1062 |
if ( $Conf{FullKeepCnt} <= 0 ) { |
1063 |
print(LOG $bpc->timeStamp, |
1064 |
"Invalid value for \$Conf{FullKeepCnt}=$Conf{FullKeepCnt}\n"); |
1065 |
print(STDERR |
1066 |
"Invalid value for \$Conf{FullKeepCnt}=$Conf{FullKeepCnt}\n") |
1067 |
if ( $opts{v} ); |
1068 |
return; |
1069 |
} |
1070 |
while ( 1 ) { |
1071 |
$cntFull = $cntIncr = 0; |
1072 |
$oldestIncr = $oldestFull = 0; |
1073 |
for ( my $i = 0 ; $i < @Backups ; $i++ ) { |
1074 |
if ( $Backups[$i]{type} eq "full" ) { |
1075 |
$firstFull = $i if ( $cntFull == 0 ); |
1076 |
$cntFull++; |
1077 |
} else { |
1078 |
$firstIncr = $i if ( $cntIncr == 0 ); |
1079 |
$cntIncr++; |
1080 |
} |
1081 |
} |
1082 |
$oldestIncr = (time - $Backups[$firstIncr]{startTime}) / (24 * 3600) |
1083 |
if ( $cntIncr > 0 ); |
1084 |
$oldestFull = (time - $Backups[$firstFull]{startTime}) / (24 * 3600) |
1085 |
if ( $cntFull > 0 ); |
1086 |
if ( $cntIncr > $Conf{IncrKeepCnt} |
1087 |
|| ($cntIncr > $Conf{IncrKeepCntMin} |
1088 |
&& $oldestIncr > $Conf{IncrAgeMax}) |
1089 |
&& (@Backups <= $firstIncr + 1 |
1090 |
|| $Backups[$firstIncr]{noFill} |
1091 |
|| !$Backups[$firstIncr + 1]{noFill}) ) { |
1092 |
# |
1093 |
# Only delete an incr backup if the Conf settings are satisfied. |
1094 |
# We also must make sure that either this backup is the most |
1095 |
# recent one, or it is not filled, or the next backup is filled. |
1096 |
# (We can't deleted a filled incr if the next backup is not |
1097 |
# filled.) |
1098 |
# |
1099 |
print(LOG $bpc->timeStamp, |
1100 |
"removing incr backup $Backups[$firstIncr]{num}\n"); |
1101 |
BackupRemove($client, \@Backups, $firstIncr); |
1102 |
next; |
1103 |
} |
1104 |
|
1105 |
# |
1106 |
# Delete any old full backups, according to $Conf{FullKeepCntMin} |
1107 |
# and $Conf{FullAgeMax}. |
1108 |
# |
1109 |
# First make sure that $Conf{FullAgeMax} is at least bigger |
1110 |
# than $Conf{FullPeriod} * $Conf{FullKeepCnt}, including |
1111 |
# the exponential array case. |
1112 |
# |
1113 |
my $fullKeepCnt = $Conf{FullKeepCnt}; |
1114 |
$fullKeepCnt = [$fullKeepCnt] if ( ref($fullKeepCnt) ne "ARRAY" ); |
1115 |
my $fullAgeMax; |
1116 |
my $fullPeriod = int(0.5 + $Conf{FullPeriod}); |
1117 |
$fullPeriod = 7 if ( $fullPeriod <= 0 ); |
1118 |
for ( my $i = 0 ; $i < @$fullKeepCnt ; $i++ ) { |
1119 |
$fullAgeMax += $fullKeepCnt->[$i] * $fullPeriod; |
1120 |
$fullPeriod *= 2; |
1121 |
} |
1122 |
$fullAgeMax += $fullPeriod; # add some buffer |
1123 |
|
1124 |
if ( $cntFull > $Conf{FullKeepCntMin} |
1125 |
&& $oldestFull > $Conf{FullAgeMax} |
1126 |
&& $oldestFull > $fullAgeMax |
1127 |
&& $Conf{FullKeepCntMin} > 0 |
1128 |
&& $Conf{FullAgeMax} > 0 |
1129 |
&& (@Backups <= $firstFull + 1 |
1130 |
|| !$Backups[$firstFull + 1]{noFill}) ) { |
1131 |
# |
1132 |
# Only delete a full backup if the Conf settings are satisfied. |
1133 |
# We also must make sure that either this backup is the most |
1134 |
# recent one, or the next backup is filled. |
1135 |
# (We can't deleted a full backup if the next backup is not |
1136 |
# filled.) |
1137 |
# |
1138 |
print(LOG $bpc->timeStamp, |
1139 |
"removing old full backup $Backups[$firstFull]{num}\n"); |
1140 |
BackupRemove($client, \@Backups, $firstFull); |
1141 |
next; |
1142 |
} |
1143 |
|
1144 |
# |
1145 |
# Do new-style full backup expiry, which includes the the case |
1146 |
# where $Conf{FullKeepCnt} is an array. |
1147 |
# |
1148 |
last if ( !BackupFullExpire($client, \@Backups) ); |
1149 |
} |
1150 |
$bpc->BackupInfoWrite($client, @Backups); |
1151 |
} |
1152 |
|
1153 |
# |
1154 |
# Handle full backup expiry, using exponential periods. |
1155 |
# |
1156 |
sub BackupFullExpire |
1157 |
{ |
1158 |
my($client, $Backups) = @_; |
1159 |
my $fullCnt = 0; |
1160 |
my $fullPeriod = $Conf{FullPeriod}; |
1161 |
my $origFullPeriod = $fullPeriod; |
1162 |
my $fullKeepCnt = $Conf{FullKeepCnt}; |
1163 |
my $fullKeepIdx = 0; |
1164 |
my(@delete, @fullList); |
1165 |
|
1166 |
# |
1167 |
# Don't delete anything if $Conf{FullPeriod} or $Conf{FullKeepCnt} are |
1168 |
# not defined - possibly a corrupted config.pl file. |
1169 |
# |
1170 |
return if ( !defined($Conf{FullPeriod}) || !defined($Conf{FullKeepCnt}) ); |
1171 |
|
1172 |
# |
1173 |
# If regular backups are still disabled with $Conf{FullPeriod} < 0, |
1174 |
# we still expire backups based on a typical FullPeriod value - weekly. |
1175 |
# |
1176 |
$fullPeriod = 7 if ( $fullPeriod <= 0 ); |
1177 |
|
1178 |
$fullKeepCnt = [$fullKeepCnt] if ( ref($fullKeepCnt) ne "ARRAY" ); |
1179 |
|
1180 |
for ( my $i = 0 ; $i < @$Backups ; $i++ ) { |
1181 |
next if ( $Backups->[$i]{type} ne "full" ); |
1182 |
push(@fullList, $i); |
1183 |
} |
1184 |
for ( my $k = @fullList - 1 ; $k >= 0 ; $k-- ) { |
1185 |
my $i = $fullList[$k]; |
1186 |
my $prevFull = $fullList[$k-1] if ( $k > 0 ); |
1187 |
# |
1188 |
# Don't delete any full that is followed by an unfilled backup, |
1189 |
# since it is needed for restore. |
1190 |
# |
1191 |
my $noDelete = $i + 1 < @$Backups ? $Backups->[$i+1]{noFill} : 0; |
1192 |
|
1193 |
if ( !$noDelete && |
1194 |
($fullKeepIdx >= @$fullKeepCnt |
1195 |
|| $k > 0 |
1196 |
&& $fullKeepIdx > 0 |
1197 |
&& $Backups->[$i]{startTime} - $Backups->[$prevFull]{startTime} |
1198 |
< ($fullPeriod - $origFullPeriod / 2) * 24 * 3600 |
1199 |
) |
1200 |
) { |
1201 |
# |
1202 |
# Delete the full backup |
1203 |
# |
1204 |
#print("Deleting backup $i ($prevFull)\n"); |
1205 |
unshift(@delete, $i); |
1206 |
} else { |
1207 |
$fullCnt++; |
1208 |
while ( $fullKeepIdx < @$fullKeepCnt |
1209 |
&& $fullCnt >= $fullKeepCnt->[$fullKeepIdx] ) { |
1210 |
$fullKeepIdx++; |
1211 |
$fullCnt = 0; |
1212 |
$fullPeriod = 2 * $fullPeriod; |
1213 |
} |
1214 |
} |
1215 |
} |
1216 |
# |
1217 |
# Now actually delete the backups |
1218 |
# |
1219 |
for ( my $i = @delete - 1 ; $i >= 0 ; $i-- ) { |
1220 |
print(LOG $bpc->timeStamp, |
1221 |
"removing full backup $Backups->[$delete[$i]]{num}\n"); |
1222 |
BackupRemove($client, $Backups, $delete[$i]); |
1223 |
} |
1224 |
return @delete; |
1225 |
} |
1226 |
|
1227 |
# |
1228 |
# Removes any partial backups |
1229 |
# |
1230 |
sub BackupPartialRemove |
1231 |
{ |
1232 |
my($client, $Backups) = @_; |
1233 |
|
1234 |
for ( my $i = @$Backups - 1 ; $i >= 0 ; $i-- ) { |
1235 |
next if ( $Backups->[$i]{type} ne "partial" ); |
1236 |
BackupRemove($client, $Backups, $i); |
1237 |
} |
1238 |
} |
1239 |
|
1240 |
sub BackupSave |
1241 |
{ |
1242 |
my @Backups = $bpc->BackupInfoRead($client); |
1243 |
my $num = -1; |
1244 |
|
1245 |
# |
1246 |
# Since we got a good backup we should remove any partial dumps |
1247 |
# (the new backup might also be a partial, but that's ok). |
1248 |
# |
1249 |
BackupPartialRemove($client, \@Backups); |
1250 |
|
1251 |
# |
1252 |
# Number the new backup |
1253 |
# |
1254 |
for ( my $i = 0 ; $i < @Backups ; $i++ ) { |
1255 |
$num = $Backups[$i]{num} if ( $num < $Backups[$i]{num} ); |
1256 |
} |
1257 |
$num++; |
1258 |
$bpc->RmTreeDefer("$TopDir/trash", "$Dir/$num") if ( -d "$Dir/$num" ); |
1259 |
if ( !rename("$Dir/new", "$Dir/$num") ) { |
1260 |
print(LOG $bpc->timeStamp, "Rename $Dir/new -> $Dir/$num failed\n"); |
1261 |
$stat{xferOK} = 0; |
1262 |
} |
1263 |
$needLink = 1 if ( -f "$Dir/NewFileList" ); |
1264 |
|
1265 |
# |
1266 |
# Add the new backup information to the backup file |
1267 |
# |
1268 |
my $i = @Backups; |
1269 |
$Backups[$i]{num} = $num; |
1270 |
$Backups[$i]{type} = $type; |
1271 |
$Backups[$i]{startTime} = $startTime; |
1272 |
$Backups[$i]{endTime} = $endTime; |
1273 |
$Backups[$i]{size} = $sizeTotal; |
1274 |
$Backups[$i]{nFiles} = $nFilesTotal; |
1275 |
$Backups[$i]{xferErrs} = $stat{xferErrCnt} || 0; |
1276 |
$Backups[$i]{xferBadFile} = $stat{xferBadFileCnt} || 0; |
1277 |
$Backups[$i]{xferBadShare} = $stat{xferBadShareCnt} || 0; |
1278 |
$Backups[$i]{nFilesExist} = $nFilesExist; |
1279 |
$Backups[$i]{sizeExist} = $sizeExist; |
1280 |
$Backups[$i]{sizeExistComp} = $sizeExistComp; |
1281 |
$Backups[$i]{tarErrs} = $tarErrs; |
1282 |
$Backups[$i]{compress} = $Conf{CompressLevel}; |
1283 |
$Backups[$i]{noFill} = $type eq "incr" ? 1 : 0; |
1284 |
$Backups[$i]{level} = $type eq "incr" ? 1 : 0; |
1285 |
$Backups[$i]{mangle} = 1; # name mangling always on for v1.04+ |
1286 |
$bpc->BackupInfoWrite($client, @Backups); |
1287 |
|
1288 |
unlink("$Dir/timeStamp.level0") if ( -f "$Dir/timeStamp.level0" ); |
1289 |
foreach my $ext ( qw(bad bad.z) ) { |
1290 |
next if ( !-f "$Dir/XferLOG.$ext" ); |
1291 |
unlink("$Dir/XferLOG.$ext.old") if ( -f "$Dir/XferLOG.$ext" ); |
1292 |
rename("$Dir/XferLOG.$ext", "$Dir/XferLOG.$ext.old"); |
1293 |
} |
1294 |
|
1295 |
# |
1296 |
# Now remove the bad files, replacing them if possible with links to |
1297 |
# earlier backups. |
1298 |
# |
1299 |
foreach my $f ( $xfer->getBadFiles ) { |
1300 |
my $j; |
1301 |
my $shareM = $bpc->fileNameEltMangle($f->{share}); |
1302 |
my $fileM = $bpc->fileNameMangle($f->{file}); |
1303 |
unlink("$Dir/$num/$shareM/$fileM"); |
1304 |
for ( $j = $i - 1 ; $j >= 0 ; $j-- ) { |
1305 |
my $file; |
1306 |
if ( $Backups[$j]{mangle} ) { |
1307 |
$file = "$shareM/$fileM"; |
1308 |
} else { |
1309 |
$file = "$f->{share}/$f->{file}"; |
1310 |
} |
1311 |
next if ( !-f "$Dir/$Backups[$j]{num}/$file" ); |
1312 |
if ( !link("$Dir/$Backups[$j]{num}/$file", |
1313 |
"$Dir/$num/$shareM/$fileM") ) { |
1314 |
my $str = \"Unable to link $num/$f->{share}/$f->{file} to" |
1315 |
. " $Backups[$j]{num}/$f->{share}/$f->{file}\n"; |
1316 |
$XferLOG->write(\$str); |
1317 |
} else { |
1318 |
my $str = "Bad file $num/$f->{share}/$f->{file} replaced" |
1319 |
. " by link to" |
1320 |
. " $Backups[$j]{num}/$f->{share}/$f->{file}\n"; |
1321 |
$XferLOG->write(\$str); |
1322 |
} |
1323 |
last; |
1324 |
} |
1325 |
if ( $j < 0 ) { |
1326 |
my $str = "Removed bad file $num/$f->{share}/$f->{file}" |
1327 |
. " (no older copy to link to)\n"; |
1328 |
$XferLOG->write(\$str); |
1329 |
} |
1330 |
} |
1331 |
$XferLOG->close(); |
1332 |
rename("$Dir/XferLOG$fileExt", "$Dir/XferLOG.$num$fileExt"); |
1333 |
rename("$Dir/NewFileList", "$Dir/NewFileList.$num"); |
1334 |
|
1335 |
return $num; |
1336 |
} |
1337 |
|
1338 |
# |
1339 |
# Removes a specific backup |
1340 |
# |
1341 |
sub BackupRemove |
1342 |
{ |
1343 |
my($client, $Backups, $idx) = @_; |
1344 |
my($Dir) = "$TopDir/pc/$client"; |
1345 |
|
1346 |
if ( $Backups->[$idx]{num} eq "" ) { |
1347 |
print("BackupRemove: ignoring empty backup number for idx $idx\n"); |
1348 |
return; |
1349 |
} |
1350 |
|
1351 |
$bpc->RmTreeDefer("$TopDir/trash", |
1352 |
"$Dir/$Backups->[$idx]{num}"); |
1353 |
unlink("$Dir/SmbLOG.$Backups->[$idx]{num}") |
1354 |
if ( -f "$Dir/SmbLOG.$Backups->[$idx]{num}" ); |
1355 |
unlink("$Dir/SmbLOG.$Backups->[$idx]{num}.z") |
1356 |
if ( -f "$Dir/SmbLOG.$Backups->[$idx]{num}.z" ); |
1357 |
unlink("$Dir/XferLOG.$Backups->[$idx]{num}") |
1358 |
if ( -f "$Dir/XferLOG.$Backups->[$idx]{num}" ); |
1359 |
unlink("$Dir/XferLOG.$Backups->[$idx]{num}.z") |
1360 |
if ( -f "$Dir/XferLOG.$Backups->[$idx]{num}.z" ); |
1361 |
splice(@{$Backups}, $idx, 1); |
1362 |
} |
1363 |
|
1364 |
sub CorrectHostCheck |
1365 |
{ |
1366 |
my($hostIP, $host) = @_; |
1367 |
return if ( $hostIP eq $host && !$Conf{FixedIPNetBiosNameCheck} |
1368 |
|| $Conf{NmbLookupCmd} eq "" ); |
1369 |
my($netBiosHost, $netBiosUser) = $bpc->NetBiosInfoGet($hostIP); |
1370 |
return "host $host has mismatching netbios name $netBiosHost" |
1371 |
if ( $netBiosHost ne $host ); |
1372 |
return; |
1373 |
} |
1374 |
|
1375 |
# |
1376 |
# The Xfer method might tell us from time to time about processes |
1377 |
# it forks. We tell BackupPC about this (for status displays) and |
1378 |
# keep track of the pids in case we cancel the backup |
1379 |
# |
1380 |
sub pidHandler |
1381 |
{ |
1382 |
@xferPid = @_; |
1383 |
@xferPid = grep(/./, @xferPid); |
1384 |
return if ( !@xferPid && $tarPid < 0 ); |
1385 |
my @pids = @xferPid; |
1386 |
push(@pids, $tarPid) if ( $tarPid > 0 ); |
1387 |
my $str = join(",", @pids); |
1388 |
$XferLOG->write(\"Xfer PIDs are now $str\n") if ( defined($XferLOG) ); |
1389 |
print("xferPids $str\n"); |
1390 |
} |
1391 |
|
1392 |
# |
1393 |
# Run an optional pre- or post-dump command |
1394 |
# |
1395 |
sub UserCommandRun |
1396 |
{ |
1397 |
my($cmdType) = @_; |
1398 |
|
1399 |
return if ( !defined($Conf{$cmdType}) ); |
1400 |
my $vars = { |
1401 |
xfer => $xfer, |
1402 |
client => $client, |
1403 |
host => $host, |
1404 |
hostIP => $hostIP, |
1405 |
user => $Hosts->{$client}{user}, |
1406 |
moreUsers => $Hosts->{$client}{moreUsers}, |
1407 |
share => $ShareNames->[0], |
1408 |
shares => $ShareNames, |
1409 |
XferMethod => $Conf{XferMethod}, |
1410 |
sshPath => $Conf{SshPath}, |
1411 |
LOG => *LOG, |
1412 |
XferLOG => $XferLOG, |
1413 |
stat => \%stat, |
1414 |
xferOK => $stat{xferOK} || 0, |
1415 |
hostError => $stat{hostError}, |
1416 |
type => $type, |
1417 |
cmdType => $cmdType, |
1418 |
}; |
1419 |
my $cmd = $bpc->cmdVarSubstitute($Conf{$cmdType}, $vars); |
1420 |
$XferLOG->write(\"Executing $cmdType: @$cmd\n"); |
1421 |
# |
1422 |
# Run the user's command, dumping the stdout/stderr into the |
1423 |
# Xfer log file. Also supply the optional $vars and %Conf in |
1424 |
# case the command is really perl code instead of a shell |
1425 |
# command. |
1426 |
# |
1427 |
$bpc->cmdSystemOrEval($cmd, |
1428 |
sub { |
1429 |
$XferLOG->write(\$_[0]); |
1430 |
}, |
1431 |
$vars, \%Conf); |
1432 |
} |