| 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 |
} |
Parent Directory
| 
Revision Log