Various changes, including changes in 2.1.1 and 2.1.2 releases.
[BackupPC.git] / bin / BackupPC_dump
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.0, released 20 Jun 2004.
74 #
75 # See http://backuppc.sourceforge.net.
76 #
77 #========================================================================
78
79 use strict;
80 no  utf8;
81 use lib "/usr/local/BackupPC/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     UserCommandRun("DumpPreShareCmd", $shareName);
526
527     if ( $Conf{XferMethod} eq "tar" ) {
528         #
529         # Use tar (eg: tar/ssh) as the transport program.
530         #
531         $xfer = BackupPC::Xfer::Tar->new($bpc);
532     } elsif ( $Conf{XferMethod} eq "rsync" || $Conf{XferMethod} eq "rsyncd" ) {
533         #
534         # Use rsync as the transport program.
535         #
536         if ( !defined($xfer = BackupPC::Xfer::Rsync->new($bpc)) ) {
537             my $errStr = BackupPC::Xfer::Rsync::errStr;
538             print(LOG $bpc->timeStamp, "dump failed: $errStr\n");
539             print("dump failed: $errStr\n");
540             UserCommandRun("DumpPostShareCmd", $shareName) if ( $NeedPostCmd );
541             UserCommandRun("DumpPostUserCmd") if ( $NeedPostCmd );
542             exit(1);
543         }
544     } else {
545         #
546         # Default is to use smbclient (smb) as the transport program.
547         #
548         $xfer = BackupPC::Xfer::Smb->new($bpc);
549     }
550
551     my $useTar = $xfer->useTar;
552
553     if ( $useTar ) {
554         #
555         # This xfer method outputs a tar format file, so we start a
556         # BackupPC_tarExtract to extract the data.
557         #
558         # Create a socketpair to connect the Xfer method to BackupPC_tarExtract
559         # WH is the write handle for writing, provided to the transport
560         # program, and RH is the other end of the socket for reading,
561         # provided to BackupPC_tarExtract.
562         #
563         if ( socketpair(RH, WH, AF_UNIX, SOCK_STREAM, PF_UNSPEC) ) {
564             shutdown(RH, 1);    # no writing to this socket
565             shutdown(WH, 0);    # no reading from this socket
566             setsockopt(RH, SOL_SOCKET, SO_RCVBUF, 8 * 65536);
567             setsockopt(WH, SOL_SOCKET, SO_SNDBUF, 8 * 65536);
568         } else {
569             #
570             # Default to pipe() if socketpair() doesn't work.
571             #
572             pipe(RH, WH);
573         }
574
575         #
576         # fork a child for BackupPC_tarExtract.  TAR is a file handle
577         # on which we (the parent) read the stdout & stderr from
578         # BackupPC_tarExtract.
579         #
580         if ( !defined($tarPid = open(TAR, "-|")) ) {
581             print(LOG $bpc->timeStamp, "can't fork to run tar\n");
582             print("can't fork to run tar\n");
583             close(RH);
584             close(WH);
585             last;
586         }
587         binmode(TAR);
588         if ( !$tarPid ) {
589             #
590             # This is the tar child.  Close the write end of the pipe,
591             # clone STDERR to STDOUT, clone STDIN from RH, and then
592             # exec BackupPC_tarExtract.
593             #
594             setpgrp 0,0;
595             close(WH);
596             close(STDERR);
597             open(STDERR, ">&STDOUT");
598             close(STDIN);
599             open(STDIN, "<&RH");
600             alarm(0);
601             exec("$BinDir/BackupPC_tarExtract", $client, $shareName,
602                          $Conf{CompressLevel});
603             print(LOG $bpc->timeStamp,
604                         "can't exec $BinDir/BackupPC_tarExtract\n");
605             exit(0);
606         }
607     } elsif ( !defined($newFilesFH) ) {
608         #
609         # We need to create the NewFileList output file
610         #
611         local(*NEW_FILES);
612         open(NEW_FILES, ">", "$TopDir/pc/$client/NewFileList")
613                      || die("can't open $TopDir/pc/$client/NewFileList");
614         $newFilesFH = *NEW_FILES;
615         binmode(NEW_FILES);
616     }
617
618     #
619     # Run the transport program
620     #
621     $xfer->args({
622         host        => $host,
623         client      => $client,
624         hostIP      => $hostIP,
625         shareName   => $shareName,
626         pipeRH      => *RH,
627         pipeWH      => *WH,
628         XferLOG     => $XferLOG,
629         newFilesFH  => $newFilesFH,
630         outDir      => $Dir,
631         type        => $type,
632         lastFull    => $lastFull,
633         lastBkupNum => $lastBkupNum,
634         lastFullBkupNum => $lastFullBkupNum,
635         backups     => \@Backups,
636         compress    => $Conf{CompressLevel},
637         XferMethod  => $Conf{XferMethod},
638         logLevel    => $Conf{XferLogLevel},
639         pidHandler  => \&pidHandler,
640         partialNum  => $partialNum,
641     });
642
643     if ( !defined($logMsg = $xfer->start()) ) {
644         print(LOG $bpc->timeStamp, "xfer start failed: ", $xfer->errStr, "\n");
645         print("dump failed: ", $xfer->errStr, "\n");
646         print("link $clientURI\n") if ( $needLink );
647         #
648         # kill off the tar process, first nicely then forcefully
649         #
650         if ( $tarPid > 0 ) {
651             kill($bpc->sigName2num("INT"), $tarPid);
652             sleep(1);
653             kill($bpc->sigName2num("KILL"), $tarPid);
654         }
655         if ( @xferPid ) {
656             kill($bpc->sigName2num("INT"), @xferPid);
657             sleep(1);
658             kill($bpc->sigName2num("KILL"), @xferPid);
659         }
660         UserCommandRun("DumpPostShareCmd", $shareName) if ( $NeedPostCmd );
661         UserCommandRun("DumpPostUserCmd") if ( $NeedPostCmd );
662         exit(1);
663     }
664
665     @xferPid = $xfer->xferPid;
666
667     if ( $useTar ) {
668         #
669         # The parent must close both handles on the pipe since the children
670         # are using these handles now.
671         #
672         close(RH);
673         close(WH);
674     }
675     print(LOG $bpc->timeStamp, $logMsg, "\n");
676     print("started $type dump, share=$shareName\n");
677
678     pidHandler(@xferPid);
679
680     if ( $useTar ) {
681         #
682         # Parse the output of the transfer program and BackupPC_tarExtract
683         # while they run.  Since we might be reading from two or more children
684         # we use a select.
685         #
686         my($FDread, $tarOut, $mesg);
687         vec($FDread, fileno(TAR), 1) = 1 if ( $useTar );
688         $xfer->setSelectMask(\$FDread);
689
690         SCAN: while ( 1 ) {
691             my $ein = $FDread;
692             last if ( $FDread =~ /^\0*$/ );
693             select(my $rout = $FDread, undef, $ein, undef);
694             if ( $useTar ) {
695                 if ( vec($rout, fileno(TAR), 1) ) {
696                     if ( sysread(TAR, $mesg, 8192) <= 0 ) {
697                         vec($FDread, fileno(TAR), 1) = 0;
698                         close(TAR);
699                     } else {
700                         $tarOut .= $mesg;
701                     }
702                 }
703                 while ( $tarOut =~ /(.*?)[\n\r]+(.*)/s ) {
704                     $_ = $1;
705                     $tarOut = $2;
706                     if ( /^  / ) {
707                         $XferLOG->write(\"$_\n");
708                     } else {
709                         $XferLOG->write(\"tarExtract: $_\n");
710                     }
711                     if ( /^BackupPC_tarExtact aborting \((.*)\)/ ) {
712                         $stat{hostError} = $1;
713                     }
714                     if ( /^Done: (\d+) errors, (\d+) filesExist, (\d+) sizeExist, (\d+) sizeExistComp, (\d+) filesTotal, (\d+) sizeTotal/ ) {
715                         $tarErrs       += $1;
716                         $nFilesExist   += $2;
717                         $sizeExist     += $3;
718                         $sizeExistComp += $4;
719                         $nFilesTotal   += $5;
720                         $sizeTotal     += $6;
721                     }
722                 }
723             }
724             last if ( !$xfer->readOutput(\$FDread, $rout) );
725             while ( my $str = $xfer->logMsgGet ) {
726                 print(LOG $bpc->timeStamp, "xfer: $str\n");
727             }
728             if ( $xfer->getStats->{fileCnt} == 1 ) {
729                 #
730                 # Make sure it is still the machine we expect.  We do this while
731                 # the transfer is running to avoid a potential race condition if
732                 # the ip address was reassigned by dhcp just before we started
733                 # the transfer.
734                 #
735                 if ( my $errMsg = CorrectHostCheck($hostIP, $host) ) {
736                     $stat{hostError} = $errMsg if ( $stat{hostError} eq "" );
737                     last SCAN;
738                 }
739             }
740         }
741     } else {
742         #
743         # otherwise the xfer module does everything for us
744         #
745         my @results = $xfer->run();
746         $tarErrs       += $results[0];
747         $nFilesExist   += $results[1];
748         $sizeExist     += $results[2];
749         $sizeExistComp += $results[3];
750         $nFilesTotal   += $results[4];
751         $sizeTotal     += $results[5];
752     }
753
754     #
755     # Merge the xfer status (need to accumulate counts)
756     #
757     my $newStat = $xfer->getStats;
758     if ( $newStat->{fileCnt} == 0 ) {
759        $noFilesErr ||= "No files dumped for share $shareName";
760     }
761     foreach my $k ( (keys(%stat), keys(%$newStat)) ) {
762         next if ( !defined($newStat->{$k}) );
763         if ( $k =~ /Cnt$/ ) {
764             $stat{$k} += $newStat->{$k};
765             delete($newStat->{$k});
766             next;
767         }
768         if ( !defined($stat{$k}) ) {
769             $stat{$k} = $newStat->{$k};
770             delete($newStat->{$k});
771             next;
772         }
773     }
774
775     UserCommandRun("DumpPostShareCmd", $shareName) if ( $NeedPostCmd );
776
777     $stat{xferOK} = 0 if ( $stat{hostError} || $stat{hostAbort} );
778     if ( !$stat{xferOK} ) {
779         #
780         # kill off the tranfer program, first nicely then forcefully
781         #
782         if ( @xferPid ) {
783             kill($bpc->sigName2num("INT"), @xferPid);
784             sleep(1);
785             kill($bpc->sigName2num("KILL"), @xferPid);
786         }
787         #
788         # kill off the tar process, first nicely then forcefully
789         #
790         if ( $tarPid > 0 ) {
791             kill($bpc->sigName2num("INT"), $tarPid);
792             sleep(1);
793             kill($bpc->sigName2num("KILL"), $tarPid);
794         }
795         #
796         # don't do any more shares on this host
797         #
798         last;
799     }
800 }
801
802 #
803 # If this is a full, and any share had zero files then consider the dump bad
804 #
805 if ( $type eq "full" && $stat{hostError} eq ""
806             && length($noFilesErr) && $Conf{BackupZeroFilesIsFatal} ) {
807     $stat{hostError} = $noFilesErr;
808     $stat{xferOK} = 0;
809 }
810
811 $stat{xferOK} = 0 if ( $Abort );
812
813 #
814 # Do one last check to make sure it is still the machine we expect.
815 #
816 if ( $stat{xferOK} && (my $errMsg = CorrectHostCheck($hostIP, $host)) ) {
817     $stat{hostError} = $errMsg;
818     $stat{xferOK} = 0;
819 }
820
821 UserCommandRun("DumpPostUserCmd") if ( $NeedPostCmd );
822 close($newFilesFH) if ( defined($newFilesFH) );
823
824 my $endTime = time();
825
826 #
827 # If the dump failed, clean up
828 #
829 if ( !$stat{xferOK} ) {
830     $stat{hostError} = $stat{lastOutputLine} if ( $stat{hostError} eq "" );
831     if ( $stat{hostError} ) {
832         print(LOG $bpc->timeStamp,
833                   "Got fatal error during xfer ($stat{hostError})\n");
834         $XferLOG->write(\"Got fatal error during xfer ($stat{hostError})\n");
835     }
836     if ( !$Abort ) {
837         #
838         # wait a short while and see if the system is still alive
839         #
840         sleep(5);
841         if ( $bpc->CheckHostAlive($hostIP) < 0 ) {
842             $stat{hostAbort} = 1;
843         }
844         if ( $stat{hostAbort} ) {
845             $stat{hostError} = "lost network connection during backup";
846         }
847         print(LOG $bpc->timeStamp, "Backup aborted ($stat{hostError})\n");
848         $XferLOG->write(\"Backup aborted ($stat{hostError})\n");
849     } else {
850         $XferLOG->write(\"Backup aborted by user signal\n");
851     }
852
853     #
854     # Close the log file and call BackupFailCleanup, which exits.
855     #
856     BackupFailCleanup();
857 }
858
859 my $newNum = BackupSave();
860
861 my $otherCount = $stat{xferErrCnt} - $stat{xferBadFileCnt}
862                                    - $stat{xferBadShareCnt};
863 print(LOG $bpc->timeStamp,
864           "$type backup $newNum complete, $stat{fileCnt} files,"
865         . " $stat{byteCnt} bytes,"
866         . " $stat{xferErrCnt} xferErrs ($stat{xferBadFileCnt} bad files,"
867         . " $stat{xferBadShareCnt} bad shares, $otherCount other)\n");
868
869 BackupExpire($client);
870
871 print("$type backup complete\n");
872
873 ###########################################################################
874 # Subroutines
875 ###########################################################################
876
877 sub NothingToDo
878 {
879     my($needLink) = @_;
880
881     print("nothing to do\n");
882     print("link $clientURI\n") if ( $needLink );
883     exit(0);
884 }
885
886 sub catch_signal
887 {
888     my $sigName = shift;
889
890     #
891     # The first time we receive a signal we try to gracefully
892     # abort the backup.  This allows us to keep a partial dump
893     # with the in-progress file deleted and attribute caches
894     # flushed to disk etc.
895     #
896     if ( !length($SigName) ) {
897         my $reason;
898         if ( $sigName eq "INT" ) {
899             $reason = "aborted by user (signal=$sigName)";
900         } else {
901             $reason = "aborted by signal=$sigName";
902         }
903         if ( $Pid == $$ ) {
904             #
905             # Parent logs a message
906             #
907             print(LOG $bpc->timeStamp,
908                     "Aborting backup up after signal $sigName\n");
909
910             #
911             # Tell xfer to abort
912             #
913             $xfer->abort($reason);
914
915             #
916             # Send ALRMs to BackupPC_tarExtract if we are using it
917             #
918             if ( $tarPid > 0 ) {
919                 kill($bpc->sigName2num("ARLM"), $tarPid);
920             }
921
922             #
923             # Schedule a 20 second timer in case the clean
924             # abort doesn't complete
925             #
926             alarm(20);
927         } else {
928             #
929             # Children ignore anything other than ALRM and INT
930             #
931             if ( $sigName ne "ALRM" && $sigName ne "INT" ) {
932                 return;
933             }
934
935             #
936             # The child also tells xfer to abort
937             #
938             $xfer->abort($reason);
939
940             #
941             # Schedule a 15 second timer in case the clean
942             # abort doesn't complete
943             #
944             alarm(15);
945         }
946         $SigName = $sigName;
947         $Abort = 1;
948         return;
949     }
950
951     #
952     # This is a second signal: time to clean up.
953     #
954     if ( $Pid != $$ && ($sigName eq "ALRM" || $sigName eq "INT") ) {
955         #
956         # Children quit quietly on ALRM or INT
957         #
958         exit(1)
959     }
960
961     #
962     # Ignore other signals in children
963     #
964     return if ( $Pid != $$ );
965
966     $SIG{$sigName} = 'IGNORE';
967     UserCommandRun("DumpPostUserCmd") if ( $NeedPostCmd );
968     $XferLOG->write(\"exiting after signal $sigName\n");
969     if ( @xferPid ) {
970         kill($bpc->sigName2num("INT"), @xferPid);
971         sleep(1);
972         kill($bpc->sigName2num("KILL"), @xferPid);
973     }
974     if ( $tarPid > 0 ) {
975         kill($bpc->sigName2num("INT"), $tarPid);
976         sleep(1);
977         kill($bpc->sigName2num("KILL"), $tarPid);
978     }
979     if ( $sigName eq "INT" ) {
980         $stat{hostError} = "aborted by user (signal=$sigName)";
981     } else {
982         $stat{hostError} = "received signal=$sigName";
983     }
984     BackupFailCleanup();
985 }
986
987 sub CheckForNewFiles
988 {
989     if ( -f _ && $File::Find::name !~ /\/fattrib$/ ) {
990         $nFilesTotal++;
991     } elsif ( -d _ ) {
992         #
993         # No need to check entire tree
994         #
995         $File::Find::prune = 1 if ( $nFilesTotal );
996     }
997 }
998
999 sub BackupFailCleanup
1000 {
1001     my $fileExt = $Conf{CompressLevel} > 0 ? ".z" : "";
1002     my $keepPartial = 0;
1003
1004     #
1005     # We keep this backup if it is a full and we actually backed
1006     # up some files.
1007     #
1008     if ( $type eq "full" ) {
1009         if ( $nFilesTotal == 0 && $xfer->getStats->{fileCnt} == 0 ) {
1010             #
1011             # Xfer didn't report any files, but check in the new
1012             # directory just in case.
1013             #
1014             find(\&CheckForNewFiles, "$Dir/new");
1015             $keepPartial = 1 if ( $nFilesTotal );
1016         } else {
1017             #
1018             # Xfer reported some files
1019             #
1020             $keepPartial = 1;
1021         }
1022     }
1023
1024     #
1025     # Don't keep partials if they are disabled
1026     #
1027     $keepPartial = 0 if ( $Conf{PartialAgeMax} < 0 );
1028
1029     if ( !$keepPartial ) {
1030         #
1031         # No point in saving this dump; get rid of eveything.
1032         #
1033         $XferLOG->close();
1034         unlink("$Dir/timeStamp.level0")    if ( -f "$Dir/timeStamp.level0" );
1035         unlink("$Dir/SmbLOG.bad")          if ( -f "$Dir/SmbLOG.bad" );
1036         unlink("$Dir/SmbLOG.bad$fileExt")  if ( -f "$Dir/SmbLOG.bad$fileExt" );
1037         unlink("$Dir/XferLOG.bad")         if ( -f "$Dir/XferLOG.bad" );
1038         unlink("$Dir/XferLOG.bad$fileExt") if ( -f "$Dir/XferLOG.bad$fileExt" );
1039         unlink("$Dir/NewFileList")         if ( -f "$Dir/NewFileList" );
1040         rename("$Dir/XferLOG$fileExt", "$Dir/XferLOG.bad$fileExt");
1041         $bpc->RmTreeDefer("$TopDir/trash", "$Dir/new") if ( -d "$Dir/new" );
1042         print("dump failed: $stat{hostError}\n");
1043         $XferLOG->close();
1044         print("link $clientURI\n") if ( $needLink );
1045         exit(1);
1046     }
1047     #
1048     # Ok, now we should save this as a partial dump
1049     #
1050     $type = "partial";
1051     my $newNum = BackupSave();
1052     print("dump failed: $stat{hostError}\n");
1053     print("link $clientURI\n") if ( $needLink );
1054     print(LOG $bpc->timeStamp, "Saved partial dump $newNum\n");
1055     exit(2);
1056 }
1057
1058 #
1059 # Decide which old backups should be expired by moving them
1060 # to $TopDir/trash.
1061 #
1062 sub BackupExpire
1063 {
1064     my($client) = @_;
1065     my($Dir) = "$TopDir/pc/$client";
1066     my(@Backups) = $bpc->BackupInfoRead($client);
1067     my($cntFull, $cntIncr, $firstFull, $firstIncr, $oldestIncr, $oldestFull);
1068
1069     if ( $Conf{FullKeepCnt} <= 0 ) {
1070         print(LOG $bpc->timeStamp,
1071                   "Invalid value for \$Conf{FullKeepCnt}=$Conf{FullKeepCnt}\n");
1072         print(STDERR
1073             "Invalid value for \$Conf{FullKeepCnt}=$Conf{FullKeepCnt}\n")
1074                             if ( $opts{v} );
1075         return;
1076     }
1077     while ( 1 ) {
1078         $cntFull = $cntIncr = 0;
1079         $oldestIncr = $oldestFull = 0;
1080         for ( my $i = 0 ; $i < @Backups ; $i++ ) {
1081             if ( $Backups[$i]{type} eq "full" ) {
1082                 $firstFull = $i if ( $cntFull == 0 );
1083                 $cntFull++;
1084             } else {
1085                 $firstIncr = $i if ( $cntIncr == 0 );
1086                 $cntIncr++;
1087             }
1088         }
1089         $oldestIncr = (time - $Backups[$firstIncr]{startTime}) / (24 * 3600)
1090                         if ( $cntIncr > 0 );
1091         $oldestFull = (time - $Backups[$firstFull]{startTime}) / (24 * 3600)
1092                         if ( $cntFull > 0 );
1093         if ( $cntIncr > $Conf{IncrKeepCnt}
1094                 || ($cntIncr > $Conf{IncrKeepCntMin}
1095                     && $oldestIncr > $Conf{IncrAgeMax})
1096                && (@Backups <= $firstIncr + 1
1097                         || $Backups[$firstIncr]{noFill}
1098                         || !$Backups[$firstIncr + 1]{noFill}) ) {
1099             #
1100             # Only delete an incr backup if the Conf settings are satisfied.
1101             # We also must make sure that either this backup is the most
1102             # recent one, or it is not filled, or the next backup is filled.
1103             # (We can't deleted a filled incr if the next backup is not
1104             # filled.)
1105             # 
1106             print(LOG $bpc->timeStamp,
1107                       "removing incr backup $Backups[$firstIncr]{num}\n");
1108             BackupRemove($client, \@Backups, $firstIncr);
1109             next;
1110         }
1111
1112         #
1113         # Delete any old full backups, according to $Conf{FullKeepCntMin}
1114         # and $Conf{FullAgeMax}.
1115         #
1116         # First make sure that $Conf{FullAgeMax} is at least bigger
1117         # than $Conf{FullPeriod} * $Conf{FullKeepCnt}, including
1118         # the exponential array case.
1119         #
1120         my $fullKeepCnt = $Conf{FullKeepCnt};
1121         $fullKeepCnt = [$fullKeepCnt] if ( ref($fullKeepCnt) ne "ARRAY" );
1122         my $fullAgeMax;
1123         my $fullPeriod = int(0.5 + $Conf{FullPeriod});
1124         $fullPeriod = 7 if ( $fullPeriod <= 0 );
1125         for ( my $i = 0 ; $i < @$fullKeepCnt ; $i++ ) {
1126             $fullAgeMax += $fullKeepCnt->[$i] * $fullPeriod;
1127             $fullPeriod *= 2;
1128         }
1129         $fullAgeMax += $fullPeriod;     # add some buffer
1130
1131         if ( $cntFull > $Conf{FullKeepCntMin}
1132                && $oldestFull > $Conf{FullAgeMax}
1133                && $oldestFull > $fullAgeMax
1134                && $Conf{FullKeepCntMin} > 0
1135                && $Conf{FullAgeMax} > 0
1136                && (@Backups <= $firstFull + 1
1137                         || !$Backups[$firstFull + 1]{noFill}) ) {
1138             #
1139             # Only delete a full backup if the Conf settings are satisfied.
1140             # We also must make sure that either this backup is the most
1141             # recent one, or the next backup is filled.
1142             # (We can't deleted a full backup if the next backup is not
1143             # filled.)
1144             # 
1145             print(LOG $bpc->timeStamp,
1146                    "removing old full backup $Backups[$firstFull]{num}\n");
1147             BackupRemove($client, \@Backups, $firstFull);
1148             next;
1149         }
1150
1151         #
1152         # Do new-style full backup expiry, which includes the the case
1153         # where $Conf{FullKeepCnt} is an array.
1154         #
1155         last if ( !BackupFullExpire($client, \@Backups) );
1156     }
1157     $bpc->BackupInfoWrite($client, @Backups);
1158 }
1159
1160 #
1161 # Handle full backup expiry, using exponential periods.
1162 #
1163 sub BackupFullExpire
1164 {
1165     my($client, $Backups) = @_;
1166     my $fullCnt = 0;
1167     my $fullPeriod = $Conf{FullPeriod};
1168     my $origFullPeriod = $fullPeriod;
1169     my $fullKeepCnt = $Conf{FullKeepCnt};
1170     my $fullKeepIdx = 0;
1171     my(@delete, @fullList);
1172
1173     #
1174     # Don't delete anything if $Conf{FullPeriod} or $Conf{FullKeepCnt} are
1175     # not defined - possibly a corrupted config.pl file.
1176     #
1177     return if ( !defined($Conf{FullPeriod}) || !defined($Conf{FullKeepCnt}) );
1178
1179     #
1180     # If regular backups are still disabled with $Conf{FullPeriod} < 0,
1181     # we still expire backups based on a typical FullPeriod value - weekly.
1182     #
1183     $fullPeriod = 7 if ( $fullPeriod <= 0 );
1184
1185     $fullKeepCnt = [$fullKeepCnt] if ( ref($fullKeepCnt) ne "ARRAY" );
1186
1187     for ( my $i = 0 ; $i < @$Backups ; $i++ ) {
1188         next if ( $Backups->[$i]{type} ne "full" );
1189         push(@fullList, $i);
1190     }
1191     for ( my $k = @fullList - 1 ; $k >= 0 ; $k-- ) {
1192         my $i = $fullList[$k];
1193         my $prevFull = $fullList[$k-1] if ( $k > 0 );
1194         #
1195         # Don't delete any full that is followed by an unfilled backup,
1196         # since it is needed for restore.
1197         #
1198         my $noDelete = $i + 1 < @$Backups ? $Backups->[$i+1]{noFill} : 0;
1199
1200         if ( !$noDelete && 
1201               ($fullKeepIdx >= @$fullKeepCnt
1202               || $k > 0
1203                  && $fullKeepIdx > 0
1204                  && $Backups->[$i]{startTime} - $Backups->[$prevFull]{startTime}
1205                              < ($fullPeriod - $origFullPeriod / 2) * 24 * 3600
1206                )
1207             ) {
1208             #
1209             # Delete the full backup
1210             #
1211             #print("Deleting backup $i ($prevFull)\n");
1212             unshift(@delete, $i);
1213         } else {
1214             $fullCnt++;
1215             while ( $fullKeepIdx < @$fullKeepCnt
1216                      && $fullCnt >= $fullKeepCnt->[$fullKeepIdx] ) {
1217                 $fullKeepIdx++;
1218                 $fullCnt = 0;
1219                 $fullPeriod = 2 * $fullPeriod;
1220             }
1221         }
1222     }
1223     #
1224     # Now actually delete the backups
1225     #
1226     for ( my $i = @delete - 1 ; $i >= 0 ; $i-- ) {
1227         print(LOG $bpc->timeStamp,
1228                "removing full backup $Backups->[$delete[$i]]{num}\n");
1229         BackupRemove($client, $Backups, $delete[$i]);
1230     }
1231     return @delete;
1232 }
1233
1234 #
1235 # Removes any partial backups
1236 #
1237 sub BackupPartialRemove
1238 {
1239     my($client, $Backups) = @_;
1240
1241     for ( my $i = @$Backups - 1 ; $i >= 0 ; $i-- ) {
1242         next if ( $Backups->[$i]{type} ne "partial" );
1243         BackupRemove($client, $Backups, $i);
1244     }
1245 }
1246
1247 sub BackupSave
1248 {
1249     my @Backups = $bpc->BackupInfoRead($client);
1250     my $num  = -1;
1251
1252     #
1253     # Since we got a good backup we should remove any partial dumps
1254     # (the new backup might also be a partial, but that's ok).
1255     #
1256     BackupPartialRemove($client, \@Backups);
1257
1258     #
1259     # Number the new backup
1260     #
1261     for ( my $i = 0 ; $i < @Backups ; $i++ ) {
1262         $num = $Backups[$i]{num} if ( $num < $Backups[$i]{num} );
1263     }
1264     $num++;
1265     $bpc->RmTreeDefer("$TopDir/trash", "$Dir/$num") if ( -d "$Dir/$num" );
1266     if ( !rename("$Dir/new", "$Dir/$num") ) {
1267         print(LOG $bpc->timeStamp, "Rename $Dir/new -> $Dir/$num failed\n");
1268         $stat{xferOK} = 0;
1269     }
1270     $needLink = 1 if ( -f "$Dir/NewFileList" );
1271
1272     #
1273     # Add the new backup information to the backup file
1274     #
1275     my $i = @Backups;
1276     $Backups[$i]{num}           = $num;
1277     $Backups[$i]{type}          = $type;
1278     $Backups[$i]{startTime}     = $startTime;
1279     $Backups[$i]{endTime}       = $endTime;
1280     $Backups[$i]{size}          = $sizeTotal;
1281     $Backups[$i]{nFiles}        = $nFilesTotal;
1282     $Backups[$i]{xferErrs}      = $stat{xferErrCnt} || 0;
1283     $Backups[$i]{xferBadFile}   = $stat{xferBadFileCnt} || 0;
1284     $Backups[$i]{xferBadShare}  = $stat{xferBadShareCnt} || 0;
1285     $Backups[$i]{nFilesExist}   = $nFilesExist;
1286     $Backups[$i]{sizeExist}     = $sizeExist;
1287     $Backups[$i]{sizeExistComp} = $sizeExistComp;
1288     $Backups[$i]{tarErrs}       = $tarErrs;
1289     $Backups[$i]{compress}      = $Conf{CompressLevel};
1290     $Backups[$i]{noFill}        = $type eq "incr" ? 1 : 0;
1291     $Backups[$i]{level}         = $type eq "incr" ? 1 : 0;
1292     $Backups[$i]{mangle}        = 1;        # name mangling always on for v1.04+
1293     $bpc->BackupInfoWrite($client, @Backups);
1294
1295     unlink("$Dir/timeStamp.level0") if ( -f "$Dir/timeStamp.level0" );
1296     foreach my $ext ( qw(bad bad.z) ) {
1297         next if ( !-f "$Dir/XferLOG.$ext" );
1298         unlink("$Dir/XferLOG.$ext.old") if ( -f "$Dir/XferLOG.$ext" );
1299         rename("$Dir/XferLOG.$ext", "$Dir/XferLOG.$ext.old");
1300     }
1301
1302     #
1303     # Now remove the bad files, replacing them if possible with links to
1304     # earlier backups.
1305     #
1306     foreach my $f ( $xfer->getBadFiles ) {
1307         my $j;
1308         my $shareM = $bpc->fileNameEltMangle($f->{share});
1309         my $fileM  = $bpc->fileNameMangle($f->{file});
1310         unlink("$Dir/$num/$shareM/$fileM");
1311         for ( $j = $i - 1 ; $j >= 0 ; $j-- ) {
1312             my $file;
1313             if ( $Backups[$j]{mangle} ) {
1314                 $file = "$shareM/$fileM";
1315             } else {
1316                 $file = "$f->{share}/$f->{file}";
1317             }
1318             next if ( !-f "$Dir/$Backups[$j]{num}/$file" );
1319             if ( !link("$Dir/$Backups[$j]{num}/$file",
1320                                 "$Dir/$num/$shareM/$fileM") ) {
1321                 my $str = \"Unable to link $num/$f->{share}/$f->{file} to"
1322                          . " $Backups[$j]{num}/$f->{share}/$f->{file}\n";
1323                 $XferLOG->write(\$str);
1324             } else {
1325                 my $str = "Bad file $num/$f->{share}/$f->{file} replaced"
1326                         . " by link to"
1327                         . " $Backups[$j]{num}/$f->{share}/$f->{file}\n";
1328                 $XferLOG->write(\$str);
1329             }
1330             last;
1331         }
1332         if ( $j < 0 ) {
1333             my $str = "Removed bad file $num/$f->{share}/$f->{file}"
1334                     . " (no older copy to link to)\n";
1335             $XferLOG->write(\$str);
1336         }
1337     }
1338     $XferLOG->close();
1339     rename("$Dir/XferLOG$fileExt", "$Dir/XferLOG.$num$fileExt");
1340     rename("$Dir/NewFileList", "$Dir/NewFileList.$num");
1341
1342     return $num;
1343 }
1344
1345 #
1346 # Removes a specific backup
1347 #
1348 sub BackupRemove
1349 {
1350     my($client, $Backups, $idx) = @_;
1351     my($Dir) = "$TopDir/pc/$client";
1352
1353     if ( $Backups->[$idx]{num} eq "" ) {
1354         print("BackupRemove: ignoring empty backup number for idx $idx\n");
1355         return;
1356     }
1357
1358     $bpc->RmTreeDefer("$TopDir/trash",
1359                       "$Dir/$Backups->[$idx]{num}");
1360     unlink("$Dir/SmbLOG.$Backups->[$idx]{num}")
1361                 if ( -f "$Dir/SmbLOG.$Backups->[$idx]{num}" );
1362     unlink("$Dir/SmbLOG.$Backups->[$idx]{num}.z")
1363                 if ( -f "$Dir/SmbLOG.$Backups->[$idx]{num}.z" );
1364     unlink("$Dir/XferLOG.$Backups->[$idx]{num}")
1365                 if ( -f "$Dir/XferLOG.$Backups->[$idx]{num}" );
1366     unlink("$Dir/XferLOG.$Backups->[$idx]{num}.z")
1367                 if ( -f "$Dir/XferLOG.$Backups->[$idx]{num}.z" );
1368     splice(@{$Backups}, $idx, 1);
1369 }
1370
1371 sub CorrectHostCheck
1372 {
1373     my($hostIP, $host) = @_;
1374     return if ( $hostIP eq $host && !$Conf{FixedIPNetBiosNameCheck}
1375                 || $Conf{NmbLookupCmd} eq "" );
1376     my($netBiosHost, $netBiosUser) = $bpc->NetBiosInfoGet($hostIP);
1377     return "host $host has mismatching netbios name $netBiosHost"
1378                 if ( $netBiosHost ne $host );
1379     return;
1380 }
1381
1382 #
1383 # The Xfer method might tell us from time to time about processes
1384 # it forks.  We tell BackupPC about this (for status displays) and
1385 # keep track of the pids in case we cancel the backup
1386 #
1387 sub pidHandler
1388 {
1389     @xferPid = @_;
1390     @xferPid = grep(/./, @xferPid);
1391     return if ( !@xferPid && $tarPid < 0 );
1392     my @pids = @xferPid;
1393     push(@pids, $tarPid) if ( $tarPid > 0 );
1394     my $str = join(",", @pids);
1395     $XferLOG->write(\"Xfer PIDs are now $str\n") if ( defined($XferLOG) );
1396     print("xferPids $str\n");
1397 }
1398
1399 #
1400 # Run an optional pre- or post-dump command
1401 #
1402 sub UserCommandRun
1403 {
1404     my($cmdType, $sharename) = @_;
1405
1406     return if ( !defined($Conf{$cmdType}) );
1407     my $vars = {
1408         xfer       => $xfer,
1409         client     => $client,
1410         host       => $host,
1411         hostIP     => $hostIP,
1412         user       => $Hosts->{$client}{user},
1413         moreUsers  => $Hosts->{$client}{moreUsers},
1414         share      => $ShareNames->[0],
1415         shares     => $ShareNames,
1416         XferMethod => $Conf{XferMethod},
1417         sshPath    => $Conf{SshPath},
1418         LOG        => *LOG,
1419         XferLOG    => $XferLOG,
1420         stat       => \%stat,
1421         xferOK     => $stat{xferOK} || 0,
1422         hostError  => $stat{hostError},
1423         type       => $type,
1424         cmdType    => $cmdType,
1425     };
1426
1427     if ($cmdType eq 'DumpPreShareCmd' || $cmdType eq 'DumpPostShareCmd') {
1428         $vars->{share} = $sharename;
1429     }
1430
1431     my $cmd = $bpc->cmdVarSubstitute($Conf{$cmdType}, $vars);
1432     $XferLOG->write(\"Executing $cmdType: @$cmd\n");
1433     #
1434     # Run the user's command, dumping the stdout/stderr into the
1435     # Xfer log file.  Also supply the optional $vars and %Conf in
1436     # case the command is really perl code instead of a shell
1437     # command.
1438     #
1439     $bpc->cmdSystemOrEval($cmd,
1440             sub {
1441                 $XferLOG->write(\$_[0]);
1442             },
1443             $vars, \%Conf);
1444 }