+ "removing old full backup $Backups[$firstFull]{num}\n");
+ BackupRemove($client, \@Backups, $firstFull);
+ next;
+ }
+
+ #
+ # Do new-style full backup expiry, which includes the the case
+ # where $Conf{FullKeepCnt} is an array.
+ #
+ last if ( !BackupFullExpire($client, \@Backups) );
+ }
+ $bpc->BackupInfoWrite($client, @Backups);
+}
+
+#
+# Handle full backup expiry, using exponential periods.
+#
+sub BackupFullExpire
+{
+ my($client, $Backups) = @_;
+ my $fullCnt = 0;
+ my $fullPeriod = $Conf{FullPeriod};
+ my $origFullPeriod = $fullPeriod;
+ my $fullKeepCnt = $Conf{FullKeepCnt};
+ my $fullKeepIdx = 0;
+ my(@delete, @fullList);
+
+ #
+ # Don't delete anything if $Conf{FullPeriod} or $Conf{FullKeepCnt} are
+ # not defined - possibly a corrupted config.pl file.
+ #
+ return if ( !defined($Conf{FullPeriod}) || !defined($Conf{FullKeepCnt}) );
+
+ #
+ # If regular backups are still disabled with $Conf{FullPeriod} < 0,
+ # we still expire backups based on a typical FullPeriod value - weekly.
+ #
+ $fullPeriod = 7 if ( $fullPeriod <= 0 );
+
+ $fullKeepCnt = [$fullKeepCnt] if ( ref($fullKeepCnt) ne "ARRAY" );
+
+ for ( my $i = 0 ; $i < @$Backups ; $i++ ) {
+ next if ( $Backups->[$i]{type} ne "full" );
+ push(@fullList, $i);
+ }
+ for ( my $k = @fullList - 1 ; $k >= 0 ; $k-- ) {
+ my $i = $fullList[$k];
+ my $prevFull = $fullList[$k-1] if ( $k > 0 );
+ #
+ # Don't delete any full that is followed by an unfilled backup,
+ # since it is needed for restore.
+ #
+ my $noDelete = $i + 1 < @$Backups ? $Backups->[$i+1]{noFill} : 0;
+
+ if ( !$noDelete &&
+ ($fullKeepIdx >= @$fullKeepCnt
+ || $k > 0
+ && $fullKeepIdx > 0
+ && $Backups->[$i]{startTime} - $Backups->[$prevFull]{startTime}
+ < ($fullPeriod - $origFullPeriod / 2) * 24 * 3600
+ )
+ ) {
+ #
+ # Delete the full backup
+ #
+ #printf("Deleting backup $i ($prevFull)\n");
+ push(@delete, $i);
+ } else {
+ $fullCnt++;
+ while ( $fullKeepIdx < @$fullKeepCnt
+ && $fullCnt >= $fullKeepCnt->[$fullKeepIdx] ) {
+ $fullKeepIdx++;
+ $fullCnt = 0;
+ $fullPeriod = 2 * $fullPeriod;
+ }
+ }
+ }
+ #
+ # Now actually delete the backups
+ #
+ for ( my $i = @delete - 1 ; $i >= 0 ; $i-- ) {
+ print(LOG $bpc->timeStamp,
+ "removing full backup $Backups->[$delete[$i]]{num}\n");
+ BackupRemove($client, $Backups, $delete[$i]);
+ }
+ return @delete;
+}
+
+#
+# Removes any partial backups
+#
+sub BackupPartialRemove
+{
+ my($client, $Backups) = @_;
+
+ for ( my $i = @$Backups - 1 ; $i >= 0 ; $i-- ) {
+ next if ( $Backups->[$i]{type} ne "partial" );
+ BackupRemove($client, $Backups, $i);
+ }
+}
+
+sub BackupSave
+{
+ my @Backups = $bpc->BackupInfoRead($client);
+ my $num = -1;
+
+ #
+ # Since we got a good backup we should remove any partial dumps
+ # (the new backup might also be a partial, but that's ok).
+ #
+ BackupPartialRemove($client, \@Backups);
+
+ #
+ # Number the new backup
+ #
+ for ( my $i = 0 ; $i < @Backups ; $i++ ) {
+ $num = $Backups[$i]{num} if ( $num < $Backups[$i]{num} );
+ }
+ $num++;
+ $bpc->RmTreeDefer("$TopDir/trash", "$Dir/$num") if ( -d "$Dir/$num" );
+ if ( !rename("$Dir/new", "$Dir/$num") ) {
+ print(LOG $bpc->timeStamp, "Rename $Dir/new -> $Dir/$num failed\n");
+ $stat{xferOK} = 0;
+ }
+ $needLink = 1 if ( -f "$Dir/NewFileList" );
+
+ #
+ # Add the new backup information to the backup file
+ #
+ my $i = @Backups;
+ $Backups[$i]{num} = $num;
+ $Backups[$i]{type} = $type;
+ $Backups[$i]{startTime} = $startTime;
+ $Backups[$i]{endTime} = $endTime;
+ $Backups[$i]{size} = $sizeTotal;
+ $Backups[$i]{nFiles} = $nFilesTotal;
+ $Backups[$i]{xferErrs} = $stat{xferErrCnt} || 0;
+ $Backups[$i]{xferBadFile} = $stat{xferBadFileCnt} || 0;
+ $Backups[$i]{xferBadShare} = $stat{xferBadShareCnt} || 0;
+ $Backups[$i]{nFilesExist} = $nFilesExist;
+ $Backups[$i]{sizeExist} = $sizeExist;
+ $Backups[$i]{sizeExistComp} = $sizeExistComp;
+ $Backups[$i]{tarErrs} = $tarErrs;
+ $Backups[$i]{compress} = $Conf{CompressLevel};
+ $Backups[$i]{noFill} = $type eq "incr" ? 1 : 0;
+ $Backups[$i]{level} = $type eq "incr" ? 1 : 0;
+ $Backups[$i]{mangle} = 1; # name mangling always on for v1.04+
+ $bpc->BackupInfoWrite($client, @Backups);
+
+ unlink("$Dir/timeStamp.level0") if ( -f "$Dir/timeStamp.level0" );
+ foreach my $ext ( qw(bad bad.z) ) {
+ next if ( !-f "$Dir/XferLOG.$ext" );
+ unlink("$Dir/XferLOG.$ext.old") if ( -f "$Dir/XferLOG.$ext" );
+ rename("$Dir/XferLOG.$ext", "$Dir/XferLOG.$ext.old");
+ }
+
+ #
+ # Now remove the bad files, replacing them if possible with links to
+ # earlier backups.
+ #
+ foreach my $f ( $xfer->getBadFiles ) {
+ my $j;
+ my $shareM = $bpc->fileNameEltMangle($f->{share});
+ my $fileM = $bpc->fileNameMangle($f->{file});
+ unlink("$Dir/$num/$shareM/$fileM");
+ for ( $j = $i - 1 ; $j >= 0 ; $j-- ) {
+ my $file;
+ if ( $Backups[$j]{mangle} ) {
+ $file = "$shareM/$fileM";
+ } else {
+ $file = "$f->{share}/$f->{file}";
+ }
+ next if ( !-f "$Dir/$Backups[$j]{num}/$file" );
+ if ( !link("$Dir/$Backups[$j]{num}/$file",
+ "$Dir/$num/$shareM/$fileM") ) {
+ my $str = \"Unable to link $num/$f->{share}/$f->{file} to"
+ . " $Backups[$j]{num}/$f->{share}/$f->{file}\n";
+ $XferLOG->write(\$str);
+ } else {
+ my $str = "Bad file $num/$f->{share}/$f->{file} replaced"
+ . " by link to"
+ . " $Backups[$j]{num}/$f->{share}/$f->{file}\n";
+ $XferLOG->write(\$str);
+ }
projects / BackupPC.git / blobdiff