# -*- perl -*-
#
# Copyright (C) Dr. Heinz-Josef Claes (2001-2022)
# hjclaes@web.de
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see .
#
use strict;
use Fcntl;
use IO::Compress::Gzip qw(gzip $GzipError);
use IO::Uncompress::Bunzip2 qw(bunzip2 $Bunzip2Error);
require 'storeBackupGlob.pl';
# Erkennen des Trees mit dem Backup (Wurzel des Backups)
# Listen aller Backup-Verzeichnisse
# Listen aller geänderten Dateien (nach Link + md5-Summe)
# Suchen von Dateien nach md5-Summe
# Suchen von Dateien nach Namen (Pattern), Größe, Datum, etc.
# Löschen von Teilbäumen in einem Backup
##################################################
sub buildDBMs
{
my (%params) = ('-dbmKeyIsFilename' => undef, # pointer to hash
'-dbmKeyIsMD5Sum' => undef, # pointer to hash
'-dbmBlockCheck' => undef, # pointer to hash
'-flagBlockDevice' => 0, # flag: 0 or 1
'-indexDir' => undef, # object pointer
'-backupRoot' => undef, # String
'-backupDirIndex' => undef, # Index des Pfades
'-noBackupDir' => undef,
'-checkSumFile' => undef,
'-checkSumFileVersion' => undef,
'-blockCheckSumFile' => undef,
'-progressReport' => undef,
'-prLog' => undef,
'-suppressInfo' => undef,
'-saveRAM' => 0,
'-dbmBaseName' => undef,
'-tmpdir' => undef
);
&::checkObjectParams(\%params, \@_, '::buildDBMs',
['-dbmKeyIsFilename', '-dbmKeyIsMD5Sum', '-indexDir',
'-backupRoot', '-backupDirIndex',
'-noBackupDir', '-checkSumFile',
'-checkSumFileVersion', '-prLog', '-tmpdir']);
my $dbmKeyIsFilename = $params{'-dbmKeyIsFilename'};
my $dbmKeyIsMD5Sum = $params{'-dbmKeyIsMD5Sum'};
my $dbmBlockCheck = $params{'-dbmBlockCheck'};
my $indexDir = $params{'-indexDir'};
my $backupRoot = $params{'-backupRoot'};
my $backupDirIndex = $params{'-backupDirIndex'};
my $noBackupDir = $params{'-noBackupDir'};
my $checkSumFile = $params{'-checkSumFile'};
my $checkSumFileVersion = $params{'-checkSumFileVersion'};
my $blockCheckSumFile = $params{'-blockCheckSumFile'};
my $progressReport = 5 * $params{'-progressReport'};
my $prLog = $params{'-prLog'};
my $suppressInfo = $params{'-suppressInfo'};
my $tmpdir = $params{'-tmpdir'};
my $rcsf = readCheckSumFile->new('-checkSumFile' =>
"$backupRoot/$checkSumFile",
'-prLog' => $prLog,
'-tmpdir' => $tmpdir);
my $v = $rcsf->getInfoWithPar('version');
$prLog->print('-kind' => 'E',
'-str' =>
["Version of file " . $checkSumFile .
"is $v, must be " . $checkSumFileVersion,
"Please upgrade to version $checkSumFileVersion " .
"with storeBackupConvertBackup.pl"],
'-exit' => 1)
unless $v eq $checkSumFileVersion;
$prLog->print('-kind' => 'I',
'-str' => ["start reading " . $rcsf->getFilename()]);
my $noLines = 0;
my $noEntriesInDBM = 0;
my (%md5InThisBackup);
my $noEntriesBlockCheck = 0;
my ($md5sum, $compr, $devInode, $inodeBackup, $ctime, $mtime, $atime,
$size, $uid, $gid, $mode, $f);
while ((($md5sum, $compr, $devInode, $inodeBackup, $ctime, $mtime,
$atime, $size, $uid, $gid, $mode, $f) = $rcsf->nextLine()) > 0)
{
#print "==1==$backupDirIndex==$md5sum=$f=\n";
++$noLines;
$prLog->print('-kind' => 'P',
'-str' => [" read $noLines lines ..."])
if $progressReport and $noLines % $progressReport == 0;
#print "==1.2==\n";
next if length($md5sum) != 32; # ist dir, pipe, symlink
#print "==1.3==\n";
my ($fbase, $fname, $index) = $indexDir->newFile($f);
my $md5pack = pack('H32', $md5sum);
#print "==2==$backupDirIndex==$md5sum=$f=$index/$fname=\n";
if ((not exists $md5InThisBackup{$md5pack}
and (exists $$dbmKeyIsMD5Sum{$md5pack}))
or exists $$dbmKeyIsFilename{"$index/$fname"})
{
next;
}
#print "==3==\n";
++$noEntriesInDBM;
$md5InThisBackup{$md5pack} = 1;
$$dbmKeyIsMD5Sum{$md5pack} = pack('FaSa*', $inodeBackup, $compr,
$backupDirIndex, "$index/$fname");
$$dbmKeyIsFilename{"$index/$fname"} =
pack('aIIFH32', $compr, $ctime, $mtime, $size, $md5sum);
my $flagBlockDevice = $params{'-flagBlockDevice'};
my $suppInfo = 0;
$suppInfo = 1 if exists $$suppressInfo{'readCheckSums'};
#print "==4==suppInfo=$suppInfo, flagBlockDevice=$flagBlockDevice, suppressInfo=", join(':', sort keys %$suppressInfo), "\n";
if ($compr eq 'b')
{
$prLog->print('-kind' => 'I',
'-str' => [" start reading blocked file $f"])
unless $suppInfo;
my $nebl;
($nebl, $noLines) =
&::buildBlockedDMBs($blockCheckSumFile, $flagBlockDevice,
$params{'-saveRAM'}, $params{'-dbmBaseName'},
$prLog, $backupRoot, $f, $dbmBlockCheck,
$indexDir, $noLines, $progressReport, $tmpdir,
$suppressInfo);
$noEntriesBlockCheck += $nebl;
$prLog->print('-kind' => 'I',
'-str' => [" finished reading blocked file $f"])
unless $suppInfo;
}
}
$prLog->print('-kind' => 'I',
'-str' =>
["finished reading " . $rcsf->getFilename() .
" ($noLines entries)"]);
return ($noEntriesInDBM, $noEntriesBlockCheck);
}
sub buildBlockedDMBs
{
my ($blockCheckSumFile, $flagBlockDevice, $saveRAM, $dbmBaseName,
$prLog, $backupRoot, $relFile, $dbmBlockCheck, $indexDir, $noLines,
$progressReport, $tmpdir, $suppressInfo) = @_;
# read dbmBlockCheck
my $noEntriesBlockCheck = 0;
my $f = "$backupRoot/$relFile/$blockCheckSumFile";
my $suppInfo = 0;
$suppInfo = 1 if exists $$suppressInfo{'readCheckSums'};
if ($flagBlockDevice and (-e $f or -e "$f.bz2"))
{
local *IN;
my $in = undef;
if (-e $f)
{
open(IN, "<", $f) or
$prLog->print('-kind' => 'E',
'-str' => ["cannot open <$f>, exiting"],
'-add' => [__FILE__, __LINE__],
'-exit' => 1);
}
else # "$f.bz2"
{
$in = pipeFromFork->new('-exec' => 'bzip2',
'-param' => ['-d'],
'-stdin' => "$f.bz2",
'-outRandom' => "$tmpdir/stbuPipeFrom0-",
'-prLog' => $prLog);
}
my $l;
while ($l = $in ? $in->read() : )
{
next if $l =~ /\A#/;
chop $l;
my ($md5, $compr, $filename) = split(/\s/, $l, 3);
$filename =~ s/\\0A/\n/og; # '\n' wiederherstellen
$filename =~ s/\\5C/\\/og; # '\\' wiederherstellen
my ($fbase, $fname, $index) =
$indexDir->newFile("$backupRoot/$filename");
$$dbmBlockCheck{$md5} = "$compr $index/$fname";
++$noEntriesBlockCheck;
++$noLines;
$prLog->print('-kind' => 'P',
'-str' => [" read $noLines lines ..."])
if $progressReport and $noLines % $progressReport == 0
and not $suppInfo;
}
if ($in)
{
my $out = $in->getSTDERR();
if (@$out)
{
$prLog->print('-kind' => 'E',
'-str' =>
["reading from $f.bz2 generated",
@$out]);
exit 1;
}
$in->close();
}
else
{
close(IN);
}
}
return ($noEntriesBlockCheck, $noLines);
}
##################################################
sub readAllBackupSeries
{
my $dir = shift;
my $prLog = shift;
my (%dirs) = ();
&::_readAllBackupSeries($dir, \%dirs, $prLog);
return keys %dirs;
}
##################################################
sub _readAllBackupSeries
{
my $dir = shift;
my $dirs = shift;
my $prLog = shift;
return if -l $dir;
my ($x, $entry) = ::splitFileDir($dir);
if ($entry =~ /\A\d{4}\.\d{2}\.\d{2}_\d{2}\.\d{2}\.\d{2}\Z/)
{
# next if -e "$dir/.md5CheckSums.notFinished";
next unless &::checkIfBackupWasFinished('-backupDir' => $dir,
'-prLog' => $prLog,
'-count' => 1);
$$dirs{$x} = 1;
}
elsif ($entry =~ /\A\d{4}\.\d{2}\.\d{2}_\d{2}\.\d{2}\.\d{2}-.*\Z/)
{
return;
}
else
{
local *DIR;
unless (opendir(DIR, $dir))
{
return;
}
while ($entry = readdir DIR)
{
next if ($entry eq '.' or $entry eq '..');
my $fullEntry = "$dir/$entry";
next unless -d $fullEntry;
&::_readAllBackupSeries($fullEntry, $dirs, $prLog);
}
close(DIR);
}
}
##################################################
sub readAllBackupDirs # only used by storeBackupVersion.pl
{
my $allBackupsRoot = shift;
my $prLog = shift;
my $fullpath = shift; # 1: ja, 0: nein
# alle Verzeichnisse lesen und merken
local *BACKUPROOT;
opendir(BACKUPROOT, $allBackupsRoot) or
$prLog->print('-kind' => 'E',
'-str' => ["cannot opendir <$allBackupsRoot>, exiting"],
'-add' => [__FILE__, __LINE__],
'-exit' => 1);
my (@dirs, $entry);
while ($entry = readdir BACKUPROOT)
{
next if (-l $entry and not -d $entry); # nur Directories interessant
next unless $entry =~ # Dateiname muß passen
/\A(\d{4})\.(\d{2})\.(\d{2})_(\d{2})\.(\d{2})\.(\d{2})\Z/o;
push @dirs, $fullpath ? "$allBackupsRoot/$entry" : $entry;
}
closedir(BACKUPROOT);
return (sort @dirs); # ältestes zuerst
}
##################################################
sub analysePathToBackup
{
my $prLog = shift;
# Einer der beiden folgender Parameter darf
# nicht undef sein. Dieser wird dann zur
# Bestimmung der return-Werte verwendet
my $backupRoot = shift; # gesetzt auf den Pfad zum Archiv oder undef
my $file = shift; # Datei innerhalb eines Archivs (oder undef)
my $checkSumFile = shift; # z.B. '.md5CheckSums'
my $verbose = shift; # undef oder definiert
if ($backupRoot)
{
$prLog->print('-kind' => 'E',
'-str' => ["directory <$backupRoot> does not exit"],
'-exit' => 1)
unless (-d $backupRoot);
$backupRoot = &absolutePath($backupRoot);
}
else
{
my ($dir, $x) = &splitFileDir($file);
$backupRoot = undef;
do
{
# feststellen, ob eine .md5sum Datei vorhanden ist
if (-f "$dir/$checkSumFile" or -f "$dir/$checkSumFile.bz2")
{
$prLog->print('-kind' => 'I',
'-str' => ["found info file <$checkSumFile> in "
. "directory <$dir>"])
if ($verbose);
$prLog->print('-kind' => 'E',
'-str' =>
["found info file <$checkSumFile> a second time "
. "in <$dir>, first time found in " .
"<$backupRoot>"],
'-exit' => 1)
if ($backupRoot);
$backupRoot = $dir;
}
($dir, $x) = &splitFileDir($dir);
} while ($dir ne '/');
$prLog->print('-kind' => 'E',
'-str' => ["did not find info file <$checkSumFile>"],
'-exit' => 1)
unless ($backupRoot);
}
my $checkSumFileRoot = $checkSumFile;
$checkSumFileRoot .= ".bz2" if (-f "$backupRoot/$checkSumFile.bz2");
$prLog->print('-kind' => 'E',
'-str' => ["no info file <$checkSumFileRoot> in <$backupRoot>"],
'-exit' => 1)
unless(-f "$backupRoot/$checkSumFileRoot");
# jetzt $restoreTree relativ zu $backupRoot machen
my $fileWithRelPath = $file ?
substr($file, length($backupRoot) + 1) : undef;
my ($storeBackupAllTrees, $fileDateDir) = &splitFileDir($backupRoot);
# ^^^
# Beispiel: (/tmp/stbu/2001.12.20_16.21.59/perl/Julian.c.bz2)
# $backupRoot beinhaltet jetzt den Pfad zum Archiv
# (/tmp/stbu/2001.12.20_16.21.59)
# $file beinhaltet die Datei mit kompletten, absoluten Pfad
# (/tmp/stbu/2001.12.20_16.21.59/perl/Julian.c.bz2)
# -> nur, wenn $file nicht undef war
# $fileWithRelPath beinhaltet jetzt den relativen Pfad innerhalb des Archivs
# (perl/Julian.c.bz2)
# -> nur, wenn $file nicht undef war
# $storeBackupAllTrees beinhaltet den Root-Pfad des storeBackup (oberhalb
# der Datum Directories)
# (/tmp/stbu)
# $fileDateDir beinhaltet den Namen des Datum-Dirs des gesuchten files
# (2001.12.20_16.21.59)
#print "backupRoot = $backupRoot\n";
#print "file = $file\n";
#print "fileWithRelPath = $fileWithRelPath\n";
#print "storeBackupAllTrees = $storeBackupAllTrees\n";
#print "fileDateDir = $fileDateDir\n\n";
return ($backupRoot, $file, $fileWithRelPath, $storeBackupAllTrees,
$fileDateDir);
}
############################################################
# makes the directories to a file
sub makeFilePathCache
{
my $path = shift;
my $prLog = shift;
$path =~ m#\A(.*)/.*\Z#s;
&makeDirPathCache($1, $prLog);
}
############################################################
# like `mkdir -p`, all permissions set to 0700
# cached version to avoid latency due to '-e dir'
# success: returns 1
# no success: returns 0
%main::makeDirPathCache = ();
sub makeDirPathCache
{
my $path = shift;
my $prLog = shift;
return unless $path;
# build path series
my (@paths) = ($path);
my $p1 = $path;
while (1)
{
($p1) = $p1 =~ m#\A(.*)/(.*)\Z#s;
last unless $p1;
push @paths, $p1;
}
(@paths) = reverse(@paths);
# check for existing paths
my $i = 0;
for ( ; $i < @paths ; $i++)
{
my $p = $paths[$i];
unless (exists $main::makeDirPathCache{$p})
{
if (-e $p)
{
$main::makeDirPathCache{$p} = 1;
}
else
{
last;
}
}
}
# create new paths
my @ret = ();
for ( ; $i < @paths ; $i++)
{
my $p = $paths[$i];
#print "in makeDirPathCache $p\n";
unless (mkdir $p, 0700)
{
$prLog->print('-kind' => 'E',
'-str' => ["cannot create directory <$p>"]);
# return 0;
return wantarray ? () : 0;
}
$main::makeDirPathCache{$p} = 1;
push @ret, $p;
}
# return 1;
return wantarray ? @ret : 1;
}
########################################
sub calcFileMD5Sum
{
my $file = shift;
local *FILE;
sysopen(FILE, "$file", O_RDONLY) or return undef;
my $md5All = Digest::MD5->new();
my $buffer;
while (sysread(FILE, $buffer, 1024**2))
{
$md5All->add($buffer);
}
close(FILE) or return undef;
return $md5All->hexdigest();
}
########################################
sub compressOneBlock
{
my $block = shift;
my $file = shift;
my $compressProc = shift;
my $compressOptions = shift;
my $prLog = shift;
my $tmpdir = shift;
my $comp = pipeToFork->new('-exec' => $compressProc,
'-param' => $compressOptions,
'-stdout' => $file,
'-outRandom' => "$tmpdir/stbuPipeTo1-",
'-delStdout' => 'no',
'-prLog' => $prLog);
$comp->print($block);
$comp->wait();
my $out = $comp->getSTDERR();
if (@$out)
{
$prLog->print('-kind' => 'E',
'-str' => ["$compressProc reports errors:",
@$out],
'-exit' => 1);
}
$comp->close();
return 0;
}
########################################
sub copyOneBlock
{
my $block = shift;
my $file = shift;
my $prLog = shift;
local *COMP;
sysopen(COMP, $file, O_CREAT | O_WRONLY) or
$prLog->print('-kind' => 'E',
'-str' => ["cannot write to <$file>"],
'-exit' => 1);
unless (syswrite(COMP, $block))
{
$prLog->print('-kind' => 'E',
'-str' => ["writing to <$file> failed"]);
}
close(COMP);
return 0;
}
##################################################
sub hardLinkDir
{
my $from = shift;
my $to = shift;
my $mask = shift; # pattern must match each file
my $uid = shift;
my $gid = shift;
my $mode = shift;
my $prLog = shift;
my $maxHardLinks = shift;
my $checkWithChecksumFile = shift; # eg. .md5BlockCheckSums.bz2 or undef
local *DIR;
opendir(DIR, $from) or
$prLog->print('-kind' => 'E',
'-str' => ["cannot opendir <$from>, exiting"],
'-add' => [__FILE__, __LINE__],
'-exit' => 1);
my $entry;
my $anz = 0;
my %filesDir; # list of all block files in the directory
while ($entry = readdir DIR)
{
next unless -f "$from/$entry";
next unless $entry =~ /$mask/;
$filesDir{$entry} = 1;
my $hl = -1;
if ($maxHardLinks > 0)
{
$hl = (stat("$from/$entry"))[3];
}
my $hlCopy = 0;
if ($hl < $maxHardLinks) # below number of allowed hard links
{
unless (link "$from/$entry", "$to/$entry")
{
$hlCopy = 1; # try to hard link was not successfull
}
}
else # reached number of allowed hard links
{
$hlCopy = 1; # don't try to hard link -> copy file
}
# unless (link "$from/$entry", "$to/$entry")
if ($hlCopy)
{
$prLog->print('-kind' => 'E',
'-str' =>
["cannot hard link $from/$entry -> $to/$entry"],
'-exit' => 1)
unless ::copyFile("$from/$entry", "$to/$entry");
}
++$anz;
if (defined $mode)
{
chmod $mode, "$to/$entry";
chown $uid, $gid, "$to/$entry";
}
}
closedir(DIR);
if (defined $checkWithChecksumFile)
{
my $f = "$to/$checkWithChecksumFile";
$prLog->print('-kind' => 'E',
'-str' => ["cannot read <$f>"],
'-exit' => 1)
unless -r $f;
my @filesMeta;
my $z = IO::Uncompress::Bunzip2->new($f) or
$prLog->print('-kind' => 'E',
'-str' => ["bunzip2 failed: $Bunzip2Error"],
'-exit' => 1);
while (my $line = $z->getline())
{
$line =~ s/\A\s*(.*?)\s*\Z/$1/; # minimal match
# print "-- $line\n";
my ($f);
my $n = ($_, $_, $f) = split(/\s+/, $line, 3);
$prLog->print('-kind' => 'E',
'-str' => ["wrong entry <$line> found in <$f>"],
'-exit' => 1)
unless $n == 3;
$f =~ /\A.+\/(\d+)(\.\S+)?/;
my $i = int($1);
$filesMeta[$i] = "$1$2";
# print " <$1><$2> -> $i\n";
}
for (my $i = 1 ; $i < @filesMeta ; $i++)
{
# print "$to -> <", $filesMeta[$i], ">\n";
$prLog->print('-kind' => 'E',
'-str' => ["entry $i is missing in <$to>"])
unless -e "$to/" . $filesMeta[$i];
$prLog->print('-kind' => 'E',
'-str' => ["entry $i in wronng format in <$to/$checkWithChecksumFile>"])
unless exists $filesDir{$filesMeta[$i]};
}
}
return $anz;
}
##################################################
# reads configuration file
# storeBackupBaseTree.conf in backupDir if exists
sub readBackupDirBaseTreeConf
{
my ($confFile, $backupDir, $prLog) = (@_);
my $backupTreeName = undef;
my $backupType = undef;
my $seriesToDistribute = undef;
my $deltaCache = undef;
if (-r "$confFile")
{
$prLog->print('-kind' => 'I',
'-str' => ["reading <$confFile>"]);
my $backupTreeConf =
CheckParam->new('-configFile' => '-f',
'-prLog' => $prLog,
'-list' => [
Option->new('-name' => 'baseTreeConf',
'-cl_option' => '-f',
'-param' => 'yes',
'-must_be' => 'yes'),
Option->new('-name' => 'backupTreeName',
'-cf_key' => 'backupTreeName',
'-param' => 'yes',
'-must_be' => 'yes'),
Option->new('-name' => 'backupType',
'-cf_key' => 'backupType',
'-default' => 'none',
'-pattern' =>
'\Amaster\Z|\Acopy\Z|\Anone\Z'),
Option->new('-name' => 'seriesToDistribute',
'-cf_key' => 'seriesToDistribute',
'-must_be' => 'yes',
'-multiple' => 'yes'),
Option->new('-name' => 'deltaCache',
'-cf_key' => 'deltaCache',
'-must_be' => 'yes',
'-param' => 'yes')
]);
$backupTreeConf->check('-argv' => ['-f' => $confFile],
'-help' =>
"cannot read /interpret file <$confFile>\n");
$backupTreeName = $backupTreeConf->getOptWithPar('backupTreeName');
$backupType = $backupTreeConf->getOptWithPar('backupType');
$seriesToDistribute =
$backupTreeConf->getOptWithPar('seriesToDistribute');
$deltaCache = $backupTreeConf->getOptWithPar('deltaCache');
$deltaCache =~ s/\/+$//;
}
return ($backupTreeName, $backupType, [sort @$seriesToDistribute],
$deltaCache);
}
##################################################
# reads configuration file
# deltaCache.conf in deltaCache if exists
sub readDeltaCacheConf
{
my ($confFile, $deltaCache, $expandWildcards, $prLog) = (@_);
my (@opts, $i);
return ()
unless -r $confFile;
$prLog->print('-kind' => 'I',
'-str' => ["reading <$confFile>"]);
my (@opts, $i);
foreach $i (0..9)
{
$opts[$i] = Option->new('-name' => "backupCopy$i",
'-cf_key' => "backupCopy$i",
'-param' => 'yes',
'-multiple' => 'yes');
}
my $copyStConf =
CheckParam->new('-configFile' => '-f',
'-prLog' => $prLog,
'-list' => [
Option->new('-name' => 'deltaCacheConf',
'-cl_option' => '-f',
'-param' => 'yes',
'-must_be' => 'yes'),
@opts]);
$copyStConf->check('-argv' => ['-f' => $confFile],
'-help' => "cannot read file <$confFile>\n");
my (@bc);
foreach $i (0..9)
{
my $bc = $copyStConf->getOptWithPar("backupCopy$i");
next unless $bc;
$prLog->print('-kind' => 'E',
'-str' =>
["$confFile: only one entry <@$bc> for option " .
", must be backupTreeName series ... "],
'-exit' => 1)
if @$bc == 1;
if ($expandWildcards)
{
my (@seriesInConf) = (@$bc[1..@$bc-1]);
splice(@$bc, 1); # remove everything except the first element
my (@readSeries) =
&::evalExceptionList_PlusMinus(\@seriesInConf, $deltaCache,
'deltaCache series', 'series', 0,
'(\/processedBackups\Z|\/deltaCache.conf\Z|\/\.{1,2}\Z)',
1, $prLog);
#print "1--@seriesInConf------------------- \@readSeries=@readSeries\n";
foreach my $r (@readSeries)
{
push @$bc, $r if -d "$deltaCache/$r";
}
}
push @bc, $bc;
}
return (@bc);
}
########################################
# searches recursivly all included backups below $backupDir.
# $backupDir may be the master backup directory, a series or
# a discrete backup directory
# includeRenamedBackupDirs must be set to or <1>
# lastOfEachSeries must be set to or <1>, then only the last entry of
# each series is delivered
sub selectBackupDirs
{
my ($backupDir, $includeRenamedBackups, $checkSumFile, $prLog,
$lastOfEachSeries) = (@_);
if (-l $backupDir)
{
my $newLink = ::absolutePath($backupDir);
$prLog->print('-kind' => 'I',
'-str' =>
["replacing symlink <$backupDir> with <$newLink>"]);
$backupDir = $newLink;
}
my $allLinks = lateLinks->new('-dirs' => [$backupDir],
'-kind' => 'recursiveSearch',
'-verbose' => 0,
'-prLog' => $prLog,
'-includeRenamedBackupDirs' =>
$includeRenamedBackups);
my $allStbuDirs = $allLinks->getAllStoreBackupDirs();
# filter the relevant backups
my (@dirsToCheck) = sort { $a cmp $b } @$allStbuDirs;
$prLog->print('-kind' => 'E',
'-str' => ["nothing to do, no backup directories specified"],
'-exit' => 1)
unless @dirsToCheck;
{
my (@d, $d);
(@d) = (@dirsToCheck);
(@dirsToCheck) = ();
foreach $d (@d)
{
unless (-r "$d/$checkSumFile" or
-r "$d/$checkSumFile.bz2")
{
$prLog->print('-kind' => 'E',
'-str' => ["no readable <$checkSumFile> in " .
"<$d> ... skipping"]);
next;
}
# if (-e "$d/$checkSumFile.notFinished")
unless (&::checkIfBackupWasFinished('-backupDir' => $d,
'-prLog' => $prLog,
'-count' => 2))
{
$prLog->print('-kind' => 'E',
'-str' => ["backup <$d> not finished" .
" ... skipping"]);
next;
}
if (-e "$d/.storeBackupLinks/linkFile.bz2")
{
$prLog->print('-kind' => 'E',
'-str' =>
["backup <$d> needs run of " .
"storeBackupUpdateBackup.pl" .
" ... skipping"]);
next;
}
push @dirsToCheck, $d;
}
if ($lastOfEachSeries)
{
my (%lastOfSeries, $e);
foreach $e (sort @dirsToCheck)
{
my ($seriesPath) = $e
=~ /\A(.*)\/\d{4}\.\d{2}\.\d{2}_\d{2}\.\d{2}\.\d{2}(-.+)?\Z/;
$lastOfSeries{$seriesPath} = $e;
}
(@dirsToCheck) = sort values %lastOfSeries;
}
my (@out);
foreach my $o (@dirsToCheck)
{
push @out, " $o";
}
$prLog->print('-kind' => 'I',
'-str' => ["backup directories to check", @out]);
}
return (@dirsToCheck);
}
########################################
# copies all special files including directory structure to
# another directory
sub copyStbuSpecialFiles
{
my ($backupDir, $targetBackupDir, $prLog, $verbose, $tmpdir) = (@_);
$prLog->print('-kind' => 'E',
'-str' => ["cannot create directory " .
"<$targetBackupDir/.storeBackupLinks>"],
'-exit' => 1)
unless mkdir "$targetBackupDir/.storeBackupLinks", 0700;
$prLog->print('-kind' => 'I',
'-str' => ["created directory " .
"<$targetBackupDir/.storeBackupLinks>"])
if $verbose;
my $f = undef;
if (-f "$backupDir/.md5CheckSums")
{
$f = ".md5CheckSums";
}
elsif (-f "$backupDir/.md5CheckSums.bz2")
{
$f = ".md5CheckSums.bz2";
}
$prLog->print('-kind' => 'E',
'-str' => ["cannot read <$backupDir/.md5CheckSums[.bz2]>"],
'-exit' => 1)
unless $f;
©FilePerm("$backupDir/$f" => $targetBackupDir, $prLog, $verbose);
©FilePerm("$backupDir/.md5CheckSums.info" => $targetBackupDir,
$prLog, $verbose);
$f = "$backupDir/.md5BlockCheckSums.bz2";
©FilePerm($f => $targetBackupDir, $prLog, $verbose)
if -e $f;
my $rcsf = readCheckSumFile->new('-checkSumFile' =>
"$backupDir/.md5CheckSums",
'-prLog' => $prLog,
'-tmpdir' => $tmpdir);
my ($md5sum, $compr, $devInode, $inodeBackup, $ctime, $mtime, $atime,
$size, $uid, $gid, $mode, $filename);
while ((($md5sum, $compr, $devInode, $inodeBackup, $ctime, $mtime,
$atime, $size, $uid, $gid, $mode, $filename) =
$rcsf->nextLine()) > 0)
{
if ($compr eq 'b') # blocked file
{
$f = undef;
if (-f "$backupDir/$filename/.md5BlockCheckSums")
{
$f = ".md5BlockCheckSums";
}
elsif (-f "$backupDir/$filename/.md5BlockCheckSums.bz2")
{
$f = ".md5BlockCheckSums.bz2";
}
&::makeDirPath("$targetBackupDir/$filename", $prLog);
©FilePerm("$backupDir/$filename/$f"
=> "$targetBackupDir/$filename",
$prLog, $verbose);
}
}
$f = "$backupDir/$main::finishedFlag";
©FilePerm($f => "$targetBackupDir/.storeBackupLinks", $prLog, $verbose)
if $f;
}
##################################################
sub copyFilePerm
{
my ($source, $target, $prLog, $verbose) = @_;
$prLog->print('-kind' => 'E',
'-str' => ["cannot copy $source -> $target"],
'-exit' => 1)
if system("cp -a \"$source\" \"$target\"");
$prLog->print('-kind' => 'I',
'-str' => ["copied $source -> $target"])
if $verbose;
}
##################################################
#
# exception-Liste überprüfen und evaluieren
# considering '+' and '-' before list
#
sub evalExceptionList_PlusMinus
{
my $exceptDirs = shift; # Pointer auf Liste mit Ausnahme-Directories
my $sourceDir = shift;
my $exceptDir = shift; # text for output
my $excluding = shift; # text for output
my $contExceptDirsErr = shift;
my $avoidPattern = shift; # undef means not set
my $relPath = shift; # 0 or 1, delivers rel path related to $sourceDir
my $prLog = shift;
my (@plus) = ();
my (@minus) = ();
foreach my $e (@$exceptDirs)
{
if ($e =~ /\A\-(.*)/) # subtract
{
push @minus, $1;
}
else # add
{
my $p = $e;
$p = $1 if $e =~ /\A\+(.*)/;
push @plus, $p;
}
}
(@plus) = &::evalExceptionList(\@plus, $sourceDir, $exceptDir,
"consider $excluding", $contExceptDirsErr,
$avoidPattern, $relPath, $prLog);
(@minus) = &::evalExceptionList(\@minus, $sourceDir, $exceptDir,
"avoid $excluding", $contExceptDirsErr,
$avoidPattern, $relPath, $prLog);
# subtract
my (%plus);
foreach my $p (@plus)
{
$plus{$p} = 1;
}
foreach my $m (@minus)
{
delete $plus{$m} if defined $plus{$m};
}
my (@pr);
foreach my $p (sort keys %plus)
{
push @pr, " series <$p>";
}
if (@pr)
{
$prLog->print('-kind' => 'I',
'-str' => ["resulting series", @pr]);
}
else
{
$prLog->print('-kind' => 'W',
'-str' => ["no resulting series"]);
}
return (sort keys %plus);
}
##################################################
#
# exception-Liste überprüfen und evaluieren
#
sub evalExceptionList
{
my $exceptDirs = shift; # Pointer auf Liste mit Ausnahme-Directories
my $sourceDir = shift;
my $exceptDir = shift; # text for output
my $excluding = shift; # text for output
my $contExceptDirsErr = shift;
my $avoidPattern = shift; # undef means not set
my $relPath = shift; # 0 or 1, delivers rel path related to $sourceDir
my $prLog = shift;
#print "evalExceptionList: exceptDirs=<@$exceptDirs>\n";
#print "evalExceptionList: sourceDir=<$sourceDir>\n";
#print "evalExceptionList: exceptDir=<$exceptDir>\n";
#print "evalExceptionList: excluding=<$excluding>\n";
#print "evalExceptionList: contExceptDirsErr=<$contExceptDirsErr>\n";
#print "evalExceptionList: avoidPattern=<$avoidPattern>\n";
#print "evalExceptionList: relPath=<$relPath>\n";
my $e;
my $flag = 0;
my (@allExceptDirs);
my $kind = $contExceptDirsErr ? 'W' : 'E';
my $lenSourceDir = length($sourceDir);
foreach $e (@$exceptDirs)
{
my $_e = "$sourceDir/$e";
$_e =~ s/(\s)/\\$1/g;
my (@a) = ($_e);
my (@e) = <@a>; # wildcards auflösen, rechts muss Array stehen
if (defined $avoidPattern)
{
my (@e_tmp) = ();
foreach my $e_tmp (@e)
{
next unless -d $e_tmp;
push @e_tmp, $e_tmp
unless $e_tmp =~ /$avoidPattern/;
}
(@e) = (@e_tmp);
}
unless (@e) # this happens if path does not exist
{
$prLog->print('-kind' => $kind,
'-str' =>
["<$sourceDir/$e>: path or pattern of $exceptDir " .
"does not exist"]);
$flag = 1;
}
(@a) = (); # wird jetzt zum Aufsammeln verwendet
my $e1;
foreach $e1 (@e)
{
next unless -l $e1 or -d $e1;
my $a = &::absolutePath($e1);
if ($a)
{
push @a, $a;
}
else
{
$flag = 1;
$prLog->print('-kind' => $kind,
'-str' => ["$exceptDir <$e1> does not exist"])
if $prLog;
next;
}
}
unless (@a)
{
$prLog->print('-kind' => $kind,
'-str' => ["no directory resulting from " .
"$exceptDir pattern <$e>"]);
$flag = 1;
next;
}
push @allExceptDirs, @a;
if (@e == 1 and $a[0] eq $e)
{
my $x = $relPath ? substr($a[0], $lenSourceDir + 1) : $a[0];
$prLog->print('-kind' => 'I',
'-str' => ["$excluding <$x>"]);
# '-str' => ["$excluding <$a[0]>"]);
}
elsif (@a != 0)
{
my (@p, $p);
foreach $p (@a)
{
my $x = $relPath ? substr($p, $lenSourceDir + 1) : $p;
push @p, " $excluding <$x>";
# push @p, " $excluding <$p>";
}
$prLog->print('-kind' => 'I',
'-str' => ["$excluding <$e>:", @p]);
}
}
if ($flag and not $contExceptDirsErr)
{
$prLog->print('-kind' => 'E',
'-str' => ["exiting"]);
exit 1;
}
if ($relPath)
{
my (@ret) = ();
foreach my $aed (@allExceptDirs)
{
push @ret, substr($aed, $lenSourceDir + 1);
}
return (@ret);
}
else
{
return (@allExceptDirs);
}
}
##################################################
# checks if a backup was finished
# there is a dependency to the storeBackup version
# up to 3.4.3: file .md5CheckSums.notFinished
# after 3.4.3: file $main::finishedFlag (.md5CheckSums.Finished)
#
# return 0 -> not finished
# return 1 -> finished
##################################################
sub checkIfBackupWasFinished
{
my $self = {};
my (%params) = ('-backupDir' => undef,
'-prLog' => undef,
'-count' => undef);
&::checkObjectParams(\%params, \@_, '::checkIfBackupWasFinished',
['-prLog', '-backupDir']);
my $prLog = $params{'-prLog'};
my $backupDir = $params{'-backupDir'};
my $count = $params{'-count'};
# fast check with new method
my $finished = -e "$backupDir/$main::finishedFlag";
return 1 if $finished;
my $infoFile = "$backupDir/.md5CheckSums.info";
#print "+++$count+++backupDir = <$backupDir>\n";
#print "infoFile = <$infoFile>\n";
unless (-f "$infoFile")
{
$prLog->print('-kind' => 'W',
'-str' => ["cannot find <$infoFile>"]);
return 0;
}
my $CSFile =
CheckParam->new('-configFile' => '-f',
'-prLog' => $prLog,
'-replaceEnvVar' => 'no',
'-ignoreLeadingWhiteSpace' => 1,
'-list' => [
Option->new('-name' => 'infoFile',
'-cl_option' => '-f',
'-param' => 'yes'),
Option->new('-name' => 'storeBackupVersion',
'-cf_key' => 'storeBackupVersion',
'-param' => 'yes',
'-multiple' => 'yes')
]);
$CSFile->check('-argv' => ['-f' => "$infoFile"],
'-help' =>
"cannot read file <$infoFile>\n",
'-ignoreAdditionalKeys' => 1);
my $stbuVersionLong = $CSFile->getOptWithPar('storeBackupVersion');
my $stbuVersion =
$stbuVersionLong ? &::calcOneVersionNumber($$stbuVersionLong[0]) : 0;
#print "-1-<$$stbuVersionLong[0]> <$stbuVersion>\n";
if ($stbuVersion > 3.004003) # new method with $main::finishedFlag
{
return 0; # file $main::finishedFlag doesn't exist (see 'fast check' above)
}
else # old method with .md5CheckSums.notFinished
{
return (-e "$backupDir/.md5CheckSums.notFinished") ? 0 : 1;
}
}
##################################################
# Bezeichnung für timescale:
# 50d3m -> 50 Tage, 3 Minuten
# a50d3m -> 50 Tage, 3 Minuten -> Archive Flag gesetzt, wird bei
# keepMaxNumber nicht gelöscht
# bei keepDouplicate werden auch Backups
# mit Archive Flag gelöscht
#
# in (L1) sind alle Directorynamen von Backups
# (keepMaxNumber >= keepMinNumber)
# (Syntax: (L1) -> (L2) bedeutet: alle betroffenen aus Liste 1 nach Liste 2
# verschieben)
#
# in method 'deleteOldBackupDirs::checkBackups':
#
#1. Duplikate eines Tages separieren:
# betroffene (aller außer den Letzten des Tages) von (L1) -> (L2)
#
#2. keepDuplicate - zu alte Duplikate löschen:
# betroffene von (L2) -> (Llösch)
#
#=> in (L2) sind jetzt alle Duplikate, die (erst mal) nicht
# gelöscht werden sollen
#
#3. keepFirstOfYear - ersten eines Jahres behalten:
# (immer den letzten des Tages!)
# betroffene (L1): Flag 'notDelete' setzen + eventuell Archiv Flag
#
#4. keepLastOfYear - letzten eines Jahres behalten:
# (immer den letzten des Tages!)
# betroffene (L1): Flag 'notDelete' setzen + eventuell Archiv Flag
#
#5. keepFirstOfMonth - ersten eines Monats behalten:
# (immer den letzten des Tages!)
# betroffene (L1): Flag 'notDelete' setzen + eventuell Archiv Flag
#
#6. keepLastOfMonth - letzten eines Monats behalten:
# (immer den letzten des Tages!)
# betroffene (L1): Flag 'notDelete' setzen + eventuell Archiv Flag
#
#7. keepFirstOfWeek - ersten einer Woche behalten:
# (immer den letzten des Tages!)
# betroffene (L1): Flag 'notDelete' setzen + eventuell Archiv Flag
#
#8. keepLastOfWeek - letzten einer Woche behalten:
# (immer den letzten des Tages!)
# betroffene (L1): Flag 'notDelete' setzen + eventuell Archiv Flag
#
#9. keepWeekday (berücksichtigt Defaultwerte von keepAll) -
# alle noch nicht zu alten behalten:
# betroffene (L1): Flag 'notDelete' setzen + eventuell Archiv Flag
#
#10. Backups mit Flag 'notDelete' verschieben:
# betroffene (L1) -> (L3), wenn kein Archiv Flag
# betroffene (L1) -> (L4), wenn Archiv Flag
#
#11. alle (L1) -> (Llösch) verschieben
#
#=> in Llösch sind die bisher zu löschenden Backupverzeichnisse
#=> L1 ist leer
#=> in L2 sind jetzt die Duplikate
#=> in L3 sind die mit noDelete, aber ohne Archiv Flag
#=> in L4 sind jetzt die, die das Archiv Flag gesetzt haben
#
#12. keepMinNumber - minimal zu behaltende in Sicherheit bringen
# n = keepMinNumber - scalar(L4) # die zu archivierenden abziehen
# die n jüngsten in Sicherheit bringen:
# betroffene (L3) -> (L4) in (L3) sind die noDelete ohne Archiv-Flag
# wenn das nicht reicht, betroffene (Llösch) -> (L4)
#
#13. keepMaxNumber - alles was über die Zahl geht löschen (außer in L4)
# Der folgenden Reihe nach, beginnend mit den ältesten, verschieben:
# a) (L2) -> (Llösch)
# b) wenn noch zu viele: (L3) -> (Llösch)
#
#14. Warnung ausgeben, wenn mehr als keepMaxNumber übrigbleiben
#
#15. Option lateLinks berücksichtigen
#
#16. Alle in (Llösch) löschen
##################################################
package deleteOldBackupDirs;
sub new
{
my $class = shift;
my $self = {};
my (%params) = ('-targetDir' => undef,
'-doNotDelete' => undef,
'-deleteNotFinishedDirs'=> undef,
'-checkSumFile' => undef,
'-actBackupDir' => undef,
'-prLog' => undef,
'-today' => undef,
'-keepFirstOfYear' => undef,
'-keepLastOfYear' => undef,
'-keepFirstOfMonth' => undef,
'-keepLastOfMonth' => undef,
'-firstDayOfWeek' => undef,
'-keepRelative' => undef,
'-keepFirstOfWeek' => undef,
'-keepLastOfWeek' => undef,
'-keepAll' => undef,
'-keepWeekday' => undef,
'-keepDuplicate' => undef,
'-keepMinNumber' => undef,
'-keepMaxNumber' => undef,
'-statDelOldBackupDirs' => undef,
'-flatOutput' => 'no',
'-lateLinksParam' => undef,
'-allLinks' => undef, # object of type lateLink
'-suppressWarning' => undef
);
&::checkObjectParams(\%params, \@_, 'deleteOldBackupDirs::new',
['-targetDir', '-doNotDelete', '-checkSumFile',
'-prLog', '-today', "-keepRelative",
'-keepFirstOfYear', '-keepLastOfYear',
'-keepFirstOfMonth', '-keepLastOfMonth',
'-keepFirstOfWeek', '-keepLastOfWeek',
'-keepAll', '-keepWeekday', '-keepDuplicate',
'-keepMinNumber', '-keepMaxNumber',
'-statDelOldBackupDirs', '-lateLinksParam',
'-allLinks']);
&::setParamsDirect($self, \%params);
my $targetDir = $self->{'targetDir'};
my $checkSumFile = $self->{'checkSumFile'};
my $prLog = $self->{'prLog'};
my $today = $self->{'today'};
my $keepFirstOfYear = $self->{'keepFirstOfYear'};
my $keepLastOfYear = $self->{'keepLastOfYear'};
my $firstDayOfWeek = $self->{'firstDayOfWeek'};
my $keepFirstOfMonth = $self->{'keepFirstOfMonth'};
my $keepLastOfMonth = $self->{'keepLastOfMonth'};
my $keepFirstOfWeek = $self->{'keepFirstOfWeek'};
my $keepLastOfWeek = $self->{'keepLastOfWeek'};
my $keepAll = $self->{'keepAll'};
my $keepWeekday = $self->{'keepWeekday'};
my $keepDuplicate = $self->{'keepDuplicate'};
my $keepMinNumber = $self->{'keepMinNumber'};
my $keepMaxNumber = $self->{'keepMaxNumber'};
my $keepRelative = $self->{'keepRelative'};
unless ($self->{'suppressWarning'})
{
my (%sw) = ();
$self->{'suppressWarning'} = \%sw;
}
bless $self, $class;
#
# Formate überprüfen
#
$self->{'invalidFormat'} = undef;
$self->{'invalidFormat'} = 1 unless
&checkTimeScaleFormat('keepFirstOfYear',
$keepFirstOfYear, $prLog, 1);
$self->{'invalidFormat'} = 1 unless
&checkTimeScaleFormat('keepLastOfYear',
$keepLastOfYear, $prLog, 1);
$self->{'invalidFormat'} = 1 unless
&checkTimeScaleFormat('keepFirstOfMonth',
$keepFirstOfMonth, $prLog, 1);
$self->{'invalidFormat'} = 1 unless
&checkTimeScaleFormat('keepLastOfMonth',
$keepLastOfMonth, $prLog, 1);
$self->{'invalidFormat'} = 1 unless
&checkTimeScaleFormat('keepFirstOfWeek',
$keepFirstOfWeek, $prLog, 1);
$self->{'invalidFormat'} = 1 unless
&checkTimeScaleFormat('keepLastOfWeek',
$keepLastOfWeek, $prLog, 1);
$self->{'invalidFormat'} = 1 unless
&checkTimeScaleFormat('keepAll',
$keepAll, $prLog, undef);
$self->{'invalidFormat'} = 1 unless
&checkTimeScaleFormat('keepDuplicate',
$keepDuplicate, $prLog, undef);
unless ($firstDayOfWeek =~
/\ASun\Z|\AMon\Z|\ATue\Z|\AWed\Z|\AThu\Z|\AFri\Z|\ASat\Z/o)
{
$self->{'invalidFormat'} = 1;
$prLog->print('-kind' => 'E',
'-str' => ["unknown week day <$firstDayOfWeek> at " .
"parameter --firstDayOfWeek, must be one " .
"Sun, Mon, Tue, Wed, Thu, Fri, Sat"]);
}
my $nodelete = "do not delete anything because of previous error";
if ($keepMinNumber > $keepMaxNumber and $keepMaxNumber > 0)
{
$prLog->print('-kind' => 'E',
'-str' => ["keepMinNumber ($keepMinNumber) > " .
" keepMaxNumber: ($keepMaxNumber)", $nodelete]
);
$self->{'invalidFormat'} = 1;
}
if (defined $self->{'keepRelative'})
{
# keepRelative überprüfen
my $last;
my @intervals = @{$self->{'keepRelative'}};
$self->{'keepRelative'} = [];
foreach my $el (@intervals)
{
my $secs = dateTools::strToSec('-str' => $el);
if (not defined $secs)
{
$prLog->print('-kind' => 'E',
'-str' =>
["illegal parameter for option keepRelative, " .
"must be a list of intervals"], '-exit' => 1);
}
if (not defined $last)
{
$last = $secs;
}
if ($secs < $last)
{
$prLog->print('-kind' => 'E',
'-str' =>
["illegal parameter for option keepRelative, " .
"intervals must be in increasing order"],
'-exit' => 1);
}
push @{$self->{'keepRelative'}}, {str => $el, secs => $secs};
$last = $secs;
}
}
$prLog->print('-kind' => 'E',
'-str' => ["exiting because of previous errors"],
'-exit' => 1)
if $self->{'invalidFormat'};
# Directoryeinträge der alten Backups einlesen
my $dirs =
allStoreBackupSeries->new('-rootDir' => $targetDir,
'-actBackupDir' => $self->{'actBackupDir'},
'-checkSumFile' => $checkSumFile,
'-prLog' => $prLog);
# '-absPath' => 1);
my (@l1) = $dirs->getAllFinishedDirs();
#&::printData(\@l1, '--new::l1--');
$self->{'l1'} = \@l1;
($self->{'weekDayHash'}, $self->{'dayObject'}) = &calcWeekDayHash(\@l1);
my (@nfd) = $dirs->getAllNotFinishedDirs();
$self->{'notFinishedBackupDirs'} = \@nfd;
return $self if @l1 == 0; # noch nichts da
# print "dirs =\n\t", join("\n\t", @l1), "\n------------\n";
# Format von keepWeekDay überprüfen und besser eintragen
$self->calcWeekdayDuration(\@l1);
# Ergebnis steht in Hash $self->{'weekDayDuration'}
return $self;
}
############################################################
sub checkBackups
{
my $self = shift;
my $targetDir = $self->{'targetDir'};
my $checkSumFile = $self->{'checkSumFile'};
my $prLog = $self->{'prLog'};
my $today = $self->{'today'};
my $keepFirstOfYear = $self->{'keepFirstOfYear'};
my $keepLastOfYear = $self->{'keepLastOfYear'};
my $firstDayOfWeek = $self->{'firstDayOfWeek'};
my $keepFirstOfMonth = $self->{'keepFirstOfMonth'};
my $keepLastOfMonth = $self->{'keepLastOfMonth'};
my $keepFirstOfWeek = $self->{'keepFirstOfWeek'};
my $keepLastOfWeek = $self->{'keepLastOfWeek'};
my $keepAll = $self->{'keepAll'};
my $keepWeekday = $self->{'keepWeekday'};
my $keepDuplicate = $self->{'keepDuplicate'};
my $keepMinNumber = $self->{'keepMinNumber'};
my $keepMaxNumber = $self->{'keepMaxNumber'};
my $keepRelative = $self->{'keepRelative'};
my $flatOutput = $self->{'flatOutput'};
my $suppressWarning = $self->{'suppressWarning'};
#print "Entering deleteOldBackupDirs::checkBackups\n";
my (@l1) = @{$self->{'l1'}};
my (@lLoesch) = ();
$self->{'lLoesch'} = \@lLoesch;
if (@l1 == 0)
{
$prLog->print('-kind' => 'I',
'-str' =>
["no old backups yet, no regular backups to delete"]);
return;
}
my $weekDayHash = $self->{'weekDayHash'};
my $dayObject = $self->{'dayObject'};
my (%notDelPrintHash); # Für die Ausgabe ins log file werden
# hier die Informationen gespeichert,
# welche Directories nicht gelöscht werden
# Format: Hash mit Hash: Dir -> firstDayOfWeek(a), lastDayOfMonth, ...
my $l;
foreach $l (@l1)
{
$notDelPrintHash{$l} = undef; # Annahme: wird gelöscht
}
# Alternative Methode
if ($keepRelative and @$keepRelative)
{
# Sort (new backups first)
@l1 = reverse(sort @l1);
#&::printData(\@l1, '(R1) ==l1==');
# Always keep most recent backup (we don't know when the next
# backup will be made, so we cannot judge if we may need it or
# not)
$notDelPrintHash{$l1[0]}{"most recent"} = "";
my $bi = 0;
my $off = 0;
my $debug = 0;
my ($backup, $age, $period);
# Loop over periods, starting from the most recent one
period:;
for (my $pi=0; $pi <= @$keepRelative-2; $pi++)
{
$period = $keepRelative->[$pi]->{str} . " to ".
$keepRelative->[$pi+1]->{str};
$prLog->print('-kind' => 'D',
'-str' => ["[keepRelative] Examining period $period"]) if $debug;
backup:
while ($bi < @l1)
{
$backup = $l1[$bi];
# Keep first backup that is older than the beginning
# of the current period
$age = ($$dayObject{$backup})->deltaInSecs('-secondDate' => $today);
if ($age >= $keepRelative->[$pi]->{'secs'}+$off) {
# If the backup is actually too old for this
# period, make sure that the following intervals
# are shifted by the same amount
if ($age >= $keepRelative->[$pi+1]->{'secs'} + $off)
{
$notDelPrintHash{$backup}{"$period (nearest older)"} = "";
$off += $age - ($keepRelative->[$pi+1]->{'secs'}+$off);
$prLog->print('-kind' => 'W',
'-str' =>
["no backup for period $period, choosing next older backup instead"])
unless exists $$suppressWarning{'noBackupForPeriod'};
}
else
{
$notDelPrintHash{$backup}{$period} = "";
}
$keepRelative->[$pi]->{bi} = $bi;
last backup;
}
$bi++;
}
# If we didn't find any backup old enough, we take the
# oldest one instead
if ($bi == @l1)
{
$bi = $#l1;
$backup = $l1[$bi];
$prLog->print('-kind' => 'W',
'-str' =>
["no backup for period $period, choosing oldest backup instead.",
"This is usually caused by backups not being done regularly enough." ])
unless exists $$suppressWarning{'noBackupForPeriod'};
$notDelPrintHash{$backup}{"$period (oldest possible)"} = "";
$keepRelative->[$pi]->{bi} = $bi;
}
$prLog->print('-kind' => 'D',
'-str' =>
["[keepRelative] <$period> is satisfied by backup $backup"]) if $debug;
# The following loop goes forward in time, starting from
# the backup that at the time of this run satisfies the
# current period to the most recent backup.
# For each backup $backup, it is checked if the backup
# will at some point in the future be needed to satisfy
# the period. If so, it is marked as 'candidate' for
# keeping.
# A backup $prevBackup is required for a period, if the
# backup that satisfied the period in the last iteration
# ($keptBackup) is going to run out of the period before
# the next backup ($backup) is entering the period.
my $i = $bi;
my $keptBackup = $backup;
my $prevBackup;
# Determine number of seconds until the currently
# held backup will be too old for the period
my $expires = $keepRelative->[$pi+1]->{secs}
- ($$dayObject{$keptBackup})->deltaInSecs(-secondDate => $today);
$prLog->print('-kind' => 'D',
'-str' =>
["[keepRelative] $keptBackup will leave period in "
. sprintf("%.1f", $expires/3600) . " hours."])
if $debug;
while ($i > 0)
{
$prevBackup = $backup;
$backup = $l1[--$i];
# Determine number of seconds until the next more
# recent backup will be old enough for the period
my $remaining = $keepRelative->[$pi]->{secs}
- ($$dayObject{$backup})->deltaInSecs(-secondDate => $today);
# If the backup has already expired, then we obviously
# need the next one
if ($expires < 0)
{
$notDelPrintHash{$backup}{"$period (candidate)"} = "";
$keptBackup = $backup;
$expires = $keepRelative->[$pi+1]->{secs}
- ($$dayObject{$keptBackup})->deltaInSecs(-secondDate => $today);
$prLog->print('-kind' => 'D',
'-str' =>
["[keepRelative] Has already left period. Keeping $backup. Will leave period in "
. sprintf("%.1f", $expires/3600) . " hours."])
if $debug;
}
# If the backup last marked to keep for
# this period will be too old before the current
# backup is old enough, also mark the previous backup
# for keeping.
elsif ($expires <= $remaining)
{
$prLog->print('-kind' => 'D',
'-str' =>
["[keepRelative] $backup will enter period in " .
sprintf("%.1f", $remaining/3600) ." hours ".
"- this is too late, trying to keep intermediate backup.."])
if $debug;
if ($keptBackup eq $prevBackup)
{
$prLog->print
( '-kind' => 'W',
'-str' =>
["There will be no backup for period $period in ".
sprintf("%.1f", $expires/(3600*24))." days.",
"This is usually caused by backups not being done regularly enough." ])
unless exists $$suppressWarning{'noBackupForPeriod'};
# At least we try to minimize the gap
$notDelPrintHash{$backup}{"$period (candidate)"} = "";
$keptBackup = $backup;
$expires = $keepRelative->[$pi+1]->{secs}
- ($$dayObject{$keptBackup})->deltaInSecs(-secondDate => $today);
$prLog->print('-kind' => 'D',
'-str' =>
["[keepRelative] Marking $backup to minimze gap. Will leave period in "
. sprintf("%.1f", $expires/3600) . " hours."])
if $debug;
}
else
{
$notDelPrintHash{$prevBackup}{"$period (candidate)"} = "";
$keptBackup = $prevBackup;
$expires = $keepRelative->[$pi+1]->{secs}
- ($$dayObject{$keptBackup})->deltaInSecs(-secondDate => $today);
$prLog->print('-kind' => 'D',
'-str' =>
["[keepRelative] Marking $keptBackup. Will leave period in "
. sprintf("%.1f", $expires/3600) . " hours."])
if $debug;
}
}
else
{
$prLog->print('-kind' => 'D',
'-str' =>
["[keepRelative] $backup will enter period in " .
sprintf("%.1f", $remaining/3600) .
" hours - no need to keep intermediate backup."])
if $debug;
}
}
$bi++;
}
#&::printData(\@l1, '(Rtest) ==l1==');
#&::printData(\%notDelPrintHash, '(Rtest) ==notDelPrintHash==');
foreach $l (@l1)
{
if (not defined $notDelPrintHash{$l})
{
push @{$self->{'lLoesch'}}, $l;
}
}
#&::printData(\@l1, '(R2) ==l1==');
#&::printData(\@lLoesch, '(R2) ==lLoesch==');
}
else # not 'relative' method
{
#1. Duplikate eines Tages separieren:
# betroffene (aller außer den Letzten des Tages) von (L1) -> (L2)
my (@l2) = &separateDuplicateOfTheDays(\@l1);
#&::printData(\@l1, '(1) ==l1==');
#&::printData(\@l2, '(1) ==l2==');
# print "l1 =\n\t", join("\n\t", @l1), "\n";
# print "l2 =\n\t", join("\n\t", @l2), "\n";
#2. keepDuplicate - zu alte Duplikate löschen:
# betroffene von (L2) -> (Llösch)
(@lLoesch) =
&delOldDuplicates(\@l2, $today, $keepDuplicate, $prLog,
$weekDayHash, $dayObject, \%notDelPrintHash);
# print "2. lLoesch =\n\t", join("\n\t", @lLoesch), "\n";
#&::printData(\@l1, '(2) --l1--');
#&::printData(\@l2, '(2) ==l2==');
#&::printData(\@lLoesch, '(2) ==lLoesch==');
#3. keepFirstOfYear - ersten eines Jahres behalten:
# (immer den letzten des Tages!)
# betroffene (L1): Flag 'notDelete' setzen + eventuell Archiv Flag
my (%archiveFlags) = (); # Hash mit allen Directories, die das Archive
# Flag gesetzt bekommen
my (%notDeleteFlags) = (); # Hash mit allen Directories, die nicht
# gelöscht werden sollen
&keepFirstMonthYear(\@l1, $today, \%archiveFlags, \%notDeleteFlags,
'keepFirstOfYear', $keepFirstOfYear, $dayObject,
\%notDelPrintHash);
#&::printData(\@l1, '(3) --l1--');
#&::printData(\@l2, '(3) --l2--');
#&::printData(\@lLoesch, '(3) --lLoesch--');
#&::printData(\%archiveFlags, '(3) ==archiveFlags==');
#&::printData(\%notDeleteFlags, '(3) ==notDeleteFlags==');
# print "3. keepFirstOfYear\n";
# print "archive Flags bei\n\t", join("\n\t", sort keys %archiveFlags),
# "\n------------\n";
# print "notDeleteFlags bei\n\t", join("\n\t", sort keys %notDeleteFlags),
# "\n------------\n";
#4. keepLastOfYear - letzten eines Jahres behalten:
# (immer den letzten des Tages!)
# betroffene (L1): Flag 'notDelete' setzen + eventuell Archiv Flag
&keepLastMonthYear(\@l1, $today, \%archiveFlags, \%notDeleteFlags,
'keepLastOfYear', $keepLastOfYear, $dayObject,
\%notDelPrintHash);
#&::printData(\@l1, '(4) --l1--');
#&::printData(\@l2, '(4) --l2--');
#&::printData(\@lLoesch, '(4) --lLoesch--');
#&::printData(\%archiveFlags, '(4) --archiveFlags--');
#&::printData(\%notDeleteFlags, '(4) --notDeleteFlags--');
# print "4. keepLastOfYear\n";
# print "archive Flags bei\n\t", join("\n\t", sort keys %archiveFlags),
# "\n------------\n";
# print "notDeleteFlags bei\n\t", join("\n\t", sort keys %notDeleteFlags),
# "\n------------\n";
#5. keepFirstOfMonth - ersten eines Monats behalten:
# (immer den letzten des Tages!)
# betroffene (L1): Flag 'notDelete' setzen + eventuell Archiv Flag
&keepFirstMonthYear(\@l1, $today, \%archiveFlags, \%notDeleteFlags,
'keepFirstOfMonth', $keepFirstOfMonth, $dayObject,
\%notDelPrintHash);
#&::printData(\@l1, '(5) --l1--');
#&::printData(\@l2, '(5) --l2--');
#&::printData(\@lLoesch, '(5) --lLoesch--');
#&::printData(\%archiveFlags, '(5) ==archiveFlags==');
#&::printData(\%notDeleteFlags, '(5) ==notDeleteFlags==');
# print "5. keepFirstOfMonth\n";
# print "archive Flags bei\n\t", join("\n\t", sort keys %archiveFlags),
# "\n------------\n";
# print "notDeleteFlags bei\n\t", join("\n\t", sort keys %notDeleteFlags),
# "\n------------\n";
#6. keepLastOfMonth - letzten eines Monats behalten:
# (immer den letzten des Tages!)
# betroffene (L1): Flag 'notDelete' setzen + eventuell Archiv Flag
&keepLastMonthYear(\@l1, $today, \%archiveFlags, \%notDeleteFlags,
'keepLastOfMonth', $keepLastOfMonth, $dayObject,
\%notDelPrintHash);
#&::printData(\@l1, '(6) --l1--');
#&::printData(\@l2, '(6) --l2--');
#&::printData(\@lLoesch, '(6) --lLoesch--');
#&::printData(\%archiveFlags, '(6) --archiveFlags--');
#&::printData(\%notDeleteFlags, '(6) --notDeleteFlags--');
# print "6. keepLastOfMonth\n";
# print "archive Flags bei\n\t", join("\n\t", sort keys %archiveFlags),
# "\n------------\n";
# print "notDeleteFlags bei\n\t", join("\n\t", sort keys %notDeleteFlags),
# "\n------------\n";
if ($keepFirstOfWeek or $keepLastOfWeek)
{
#7. keepFirstOfWeek - ersten einer Woche behalten:
# (immer den letzten des Tages!)
# betroffene (L1): Flag 'notDelete' setzen + eventuell Archiv Flag
my $deltaWeekDayDays =
&calcDeltaWeekDayDays(\@l1, $firstDayOfWeek, $prLog, $dayObject);
&keepFirstWeek(\@l1, $today, \%archiveFlags, \%notDeleteFlags,
$keepFirstOfWeek, $deltaWeekDayDays, $dayObject,
\%notDelPrintHash);
#&::printData(\@l1, '(7) --l1--');
#&::printData(\@l2, '(7) --l2--');
#&::printData(\@lLoesch, '(7) --lLoesch--');
#&::printData(\%archiveFlags, '(7) --archiveFlags--');
#&::printData(\%notDeleteFlags, '(7) --notDeleteFlags--');
# print "7. keepFirstOfWeek\n";
# print "archive Flags bei\n\t", join("\n\t", sort keys %archiveFlags),
# "\n------------\n";
# print "notDeleteFlags bei\n\t", join("\n\t", sort keys %notDeleteFlags),
# "\n------------\n";
#8. keepLastOfWeek - letzten einer Woche behalten:
# (immer den letzten des Tages!)
# betroffene (L1): Flag 'notDelete' setzen + eventuell Archiv Flag
&keepLastWeek(\@l1, $today, \%archiveFlags, \%notDeleteFlags,
$keepLastOfWeek, $deltaWeekDayDays, $dayObject,
\%notDelPrintHash);
#&::printData(\@l1, '(8) --l1--');
#&::printData(\@l2, '(8) --l2--');
#&::printData(\@lLoesch, '(8) --lLoesch--');
#&::printData(\%archiveFlags, '(8) ==archiveFlags==');
#&::printData(\%notDeleteFlags, '(8) ==notDeleteFlags==');
# print "8. keepLastOfWeek\n";
# print "archive Flags bei\n\t", join("\n\t", sort keys %archiveFlags),
# "\n------------\n";
# print "notDeleteFlags bei\n\t", join("\n\t", sort keys %notDeleteFlags),
# "\n------------\n";
}
#9. keepWeekday (berücksichtigt Defaultwerte von keepAll) -
# alle noch nicht zu alten behalten:
# betroffene (L1): Flag 'notDelete' setzen + eventuell Archiv Flag
$self->keepWeekdays(\@l1, $today, \%archiveFlags, \%notDeleteFlags,
$keepWeekday, \%notDelPrintHash);
#&::printData(\@l1, '(9) --l1--');
#&::printData(\@l2, '(9) --l2--');
#&::printData(\@lLoesch, '(9) --lLoesch--');
#&::printData(\%archiveFlags, '(9) ==archiveFlags==');
#&::printData(\%notDeleteFlags, '(9) ==notDeleteFlags==');
# print "9. keepWeekday\n";
# print "archive Flags bei\n\t", join("\n\t", sort keys %archiveFlags),
# "\n------------\n";
# print "notDeleteFlags bei\n\t", join("\n\t", sort keys %notDeleteFlags),
# "\n------------\n";
#10. Backups mit Flag 'notDelete' verschieben:
# betroffene (L1) -> (L3), wenn kein Archiv Flag
# betroffene (L1) -> (L4), wenn Archiv Flag
my (@l3, @l4);
&moveBackupsWithFlags(\@l1, \@l3, \@l4, \%archiveFlags, \%notDeleteFlags);
#&::printData(\@l1, '(10) ==l1==');
#&::printData(\@l2, '(10) --l2--');
#&::printData(\@l3, '(10) ==l3==');
#&::printData(\@l4, '(10) ==l4==');
#&::printData(\@lLoesch, '(10) --lLoesch--');
#&::printData(\%archiveFlags, '(10) ==archiveFlags==');
#&::printData(\%notDeleteFlags, '(10) ==notDeleteFlags==');
#11. alle (L1) -> (Llösch) verschieben
#
#=> in Llösch sind die bisher zu löschenden Backupverzeichnisse
#=> L1 ist leer
#=> in L2 sind jetzt die Duplikate
#=> in L3 sind die mit noDelete, aber ohne Archiv Flag
#=> in L4 sind jetzt die, die das Archiv Flag gesetzt haben
(@lLoesch) = sort(@lLoesch, @l1);
(@l1) = ();
#&::printData(\@l1, '(11) ==l1==');
#&::printData(\@l2, '(11) --l2--');
#&::printData(\@l3, '(11) --l3--');
#&::printData(\@l4, '(11) --l4--');
#&::printData(\@lLoesch, '(11) ==lLoesch==');
#&::printData(\%archiveFlags, '(11) ==archiveFlags==');
#&::printData(\%notDeleteFlags, '(11) ==notDeleteFlags==');
# print "11. Backups mit Flag 'notDelete' verschieben + lLösch füllen\n";
# print "lLoesch (", scalar(@lLoesch), ") =\n\t",
# join("\n\t", @lLoesch), "\n";
# print "notDelete (", scalar(@l3), "), l3 =\n\t", join("\n\t", @l3), "\n";
# print "archiveFlag (", scalar(@l4), "), l4 =\n\t", join("\n\t", @l4), "\n";
#12. keepMinNumber - minimal zu behaltende in Sicherheit bringen
# n = keepMinNumber - scalar(L4) # die zu archivierenden abziehen
# die n jüngsten in Sicherheit bringen:
# betroffene (L3) -> (L4) in (L3) sind die noDelete ohne Archiv-Flag
# wenn das nicht reicht, betroffene (Llösch) -> (L4)
&keepMinNumber(\@l3, \@l4, \@lLoesch, $keepMinNumber - @l4,
\%notDelPrintHash);
#&::printData(\@l1, '(12) --l1--');
#&::printData(\@l2, '(12) --l2--');
#&::printData(\@l3, '(12) ==l3==');
#&::printData(\@l4, '(12) ==l4==');
#&::printData(\@lLoesch, '(12) ==lLoesch==');
#&::printData(\%archiveFlags, '(12) ==archiveFlags==');
#&::printData(\%notDeleteFlags, '(12) ==notDeleteFlags==');
# print "12. keepMinNumber\n";
# print "lLoesch (", scalar(@lLoesch), ") =\n\t",
# join("\n\t", @lLoesch), "\n";
# print "notDelete (", scalar(@l3), "), l3 =\n\t", join("\n\t", @l3), "\n";
# print "archiveFlag (", scalar(@l4), "), l4 =\n\t", join("\n\t", @l4), "\n";
# print "Duplikate (", scalar(@l2), "), l2 =\n\t", join("\n\t", @l2), "\n";
#13. keepMaxNumber - alles was über die Zahl geht löschen (außer in L4)
# Der folgenden Reihe nach, beginnend mit den ältesten, verschieben:
# a) (L2) -> (Llösch)
# b) wenn noch zu viele: (L3) -> (Llösch)
&keepMaxNumber(\@l2, \@l3, \@lLoesch, @l4 + @l3 + @l2 - $keepMaxNumber,
\%notDelPrintHash)
if ($keepMaxNumber);
#&::printData(\@l1, '(13) --l1--');
#&::printData(\@l2, '(13) ==l2==');
#&::printData(\@l3, '(13) ==l3==');
#&::printData(\@l4, '(13) --l4--');
#&::printData(\@lLoesch, '(13) ==lLoesch==');
#&::printData(\%archiveFlags, '(13) --archiveFlags--');
#&::printData(\%notDeleteFlags, '(13) --notDeleteFlags--');
# print "13. keepMaxNumber\n";
# print "lLoesch = (", scalar(@lLoesch),
# ")\n\t", join("\n\t", @lLoesch), "\n";
# print "notDelete (", scalar(@l3), "), l3 =\n\t", join("\n\t", @l3), "\n";
# print "archiveFlag (", scalar(@l4), "), l4 =\n\t", join("\n\t", @l4), "\n";
# print "Duplikate (", scalar(@l2), "), l2 =\n\t", join("\n\t", @l2), "\n";
#14. Warnung ausgeben, wenn mehr als keepMaxNumber übrigbleiben
$prLog->print('-kind' => 'W',
'-str' =>
["keeping " . (@l4 + @l3 + @l2) . " backups," .
" this is more than keepMaxNumber ($keepMaxNumber)"])
if ($keepMaxNumber > 0 and @l4 + @l3 + @l2 > $keepMaxNumber);
$self->{'lLoesch'} = \@lLoesch;
}
#15. check for collision with backups who have unresolved links or
# unresolved links to them
my (@lateLinkDirs) = ($self->{'allLinks'}->getAllDirsWithLateLinks());
#&::printData(\@lateLinkDirs, '(15.1) --lateLinkDirs--');
#&::printData(\@lLoesch, '(15.1) --lLoesch--');
#&::printData(\%notDelPrintHash, '(15.1) --notDelPrintHash--'); ##!!!
if (@lateLinkDirs)
{
my (%lateLinkDirs) = ();
my ($dir, $x);
foreach $dir (@lateLinkDirs)
{
($x, $dir) = ::splitFileDir($dir);
$lateLinkDirs{$dir} = 1;
}
my (%loesch) = ();
foreach $dir (@{$self->{'lLoesch'}})
{
$loesch{$dir} = 1;
}
#&::printData(\%loesch, '(15) --loesch--');
my $actBackupDir;
($x, $actBackupDir) = ::splitFileDir($self->{'actBackupDir'});
#print "actBackupDir = <$actBackupDir>\n";
my (@loesch) = ();
foreach $dir (keys %notDelPrintHash)
{
if (exists $lateLinkDirs{$dir})
{
$notDelPrintHash{$dir}{'affected by unresolved links'} = '';
if (exists $loesch{$dir})
{
$notDelPrintHash{$dir}{'would be deleted'} = '';
delete $notDelPrintHash{$dir}{'keepMaxNumber'};
}
}
elsif ($dir eq $actBackupDir)
{
$notDelPrintHash{$dir}{'affected by unresolved links'} = ''
if $self->{'lateLinksParam'}
}
elsif (exists $loesch{$dir})
{
push @loesch, $dir;
}
}
$self->{'lLoesch'} = \@loesch;
#&::printData(\@l1, '(15.2) --l1--');
#&::printData(\@lLoesch, '(15.2) ==lLoesch==');
}
# Ausgabe ins Log File, was gelöscht wird und was nicht
my (@p) = ("analysis of old Backups in <$targetDir>:");
my $count = (keys %notDelPrintHash);
foreach $l (sort keys %notDelPrintHash)
{
my $reason = $notDelPrintHash{$l};
my $deltaSecs = $$dayObject{$l}->deltaInSecs('-secondDate' => $today);
my $deltaDays = int($deltaSecs/(3600*24));
my $deltaHours = int( ($deltaSecs - $deltaDays * 3600 * 24) / 3600);
my $p = $$weekDayHash{$l} . " $l (${deltaDays}d${deltaHours}h): ";
my ($r, @r);
#print $$weekDayHash{$l} . " $l: ";
foreach $r (sort keys %$reason)
{
if ($r eq 'keepMaxNumber')
{
unshift @r, "will be deleted ($r)";
}
else
{
my $a = $$reason{$r};
$a = "($a)" if $a;
push @r, "$r$a";
}
}
if (@r)
{
$p .= join(', ', sort @r);
#print join(', ', @r), "\n";
}
else
{
$p .= "will be deleted";
#print "will be deleted\n";
}
--$count;
push @p, " ($count) $p";
}
if ($flatOutput eq 'no')
{
$prLog->print('-kind' => 'I', # Auf einmal ausgeben, wird dann
'-str' => [@p]); # nicht getrennt
}
else
{
$prLog->pr(@p);
}
}
############################################################
sub deleteBackups
{
my $self = shift;
my $targetDir = $self->{'targetDir'};
my $doNotDelete = $self->{'doNotDelete'};
my $prLog = $self->{'prLog'};
my $statDelOldBackupDirs = $self->{'statDelOldBackupDirs'};
my $lLoesch = $self->{'lLoesch'};
my $wdh = $self->{'weekDayHash'};
if ($self->{'deleteNotFinishedDirs'} and not $self->{'doNotDelete'})
{
my $abd = $self->{'actBackupDir'};
my (@nfd) = @{$self->{'notFinishedBackupDirs'}};
my $d;
foreach $d (@nfd)
{
$prLog->print('-kind' => 'W',
'-str' =>
["deleting not finished backup <$targetDir/$d>"]);
$self->{'statDelOldBackupDirs'}->incr_noDeletedOldDirs();
my $rdd = recursiveDelDir->new('-dir' => "$targetDir/$d",
'-prLog' => $prLog);
my ($dirs, $files, $bytes, $links, $stayBytes) =
$rdd->getStatistics();
$self->{'statDelOldBackupDirs'}->addFreedSpace($dirs, $files,
$bytes, $links);
my ($b) = &::humanReadable($bytes);
my ($sb) = &::humanReadable($stayBytes);
$prLog->print('-kind' => 'I',
'-str' => [" freed $b ($bytes), $files files" .
" [$sb hard linked somewhere else]"]);
}
}
return if (@$lLoesch == 0);
#16. Alle in (Llösch) löschen
if ($doNotDelete)
{
$prLog->print('-kind' => 'I',
'-str' => ["Skipping removal of " .
scalar(@$lLoesch) . " old backups."]);
}
else
{
$prLog->print('-kind' => 'I',
'-str' => ["deleting in backup series <$targetDir>:"]);
my $l;
my $i = 0;
foreach $l (@$lLoesch)
{
$i++;
$prLog->print('-kind' => 'I',
'-str' => [" ($i/" . scalar(@$lLoesch) . ") deleting "
. $$wdh{$l} . " $l"]);
$statDelOldBackupDirs->incr_noDeletedOldDirs();
unlink "$targetDir/$l/$main::finishedFlag";
my $rdd = recursiveDelDir->new('-dir' => "$targetDir/$l",
'-prLog' => $prLog);
my ($dirs, $files, $bytes, $links, $stayBytes) =
$rdd->getStatistics();
$statDelOldBackupDirs->addFreedSpace($dirs, $files,
$bytes, $links);
my ($b) = &::humanReadable($bytes);
my ($sb) = &::humanReadable($stayBytes);
$prLog->print('-kind' => 'I',
'-str' => [" freed $b ($bytes), $files files" .
" [$sb hard linked somewhere else]"]);
}
# $statDelOldBackupDirs->print();
}
}
##################################################
sub calcWeekDayHash
{
my $l1 = shift;
my ($l, %weekDayHash, %dayObject);
foreach $l (@$l1)
{
my ($year, $month, $day, $hour, $min, $sec) = $l =~
/\A(\d{4})\.(\d{2})\.(\d{2})_(\d{2})\.(\d{2})\.(\d{2})\Z/o;
my $p = dateTools->new('-year' => $year,
'-month' => $month,
'-day' => $day,
'-hour' => $hour,
'-min' => $min,
'-sec' => $sec);
$dayObject{$l} = $p;
$weekDayHash{$l} = $p->getWeekDayName();
}
return (\%weekDayHash, \%dayObject);
}
##################################################
sub calcWeekdayDuration
{
my $self = shift;
my $l1 = shift; # Zeiger auf Liste mit allen Backup Dirs
my $prLog = $self->{'prLog'};
my $keepAll = $self->{'keepAll'};
my $keepWeekday = $self->{'keepWeekday'};
my $keepAllSecs = &dateTools::strToSec('-str' => $keepAll);
my (%weekDayDuration) = ('Sun' => $keepAll,
'Mon' => $keepAll,
'Tue' => $keepAll,
'Wed' => $keepAll,
'Thu' => $keepAll,
'Fri' => $keepAll,
'Sat' => $keepAll);
my $entry;
foreach $entry (split(/\s+/, $keepWeekday))
{
$prLog->print('-kind' => 'E',
'-str' => ["invalid format <$entry> for option " .
"--keepWeekday, exiting"],
'-exit' => 1)
unless ($entry =~ /\A([\w,]+):(\w+)\Z/o);
my ($days, $duration) = ($1, $2);
my $archiveFlag = undef;
if ($duration =~ /\Aa(.*)/o) # archive Flag gesetzt
{
$duration = $1;
$archiveFlag = 1;
}
$prLog->print('-kind' => 'E',
'-str' =>
["invalid format <$duration> for week day(s) " .
"<$days> for option --keepWeekday, exiting"],
'-exit' => 1)
unless (&dateTools::checkStr('-str' => $duration));
my $secs = &dateTools::strToSec('-str' => $duration);
if ($secs > $keepAllSecs)
{
my $d;
foreach $d (split(/,/, $days))
{
$prLog->print('-kind' => 'E',
'-str' => ["unknown week day <$d> for option " .
"--keepWeekday, exiting"],
'-exit' => 1)
unless exists $weekDayDuration{$d};
$duration = 'a' . $duration
if $archiveFlag and not $duration =~ /\Aa/;
$weekDayDuration{$d} = $duration;
}
}
}
# my $d;
# foreach $d (keys %weekDayDuration)
# {
# print "$d -> ", $weekDayDuration{$d}, "\n";
# }
$self->{'weekDayDuration'} = \%weekDayDuration;
}
##################################################
sub separateDuplicateOfTheDays
{
my $l1 = shift; # Zeiger auf @l1
my (@l1, @l2, $d, $d_old, $i);
$i = 0;
foreach $d (@$l1)
{
if ($d_old)
{
if (substr($d, 0, 10) eq substr($d_old, 0, 10))
{
push @l2, $d_old;
}
else
{
push @l1, $d_old;
}
}
$d_old = $d;
}
push @l1, $d_old; # das letzte Directory
@$l1 = @l1;
return (@l2);
}
##################################################
sub delOldDuplicates
{
my $l2 = shift;
my $today = shift;
my $keepDuplicate = shift;
my $prLog = shift;
my $weekDayHash = shift;
my $dayObject = shift;
my $notDelPrintHash = shift;
# Zeitpunkt ermitteln, ab dem gelöscht werden soll
my $delPoint = $today->copy();
$delPoint->sub('-str' => $keepDuplicate);
my (@l2, @Lloesch, $l);
foreach $l (@$l2)
{
my $p = $$dayObject{$l};
#print "delOldDuplicates: ", $delPoint->getDateTime(), " - ",
# $p->getDateTime(), "\n";
if ($delPoint->compare('-object' => $p) == -1 # zu alt
and $keepDuplicate) # überhaupt was zu tun
{
#print "\tdrin\n";
push @Lloesch, $l;
}
else
{
push @l2, $l;
my $duration = $keepDuplicate ? $keepDuplicate : 'all';
$$notDelPrintHash{$l}{"keepDuplicate($duration)"} = '';
}
}
@$l2 = @l2;
return (@Lloesch);
}
##################################################
sub keepFirstMonthYear
{
my $l1 = shift;
my $today = shift;
my $archiveFlags = shift;
my $notDeleteFlags = shift;
my $what = shift; # 'keepFirstOfYear' or 'keepFirstOfMonth'
my $timescale = shift; # wie lange zurück?
my $dayObject = shift;
my $notDelPrintHash = shift;
return unless $timescale;
my $length = ($what eq 'keepFirstOfYear') ? 4 : 7;
# erst mal alle merken, die die Ersten sind
my ($i, %first);
my $d_old = $$l1[0];
$first{$d_old} = 1;
for ($i = 1 ; $i < @$l1 ; $i++)
{
my $d = $$l1[$i];
if (substr($d, 0, $length) ne substr($d_old, 0, $length))
{
$first{$d} = 1;
}
$d_old = $d;
}
&setFlags($timescale, $today, \%first, $notDeleteFlags,
$archiveFlags, $dayObject, "$what($timescale)",
$notDelPrintHash);
}
##################################################
sub keepLastMonthYear
{
my $l1 = shift;
my $today = shift;
my $archiveFlags = shift;
my $notDeleteFlags = shift;
my $what = shift; # 'keepLastOfYear' or 'keepLastOfMonth'
my $timescale = shift; # wie lange zurück?
my $dayObject = shift;
my $notDelPrintHash = shift;
return unless $timescale;
my $length = ($what eq 'keepLastOfYear') ? 4 : 7;
# erst mal alle merken, die Ersten sind
my ($i, %last);
my $d_old = $$l1[0];
for ($i = 1 ; $i < @$l1 ; $i++)
{
my $d = $$l1[$i];
if (substr($d, 0, $length) ne substr($d_old, 0, $length))
{
$last{$d_old} = 1;
}
$d_old = $d;
}
$last{$d_old} = 1;
&setFlags($timescale, $today, \%last, $notDeleteFlags,
$archiveFlags, $dayObject, "$what($timescale)",
$notDelPrintHash);
}
##################################################
sub calcDeltaWeekDayDays
{
my $l1 = shift;
my $firstDayOfWeek = shift;
my $prLog = shift;
my $dayObject = shift;
my $l = $$l1[0];
my ($year, $month, $day) = $l =~ /\A(\d{4})\.(\d{2})\.(\d{2})/o;
my $refDate = dateTools->new('-year' => $year,
'-month' => $month,
'-day' => $day);
my $index = $refDate->dayOfWeek(); # Son == 0
my (%wd) = ('Sun' => 0,
'Mon' => 1,
'Tue' => 2,
'Wed' => 3,
'Thu' => 4,
'Fri' => 5,
'Sat' => 6);
my $indexRefDate = $wd{$firstDayOfWeek};
$prLog->print('-kind' => 'E',
'-str' =>
["unknown weekday <$firstDayOfWeek> for --firstDayOfWeek"],
'-exit' => 1)
unless exists $wd{$firstDayOfWeek};
$refDate->sub('-day' => 7 + $index - $indexRefDate);
#print "refDate = ", $refDate->getDateTime(), ", index = $index,
# indexRefDate = $indexRefDate\n";
my (@deltaWeekDayDays);
foreach $l (@$l1)
{
my $p = $$dayObject{$l};
my $delta = $refDate->deltaInDays('-secondDate' => $p);
push @deltaWeekDayDays, int($delta / 7);
#print "\t$l -> ", int($delta / 7), "\n";
}
return \@deltaWeekDayDays;
}
##################################################
sub keepFirstWeek
{
my $l1 = shift;
my $today = shift;
my $archiveFlags = shift;
my $notDeleteFlags = shift;
my $keepFirstOfWeek = shift;
my $deltaWeekDayDays = shift;
my $dayObject = shift;
my $notDelPrintHash = shift;
return unless $keepFirstOfWeek;
my ($i, %first);
$first{$$l1[0]} = 1;
for ($i = 1 ; $i < @$l1 ; $i++)
{
if ($$deltaWeekDayDays[$i] != $$deltaWeekDayDays[$i-1])
{
$first{$$l1[$i]} = 1;
#print "keepFirstWeek = ", $$l1[$i], "\n";
}
}
#print "firstOfWeek =\n\t", join("\n\t", sort keys %first), "\n";
&setFlags($keepFirstOfWeek, $today, \%first,
$notDeleteFlags, $archiveFlags, $dayObject,
"keepFirstOfWeek($keepFirstOfWeek)", $notDelPrintHash);
}
##################################################
sub keepLastWeek
{
my $l1 = shift;
my $today = shift;
my $archiveFlags = shift;
my $notDeleteFlags = shift;
my $keepLastOfWeek = shift;
my $deltaWeekDayDays = shift;
my $dayObject = shift;
my $notDelPrintHash = shift;
return unless $keepLastOfWeek;
my ($i, %last);
for ($i = 0 ; $i < @$l1 ; $i++)
{
if ($$deltaWeekDayDays[$i] != $$deltaWeekDayDays[$i-1])
{
$last{$$l1[$i-1]} = 1;
#print "keepLastWeek = ", $$l1[$i-1], "\n";
}
}
$last{$$l1[$i-1]} = 1;
#print "keepLastWeek = ", $$l1[$i-1], "\n";
#print "lastOfWeek =\n\t", join("\n\t", sort keys %last), "\n";
&setFlags($keepLastOfWeek, $today, \%last,
$notDeleteFlags, $archiveFlags, $dayObject,
"keepLastOfWeek($keepLastOfWeek)", $notDelPrintHash);
}
##################################################
sub keepWeekdays
{
my $self = shift;
my $l1 = shift;
my $today = shift;
my $archiveFlags = shift;
my $notDeleteFlags = shift;
my $keepWeekday = shift;
my $notDelPrintHash = shift;
my $weekDayDuration = $self->{'weekDayDuration'};
my $weekDayHash = $self->{'weekDayHash'};
my $dayObject = $self->{'dayObject'};
my ($l, @l1WeekDayName);
foreach $l (@$l1)
{
push @l1WeekDayName, $$weekDayHash{$l};
}
my $wName;
foreach $wName (keys %$weekDayDuration) # Sun, Mon, Thu, etc.
{
my (%list, $i);
for ($i = 0 ; $i < @$l1 ; $i++)
{
my $w = $l1WeekDayName[$i];
next unless $w eq $wName; # Listen für einen Wochentag aufbauen
$list{$$l1[$i]} = 1;
}
#print "--$wName--(", $$weekDayDuration{$wName}, ")\n";
&setFlags($$weekDayDuration{$wName}, $today, \%list,
$notDeleteFlags, $archiveFlags, $dayObject,
'keepWeekDays(' . $$weekDayDuration{$wName} . ')',
$notDelPrintHash);
}
}
##################################################
sub setFlags
{
my ($timescale, $today, $hash, $notDeleteFlags,
$archiveFlags, $dayObject, $what, $notDelPrintHash) = @_;
# festellen, wie lange behalten werden soll
my $archiveFlag = undef;
if ($timescale =~ /\Aa(.*)/o) # archive Flag gesetzt
{
$timescale = $1;
$archiveFlag = 1;
}
my $delPoint = $today->copy();
$delPoint->sub('-str' => $timescale);
my $l;
foreach $l (keys %$hash)
{
my $p = $$dayObject{$l};
#print "delPoint: ", $delPoint->getDateTime(), " - ", $p->getDateTime(), "\n";
if ($delPoint->compare('-object' => $p) == 1) # im Zeitfenster
{
#print "\tdrin\n";
$$notDeleteFlags{$l} = 1;
if ($archiveFlag)
{
$$archiveFlags{$l} = 1;
$$notDelPrintHash{$l}{$what} = '';
}
else
{
$$notDelPrintHash{$l}{$what} = '';
}
}
}
}
##################################################
sub moveBackupsWithFlags
{
my ($l1, $l3, $l4, $archiveFlags, $notDeleteFlags) = @_;
my ($l, @l1New);
foreach $l (@$l1)
{
if ($$notDeleteFlags{$l}) # Löschen
{
if ($$archiveFlags{$l}) # zusätzlich Archiv-Flag gesetzt
{
push @$l4, $l;
}
else # Löschen, aber kein Archiv-Flag
{
push @$l3, $l;
}
}
else # nicht löschen
{
push @l1New, $l;
}
}
(@$l1) = (@l1New);
}
##################################################
sub keepMinNumber
{
my ($l3, $l4, $lLoesch, $n, $notDelPrintHash) = @_;
return if $n <= 0;
my (@temp);
if ($n <= @$l3)
{
(@temp) = splice(@$l3, -$n, $n);
(@$l4) = sort(@$l4, @temp);
}
else
{
$n -= @$l3;
$n = @$lLoesch if $n > @$lLoesch; # begrenzen
(@temp) = (@$l3, splice(@$lLoesch, -$n, $n));
(@$l4) = sort(@$l4, @temp);
(@$l3) = ();
}
my $t;
my $i = 0;
foreach $t (reverse @$l4)
{
++$i;
$$notDelPrintHash{$t}{"keepMinNumber$i"} = '';
}
}
##################################################
sub keepMaxNumber
{
my ($l2, $l3, $lLoesch, $n, $notDelPrintHash) = @_;
return if $n < 0;
my (@temp);
if ($n <= @$l2)
{
(@temp) = splice(@$l2, 0, $n);
(@$lLoesch) = sort(@$lLoesch, @temp);
}
else
{
$n -= @$l2;
$n = @$l3 if $n > @$l3; # begrenzen
(@temp) = (@$l2, splice(@$l3, 0, $n));
(@$lLoesch) = sort(@$lLoesch, @temp);
(@$l2) = ();
}
my $t;
foreach $t (@temp)
{
$$notDelPrintHash{$t}{'keepMaxNumber'} = '';
}
}
##################################################
# überprüft Formate wie '50d3m' oder 'a50d3m' (mit Archiv-Flag)
sub checkTimeScaleFormat
{
my ($name, $string, $prLog, $archive) = @_;
my $nodelete = "do not delete anything because of previous error";
if ($string =~ /\Aa/) # Archiv-Flag gesetzt
{
if ($archive) # Archiv-Flag ist erlaubt
{
$string =~ s/\A.//; # erstes Zeichen löschen
}
else
{
$prLog->print('-kind' => 'E',
'-str' =>
["archive flag is not allowed for $name: " .
"<$string>", $nodelete]);
return undef;
}
}
if ($string and not &dateTools::checkStr('-str' => $string)) # nicht ok
{
$prLog->print('-kind' => 'E',
'-str' =>
["invalid format for $name: " .
"<$string>", $nodelete]);
return undef;
}
return 1; # alles ok
}
##################################################
# verwaltet Statistik-Daten für's Löschen mit package deleteOldBackupDirs
package statisticDeleteOldBackupDirs;
sub new
{
my $class = shift;
my $self = {};
my (%params) = ('-prLog' => undef,
'-kind' => 'S' # 'S' für 'Statistic'
);
&::checkObjectParams(\%params, \@_, 'statisticDeleteOldBackupDirs::new',
['-prLog']);
&::setParamsDirect($self, \%params);
$self->{'noDeletedOldDirs'} = 0;
$self->{'freedSpace'} = undef;
$self->{'dirs'} = 0;
$self->{'files'} = 0;
$self->{'bytes'} = 0;
$self->{'links'} = 0;
bless $self, $class;
}
########################################
sub incr_noDeletedOldDirs
{
my $self = shift;
++$self->{'noDeletedOldDirs'};
}
########################################
sub addFreedSpace
{
my $self = shift;
my ($dirs, $files, $bytes, $links) = @_;
$self->{'dirs'} += $dirs;
$self->{'files'} += $files;
$self->{'bytes'} += $bytes;
$self->{'links'} += $links;
}
########################################
sub print
{
my $self = shift;
my $prLog = $self->{'prLog'};
$prLog->print
('-kind' => $self->{'kind'},
'-str' =>
[
' deleted old backups = ' . $self->{'noDeletedOldDirs'},
' deleted directories = ' . $self->{'dirs'},
' deleted files = ' . $self->{'files'},
' (only) remove links = ' . $self->{'links'},
'freed space in old directories = ' .
(&::humanReadable($self->{'bytes'}))[0] . ' (' .
$self->{'bytes'} . ')'
]);
}
##################################################
# liest alle Directory-Einträge bestehender Backups ein,
# kann nach verschiedenen Kriterien sortieren bzw. filtern
package allStoreBackupSeries;
sub new
{
my $class = shift;
my $self = {};
my (%params) = ('-rootDir' => undef,
'-actBackupDir' => '', # full path
'-checkSumFile' => undef,
'-prLog' => undef
# '-absPath' => 1 # default ja (0 = nein)
); # (Dirs mit Pfad oder ohne)
&::checkObjectParams(\%params, \@_, 'allStoreBackupSeries::new',
['-rootDir', '-checkSumFile', '-prLog']);
&::setParamsDirect($self, \%params);
my $rootDir = $self->{'rootDir'};
my $actBackupDir = $self->{'actBackupDir'};
my $prLog = $self->{'prLog'};
# my $absPath = $self->{'absPath'};
my $checkSumFile = $self->{'checkSumFile'};
local *DIR;
opendir(DIR, $rootDir) or
$prLog->print('-kind' => 'E',
'-str' => ["cannot opendir <$rootDir>, exiting"],
'-add' => [__FILE__, __LINE__],
'-exit' => 1);
my (@dirs) = ();
my (@finished) = ();
my (@notFinished) = ();
my (@finishedWithoutActBackupDir) = ();
my $entry;
while ($entry = readdir DIR)
{
next if (-l $entry and not -d $entry); # only directories
next unless $entry =~ # backup pattern must fit
/\A(\d{4})\.(\d{2})\.(\d{2})_(\d{2})\.(\d{2})\.(\d{2})\Z/o;
# my $dir = $absPath ? "$rootDir/$entry" : $entry;
my $dir = $entry;
$dir =~ s/\/\//\//go; # doppelte / entfernen
# if (-f "$rootDir/$dir/$checkSumFile.notFinished")
unless (&::checkIfBackupWasFinished('-backupDir' => "$rootDir/$dir",
'-prLog' => $prLog,
'-count' => 3))
{
if ($actBackupDir eq "$rootDir/$dir")
{
push @finished, $dir;
next;
}
$prLog->print('-kind' => 'W',
'-str' => ["backup <$rootDir/$dir> not finished"]);
push @notFinished, $dir;
}
else
{
push @finished, $dir;
push @finishedWithoutActBackupDir, $dir;
}
}
closedir(DIR);
@notFinished = sort @notFinished; # oldest first
$self->{'notFinished'} = \@notFinished;
@finished = sort @finished;
$self->{'finished'} = \@finished;
@finishedWithoutActBackupDir = sort @finishedWithoutActBackupDir;
$self->{'finishedWithoutActBackupDir'} = \@finishedWithoutActBackupDir;
@dirs = sort (@notFinished, @finished);
$self->{'dirs'} = \@dirs;
$self->{'prevCount'} = @dirs;
bless $self, $class;
}
########################################
sub getAllDirs
{
my $self = shift;
return @{$self->{'dirs'}};
}
########################################
sub getAllFinishedDirs
{
my $self = shift;
return @{$self->{'finished'}};
}
########################################
sub getAllFinishedWithoutActBackupDir
{
my $self = shift;
return @{$self->{'finishedWithoutActBackupDir'}};
}
########################################
sub getAllNotFinishedDirs
{
my $self = shift;
return @{$self->{'notFinished'}};
}
########################################
sub setPrevDirStart
{
my $self = shift;
my $startValue = shift; # 0 = letzter Wert,
# 1 = zweitletzter Wert, etc.
$self->{'prevCount'} = @{$self->{'dirs'}} - $startValue;
}
########################################
sub getPrev # ein primitiver Iterator
{
my $self = shift;
my $dirs = $self->{'dirs'};
if (--$self->{'prevCount'} >= 0)
{
return $$dirs[$self->{'prevCount'}];
}
else
{
$self->{'prevCount'} = @$dirs;
return undef;
}
}
########################################
sub getFinishedPrev # berücksichtigt checkSumFile.Finished
{
my $self = shift;
my $prev;
my $prLog = $self->{'prLog'};
my $checkSumFile = $self->{'checkSumFile'};
while ($prev = $self->getPrev())
{
local *DIR;
opendir(DIR, "$prev") or next; # falls über NFS -> update
closedir(DIR);
# return $prev unless (-f "$prev/$checkSumFile.notFinished");
return $prev if &::checkIfBackupWasFinished('-backupDir' => $prev,
'-prLog' => $prLog,
'-count' => 4);
$prLog->print('-kind' => 'W',
'-str' =>
["$prev not finished, skipping"]);
}
return undef;
}
########################################
sub getInfoWithPar
{
my $self = shift;
my $opt = shift;
}
##################################################
# reads info (.md5CheckSums.info)
##################################################
package readInfoFile;
sub new
{
my $class = shift;
my $self = {};
my (%params) = ('-checkSumFile' => undef,
'-prLog' => undef);
&::checkObjectParams(\%params, \@_, 'readInfoFile::new',
['-prLog', '-checkSumFile']);
&::setParamsDirect($self, \%params);
my $prLog = $self->{'prLog'};
my $checkSumFile = $self->{'checkSumFile'};
unless (-f "$checkSumFile.info")
{
$prLog->print('-kind' => 'E',
'-str' => ["cannot find <$checkSumFile.info>"],
'-exit' => 1);
}
my (@checkBlocks);
{
my $i;
foreach $i (0..$main::noBlockDevices-1)
{
push @checkBlocks,
Option->new('-name' => "checkBlocksRule$i",
'-cf_key' => "checkBlocksRule$i",
'-multiple' => 'yes'),
Option->new('-name' => "checkBlocksBS$i",
'-cf_key' => "checkBlocksBS$i",
'-param' => 'yes'),
Option->new('-name' => "checkBlocksCompr$i",
'-cf_key' => "checkBlocksCompr$i",
'-param' => 'yes'),
Option->new('-name' => "checkBlocksRead$i",
'-cf_key' => "checkBlocksRead$i",
'-multiple' => 'yes');
}
}
# all options with parameters!
my $CSFile =
CheckParam->new('-configFile' => '-f',
'-prLog' => $prLog,
'-replaceEnvVar' => 'no',
'-ignoreLeadingWhiteSpace' => 1,
'-list' => [
Option->new('-name' => 'infoFile',
'-cl_option' => '-f',
'-param' => 'yes'),
Option->new('-name' => 'version',
'-cf_key' => 'version',
'-must_be' => 'yes',
'-default' => '1.0'),
Option->new('-name' => 'storeBackupVersion',
'-cf_key' => 'storeBackupVersion',
'-param' => 'yes',
'-multiple' => 'yes'),
Option->new('-name' => 'date',
'-cf_key' => 'date',
'-must_be' => 'yes',
'-multiple' => 'yes'),
Option->new('-name' => 'sourceDir',
'-cf_key' => 'sourceDir',
'-param' => 'yes'),
Option->new('-name' => 'followLinks',
'-cf_key' => 'followLinks',
'-param' => 'yes'),
Option->new('-name' => 'compress',
'-cf_key' => 'compress',
'-must_be' => 'yes',
'-multiple' => 'yes'),
Option->new('-name' => 'uncompress',
'-cf_key' => 'uncompress',
'-must_be' => 'yes',
'-multiple' => 'yes'),
Option->new('-name' => 'postfix',
'-cf_key' => 'postfix',
'-must_be' => 'yes',
'-param' => 'yes'),
Option->new('-name' => 'comprRule',
'-cf_key' => 'comprRule',
'-multiple' => 'yes'),
Option->new('-name' => 'exceptDirs',
'-cf_key' => 'exceptDirs',
'-multiple' => 'yes'),
Option->new('-name' => 'includeDirs',
'-cf_key' => 'includeDirs',
'-multiple' => 'yes'),
Option->new('-name' => 'exceptRule',
'-cf_key' => 'exceptRule',
'-multiple' => 'yes'),
Option->new('-name' => 'includeRule',
'-cf_key' => 'includeRule',
'-multiple' => 'yes'),
Option->new('-name' => 'writeExcludeLog',
'-cf_key' => 'writeExcludeLog',
'-param' => 'yes'),
Option->new('-name' => 'exceptTypes',
'-cf_key' => 'exceptTypes',
'-param' => 'yes'),
Option->new('-name' => 'archiveTypes',
'-cf_key' => 'archiveTypes',
'-param' => 'yes'),
Option->new('-name' => 'specialTypeArchiver',
'-cf_key' => 'specialTypeArchiver',
'-param' => 'yes'),
@checkBlocks,
Option->new('-name' => 'preservePerms',
'-cf_key' => 'preservePerms',
'-param' => 'yes'),
Option->new('-name' => 'lateLinks',
'-cf_key' => 'lateLinks',
'-param' => 'yes'),
Option->new('-name' => 'lateCompress',
'-cf_key' => 'lateCompress',
'-param' => 'yes'),
Option->new('-name' => 'cpIsGnu',
'-cf_key' => 'cpIsGnu',
'-param' => 'yes'),
Option->new('-name' => 'logInBackupDir',
'-cf_key' => 'logInBackupDir',
'-param' => 'yes'),
Option->new('-name' => 'compressLogInBackupDir',
'-cf_key' => 'compressLogInBackupDir',
'-param' => 'yes'),
Option->new('-name' => 'logInBackupDirFileName',
'-cf_key' => 'logInBackupDirFileName',
'-param' => 'yes'),
Option->new('-name' => 'linkToRecent',
'-cf_key' => 'linkToRecent',
'-must_be' => 'no',
'-param' => 'yes')
]);
$CSFile->check('-argv' => ['-f' => "$checkSumFile.info"],
'-help' =>
"cannot read file <$checkSumFile.info>\n",
'-ignoreAdditionalKeys' => 1);
my $opt;
my (%withPar, @allOpts);
foreach $opt ($CSFile->getOptNamesSet('-type' => 'withPar'))
{
$withPar{$opt} = $CSFile->getOptWithPar($opt);
push @allOpts, $opt;
}
$self->{'withPar'} = \%withPar;
$self->{'allOpts'} = \@allOpts;
bless $self, $class;
}
########################################
sub getInfoWithPar
{
my $self = shift;
my $opt = shift;
my $withPar = $self->{'withPar'};
return exists $$withPar{$opt} ? $$withPar{$opt} : undef;
}
########################################
sub getAllInfoOpts
{
my $self = shift;
return @{$self->{'allOpts'}};
}
########################################
#sub getInfoWithoutPar
#{
# my $self = shift;
# my $opt = shift;
#
# my $withoutPar = $self->{'withoutPar'};
# return exists $$withoutPar{$opt} ? $$withoutPar{$opt} : undef;
#}
##################################################
package readCheckSumFile;
sub new
{
my $class = shift;
my $self = {};
my (%params) = ('-checkSumFile' => undef,
'-prLog' => undef,
'-tmpdir' => '/tmp');
&::checkObjectParams(\%params, \@_, 'readCheckSumFile::new',
['-prLog', '-checkSumFile']);
&::setParamsDirect($self, \%params);
my $prLog = $self->{'prLog'};
my $checkSumFile = $self->{'checkSumFile'};
unless (-f "$checkSumFile.info")
{
$prLog->print('-kind' => 'E',
'-str' => ["cannot find <$checkSumFile.info>"],
'-exit' => 1);
}
$self->{'InfoFile'} =
readInfoFile->new('-checkSumFile' => "$checkSumFile",
'-prLog' => $prLog);
if (-f "$checkSumFile.bz2")
{
$self->{'filename'} = "$checkSumFile.bz2";
$self->{'compressed'} = 'yes';
}
elsif (-f "$checkSumFile")
{
$self->{'filename'} = "$checkSumFile";
$self->{'compressed'} = 'no';
}
else
{
$prLog->print('-kind' => 'E',
'-str' => ["cannot find <$checkSumFile>"],
'-exit' => 1);
}
$self->{'CHECKSUMFILE'} = undef;
bless $self, $class;
}
########################################
sub getInfoWithPar
{
my $self = shift;
my $opt = shift;
unless (defined $self->{'InfoFile'}->getInfoWithPar($opt))
{
# compatibility to old versions where these options did not exist
if ($opt eq 'writeExcludeLog' or
$opt eq 'lateLinks' or
$opt eq 'lateCompress' or
$opt eq 'cpIsGnu' or
$opt eq 'logInBackupDir' or
$opt eq 'compressLogInBackupDir')
{
return 'no';
}
#print "----not defined: $opt\n";
}
return $self->{'InfoFile'}->getInfoWithPar($opt);
}
########################################
sub getInfoWithoutPar
{
my $self = shift;
my $opt = shift;
return $self->{'InfoFile'}->getInfoWithoutPar($opt);
}
########################################
sub checkSumFileCompressed # returns 'yes' or 'no'
{
my $self = shift;
return $self->{'compressed'};
}
########################################
sub getFilename
{
my $self = shift;
return $self->{'filename'};
}
########################################
sub nextLine
{
my $self = shift;
my $checkSumFile = $self->{'checkSumFile'};
my $prLog = $self->{'prLog'};
my ($l, @l);
do
{
$l = $self->nextBinLine();
return () unless $l;
} while ((@l =
evalBinLine($l, $prLog, $checkSumFile)) != 12);
return (@l);
}
########################################
sub nextBinLine
{
my $self = shift;
my $checkSumFile = $self->{'checkSumFile'};
my $prLog = $self->{'prLog'};
my $l;
my $csf = undef;
local *FILE = undef;
if ($self->{'checksumfile'} eq undef
and $self->{'CHECKSUMFILE'} eq undef)
{
if (-f "$checkSumFile.bz2")
{
$csf = pipeFromFork->new('-exec' => 'bzip2',
'-param' => ['-d'],
'-stdin' => "$checkSumFile.bz2",
'-outRandom' =>
$self->{'tmpdir'} . '/stbuPipeFrom1-',
'-prLog' => $prLog);
}
elsif (-f "$checkSumFile")
{
open(FILE, "< $checkSumFile") or
$prLog->print('-kind' => 'E',
'-str' =>
["cannot open <$checkSumFile>"],
'-add' => [__FILE__, __LINE__],
'-exit' => 1);
}
else
{
$prLog->print('-kind' => 'E',
'-str' => ["cannot find <$checkSumFile>"],
'-exit' => 1);
}
# erste Kommentarzeile lesen und vergessen
$l = $csf ? $csf->read() : ;
$self->{'CHECKSUMFILE'} = *FILE;
$self->{'checksumfile'} = $csf;
}
else
{
*FILE = $self->{'CHECKSUMFILE'};
$csf = $self->{'checksumfile'};
}
$l = $csf ? $csf->read() : ;
return undef unless $l;
chomp $l;
return $l;
}
########################################
sub evalBinLine # function!
{
my $l = shift;
my $prLog = shift;
my $checkSumFile = shift;
my ($md5sum, $compr, $devInode, $inodeBackup, $ctime, $mtime, $atime,
$size, $uid, $gid, $mode, $filename);
my $n = ($md5sum, $compr, $devInode, $inodeBackup, $ctime, $mtime, $atime,
$size, $uid, $gid, $mode, $filename) = split(/\s+/, $l, 12);
if ($n != 12)
{
$prLog->print('-kind' => 'W',
'-str' => ["cannot read line $. in file <" .
"$checkSumFile>, line is ..." .
"\t$l"]);
return ();
}
# $filename mit Sonderzeichen wiederherstellen
$filename =~ s/\\0A/\n/og; # '\n' wiederherstellen
$filename =~ s/\\5C/\\/og; # '\\' wiederherstellen
return ($md5sum, $compr, $devInode, $inodeBackup, $ctime, $mtime,
$atime, $size, $uid, $gid, $mode, $filename);
}
########################################
sub DESTROY
{
my $self = shift;
if ($self->{'checksumfile'})
{
$self->{'checksumfile'}->close();
$self->{'checksumfile'} = undef;
}
elsif ($self->{'CHECKSUMFILE'})
{
local *FILE = $self->{'CHECKSUMFILE'};
close(FILE);
$self->{'CHECKSUMFILE'} = undef;
}
}
##################################################
package writeCheckSumFile;
sub new
{
my $class = shift;
my $self = {};
my (%params) = ('-checkSumFile' => undef, # voller Pfad
'-blockCheckSumFile' => undef, # voller Pfad
'-infoLines' => [], # Zeilen ohne \n für .info
'-prLog' => undef,
'-chmodMD5File' => undef,
'-compressMD5File' => 'yes',
'-lateLinks' => undef,
'-tmpdir' => undef);
&::checkObjectParams(\%params, \@_, 'writeCheckSumFile::new',
['-checkSumFile', '-blockCheckSumFile',
'-infoLines', '-prLog', '-chmodMD5File',
'-checkSumFile', '-tmpdir']);
&::setParamsDirect($self, \%params);
my $prLog = $self->{'prLog'};
my $chmodMD5File = $self->{'chmodMD5File'};
my $checkSumFile = $self->{'checkSumFile'};
my $infoLines = $self->{'infoLines'};
my $compressMD5File = $self->{'compressMD5File'};
my $tmpdir = $self->{'tmpdir'};
# local *FILE;
# &::checkDelSymLink("$checkSumFile.notFinished", $prLog, 0x01);
# open(FILE, ">", "$checkSumFile.notFinished") or
# $prLog->print('-kind' => 'E',
# '-str' => ["cannot open <$checkSumFile.notFinished>"],
# '-add' => [__FILE__, __LINE__],
# '-exit' => 1);
# $self->{"checkSumFile.notFinished"} = "$checkSumFile.notFinished";
# print FILE "$$\n" or
# $prLog->print('-kind' => "E",
# '-str' => ["cannot write <$checkSumFile.notFinished>: $!"]);
# FILE->autoflush(1);
# close(FILE) or
# $prLog->print('-kind' => "E",
# '-str' => ["couldn't close <$checkSumFile.notFinished>: $!"]);
&::checkDelSymLink("$checkSumFile.info", $prLog, 0x01);
open(FILE, ">", "$checkSumFile.info") or
$prLog->print('-kind' => 'E',
'-str' => ["cannot open <$checkSumFile.info>"],
'-add' => [__FILE__, __LINE__],
'-exit' => 1);
chmod $chmodMD5File, "$checkSumFile.info";
my $l;
foreach $l (@$infoLines)
{
print FILE "$l\n" or
$self->{prLog}->print(-kind => "E",
-str => ["couldn't write infofile: $!"]);
}
close(FILE) or
$self->{prLog}->print(-kind => "E",
-str => ["couldn't close infofile: $!"]);
#
my $checkSumFile = $self->{'checkSumFile'};
my $csf = undef;
if ($self->{'compressMD5File'} eq 'yes')
{
$self->{'checkSumFile'} = "$checkSumFile.bz2";
&::checkDelSymLink("$checkSumFile.bz2", $prLog, 0x01);
$csf = pipeToFork->new('-exec' => 'bzip2',
'-stdout' => "$checkSumFile.bz2",
'-outRandom' => "$tmpdir/stbuPipeTo2-",
'-delStdout' => 'no',
'-prLog' => $prLog);
chmod $chmodMD5File, $self->{'checkSumFile'};
$csf->print("# contents/md5 compr dev-inode inodeBackup " .
"ctime mtime atime size uid gid mode filename\n");
}
else
{
&::checkDelSymLink($checkSumFile, $prLog, 0x01);
open(FILE, "> $checkSumFile") or
$prLog->print('-kind' => 'E',
'-str' => ["cannot open <$checkSumFile>"],
'-add' => [__FILE__, __LINE__],
'-exit' => 1);
chmod $chmodMD5File, $self->{'checkSumFile'};
print FILE "# contents/md5 compr dev-inode inodeBackup " .
"ctime mtime atime size uid gid mode filename\n" or
$self->{prLog}->print(-kind => "E",
-str => ["couldn't write checksum file: $!"]);
}
$self->{'CHECKSUMFILE'} = *FILE;
$self->{'checksumfile'} = $csf;
bless $self, $class;
}
########################################
sub getFilename
{
my $self = shift;
return $self->{'checkSumFile'};
}
########################################
sub write
{
my $self = shift;
my (%params) = ('-filename' => undef,
'-md5sum' => undef,
'-compr' => undef,
'-dev' => undef,
'-inode' => undef,
'-inodeBackup' => undef,
'-ctime' => undef,
'-mtime' => undef,
'-atime' => undef,
'-size' => undef,
'-uid' => undef,
'-gid' => undef,
'-mode' => undef
);
&::checkObjectParams(\%params, \@_, 'writeCheckSumFile:write',
['-filename', '-md5sum', '-compr', '-dev', '-inode',
'-inodeBackup', '-ctime', '-mtime', '-atime',
'-size', '-uid', '-gid', '-mode']);
my $filename = $params{'-filename'};
my $md5sum = $params{'-md5sum'};
my $compr = $params{'-compr'};
my $dev = $params{'-dev'};
my $inode = $params{'-inode'};
my $inodeBackup = $params{'-inodeBackup'};
my $ctime = $params{'-ctime'};
my $mtime = $params{'-mtime'};
my $atime = $params{'-atime'};
my $size = $params{'-size'};
my $uid = $params{'-uid'};
my $gid = $params{'-gid'};
my $mode = $params{'-mode'};
local *FILE;
*FILE = $self->{'CHECKSUMFILE'};
my $csf = $self->{'checksumfile'};
$filename =~ s/\\/\\5C/og; # '\\' stored as \5C
$filename =~ s/\n/\\0A/sog; # '\n' stored as \0A
$filename =~ s/^\///o; # remove leading slash if it exists
if ($csf)
{
$csf->print("$md5sum $compr $dev-$inode $inodeBackup $ctime " .
"$mtime $atime $size $uid $gid $mode $filename\n");
}
else
{
print FILE "$md5sum $compr $dev-$inode $inodeBackup $ctime " .
"$mtime $atime $size $uid $gid $mode $filename\n" or
$self->{prLog}->print(-kind => "E",
-str => ["couldn't write checksum entry: $!"]);
}
}
########################################
# !!! default destructor not possible !!!
# would be called in fork / exit at
# ::calcBlockMD5Sums
# now this method is called from
# aktFilename::closeInfoFile
# via call
sub destroy
{
my $self = shift;
if ($self->{'checksumfile'})
{
$self->{'checksumfile'}->close();
$self->{'checksumfile'} = undef;
# unlink $self->{"checkSumFile.notFinished"}
# or $self->{prLog}->print(-kind => "E",
# -str => ["couldn't delete .notFinished: $!"]);
}
elsif ($self->{'CHECKSUMFILE'})
{
local *FILE = $self->{'CHECKSUMFILE'};
my $filename = $self->{'checkSumFile'};
if (not close(FILE))
{
$self->{'prLog'}->print('-kind' => 'E',
'-str' =>
["cannot close <$filename>: $!"]);
}
chmod $self->{'chmodMD5File'}, $filename; # wg. pipe und
# compr. hier nochmals
$self->{'CHECKSUMFILE'} = undef;
# unlink $self->{"checkSumFile.notFinished"} or
# $self->{prLog}->print(-kind => "E",
# -str => ["couldn't delete .notFinished: $!"]);
}
}
##################################################
# generates an index out of a directory name
# requests: 'index -> dir' or 'dir -> index'
# this is for shorten the berkely db files and
# therefor for better caching of it
package indexDir;
sub new
{
my $class = shift;
my $self = {};
my (%indexToDir) = ();
my (%dirToIndex) = ();
$self->{'indexToDir'} = \%indexToDir;
$self->{'dirToIndex'} = \%dirToIndex;
$self->{'count'} = 0;
bless $self, $class;
}
########################################
sub newFile
{
my $self = shift;
my $file = shift;
my ($d, $f) = &::splitFileDir($file);
my $dirToIndex = $self->{'dirToIndex'};
if (exists($$dirToIndex{$d}))
{
return ($d, $f, $$dirToIndex{$d});
}
else
{
my $indexToDir = $self->{'indexToDir'};
$$dirToIndex{$d} = $self->{'count'};
$$indexToDir{$self->{'count'}} = $d;
return ($d, $f, $self->{'count'}++);
}
}
########################################
sub newDir
{
my $self = shift;
my $d = shift;
my $dirToIndex = $self->{'dirToIndex'};
if (exists($$dirToIndex{$d}))
{
return $$dirToIndex{$d};
}
else
{
my $indexToDir = $self->{'indexToDir'};
$$dirToIndex{$d} = $self->{'count'};
$$indexToDir{$self->{'count'}} = $d;
return $self->{'count'}++;
}
}
########################################
sub replaceIndex
{
my $self = shift;
my $fileWithIndex = shift;
my ($index, $f) = split('/', $fileWithIndex, 2);
my $indexToDir = $self->{'indexToDir'};
return $$indexToDir{$index} . "/$f";
}
########################################
sub index2dir
{
my $self = shift;
my $index = shift;
my $indexToDir = $self->{'indexToDir'};
return $$indexToDir{$index};
}
########################################
sub setIndex
{
my $self = shift;
my $fileWithoutIndex = shift;
my ($d, $f, $index) = $self->newFile($fileWithoutIndex);
return "$index/$f";
}
######################################################################
package lateLinks;
sub new
{
my $class = shift;
my $self = {};
my (%params) = ('-dirs' => [],
'-kind' => undef, # 'directList' or 'recursiveSearch'
'-checkLinkFromConsistency' => undef,
'-verbose' => undef,
'-prLog' => undef,
'-verbose' => undef,
'-debug' => undef,
'-interactive' => undef,
'-autorepair' => undef,
'-autorepairError' => 1, # action of autorepair == 'E'
'-includeRenamedBackupDirs' => undef);
&::checkObjectParams(\%params, \@_, 'lateLinks::new',
['-dirs', '-kind', '-prLog', '-verbose']);
&::setParamsDirect($self, \%params);
my $prLog = $self->{'prLog'};
bless $self, $class;
onceAgainBecauseOfErrorCorrection:; # only in interactive mode
my (@dirs) = @{$self->{'dirs'}};
#print "##### lateLinks->new ---------dirs = @dirs--------\n";
my $dirs = \@dirs; # Kopie anlegen
my $verbose = $self->{'verbose'};
my $debug = $self->{'debug'};
#print "(1) autorepair = <", $self->{'autorepair'}, "> autorepairError = <", $self->{'autorepairError'}, ">\n";
my $kindAuto = $self->{'autorepairError'} ? 'E' : 'I';
$self->{'autorepair'} = 1 unless $self->{'autorepairError'};
my $autorepair = $self->{'autorepair'};
my $ar = $autorepair ? "autorepair: " : "";
#print "(2) autorepair = <", $self->{'autorepair'}, "> autorepairError = <", $self->{'autorepairError'}, ">\n";
my (%allBackupDirsWithLateLinks) = ();
$self->{'allBackupDirsWithLateLinks'} = \%allBackupDirsWithLateLinks;
my $d;
$self->{'allStbuDirs'} = [];
foreach $d (@$dirs)
{
$d = ::absolutePath("$d/..")
if $self->{'kind'} eq 'directList';
if (-d $d)
{
my ($s, $b, $r) = $self->listAllStoreBackupDirs($d);
$s -= 1;
$s = 0 if $s < 0;
$prLog->print('-kind' => 'S',
'-str' =>
["found $s backup series, $b backups, "
. "$r renamed backups"]);
}
}
my $allStbuDirs = $self->{'allStbuDirs'};
if ($verbose)
{
my (@mes) = ("reading late link entries in");
foreach $d (sort @$allStbuDirs)
{
push @mes, " $d";
}
$prLog->print('-kind' => 'I',
'-str' => \@mes);
}
#### read linkTo and linkFrom
my $error = 0;
my (%linkTo, %linkFrom);
$self->{'linkTo'} = \%linkTo;
$self->{'linkFrom'} = \%linkFrom;
#print "allStbuDirs = @$allStbuDirs\n";
#&::printData(\%linkFrom, '(i0.1) --linkFrom--');
foreach $d (@$allStbuDirs)
{
$d = ::absolutePath($d);
$prLog->print('-kind' => 'E',
'-str' => ["cannot access <$d/.storeBackupLinks>, " .
"check permissions"],
'-exit' => 1)
unless -r "$d/.storeBackupLinks";
my $hasLinkFile = -e "$d/.storeBackupLinks/linkFile.bz2";
my $hasLinkToFile = -e "$d/.storeBackupLinks/linkTo";
#print "$d: hasLinkFile = $hasLinkFile, hasLinkToFile = $hasLinkToFile\n";
#&::printData(\%linkFrom, "(i0.2) $d -> --linkFrom--");
if ($hasLinkToFile and not $hasLinkFile)
{
if ($self->{'interactive'})
{
my $f = "$d/.storeBackupLinks/linkTo";
my $answer;
do
{
print "backup <$d> has linkTo file\n",
"<$f>, but no\n",
"linkFile.bz2 in <$d/.storeBackupLinks>!!\n",
"This means, this backup has a reference to another backup\n",
"but no information what to reference (link):\n",
"THIS BACKUP IS CORRUPTED AND NOT RECOVERABLE\n",
"(you can save the existing files in it,\n",
"but not recover the hard links)\n",
"delete the (useless) linkTo referene?\n",
"yes / no -> ";
$answer = ;
chomp $answer;
} while ($answer ne 'yes' and $answer ne 'no');
if ($answer eq 'yes')
{
if (unlink("$f"))
{
$prLog->print('-kind' => 'I',
'-str' => ["deleted <$f>"]);
}
else
{
$prLog->print('-kind' => 'E',
'-str' => ["cannot delete <$f>"],
'-exit' => 1);
}
if (rename($d, "$d-broken"))
{
$prLog->print('-kind' => 'I',
'-str' => ["renamed <$d> to <$d-broken>"]);
}
else
{
$prLog->print('-kind' => 'E',
'-str' => ["cannot rename <$d> to <$d-broken>"],
'-exit' => 1);
}
}
$prLog->print('-kind' => $kindAuto,
'-str' => ["",
"----- repeating consistency check -----"]);
goto onceAgainBecauseOfErrorCorrection;
}
else
{
$prLog->print('-kind' => 'E',
'-str' =>
["backup <$d> has linkTo file, but no",
"linkFile.bz2 in .storeBackupLinks",
"this means it has a reference to another backup",
"but no information what to reference: this backup is lost!",
"please repair with storeBackupUpdateBackup.pl"],
'-exit' => 1)
}
}
if ($hasLinkFile)
{
#&::printData(\%allBackupDirsWithLateLinks, "(i1) --allBackupDirsWithLateLinks-- + $d");
$allBackupDirsWithLateLinks{$d} = 1;
}
local *DIR;
#print "--- reading <$d/.storeBackupLinks>\n";
unless (opendir(DIR, "$d/.storeBackupLinks"))
{
$prLog->print('-kind' => 'E',
'-str' => ["cannot open <.storebackupLinks> in <$d>".
" please check your backup or permissions of this program!"],
'-add' => [__FILE__, __LINE__]
);
$error++;
next;
}
my $entry; # directory entries of $d/.storeBackupLinks
while ($entry = readdir DIR)
{
#print "-0- entry <$d/.storeBackupLinks/$entry>\n";
next if ($entry eq '.' or $entry eq '..');
if ($entry eq 'linkTo')
{
my $f = "$d/.storeBackupLinks/$entry";
$f =~ s/\/{2,}/\//og;
unless (-w $f)
{
$error++;
$prLog->print('-kind' => 'E',
'-str' => ["no write permissions on <$f>"]);
}
local *FILE;
#print "-1- open <$f>\n";
unless (open(FILE, $f))
{
$prLog->print('-kind' => 'E',
'-str' => ["cannot open <$f>"],
'-add' => [__FILE__, __LINE__]);
$error++;
next;
}
my $line;
while ($line = )
{
chomp $line;
#print "-2- line = <$d/$line>\n";
my $l = &::absolutePath("$d/$line");
#print "-3- l = <$l>\n";
unless ($l)
{
$prLog->print('-kind' => 'E',
'-str' => ["FATAL ERROR: link <$line> to non existing" .
" dir in <$f>"]);
$error++;
if ($self->{'interactive'})
{
my $answer;
do
{
print "Backup <$d> refers to NON EXISTING\n",
"backup <$line>!!\n",
"This means:\n",
"- you didn't call $0 with all backup directories\n",
"- the backup <$line> was deleted by somebody\n",
"MAKE SHURE YOU ARE CALLING $0 WITH ALL\n",
"BACKUPS AS A PARAMETER AND RESTART (say 'no' below)!\n",
"rename backup to <${d}-broken>?\n",
"yes / no -> ";
$answer = ;
chomp $answer;
} while ($answer ne 'yes' and $answer ne 'no');
close(FILE);
closedir(DIR);
if ($answer eq 'yes')
{
if (rename($d => "${d}-broken"))
{
$prLog->print('-kind' => 'I',
'-str' =>
["renamed <$d> to <${d}-broken"]);
::clearAbsolutePathCache();
}
else
{
$prLog->print('-kind' => 'E',
'-str' => ["cannot rename <$d>"],
'-exit' => 1);
}
}
$prLog->print('-kind' => $kindAuto,
'-str' => ["----- repeating consistency check -----"]);
goto onceAgainBecauseOfErrorCorrection;
}
}
$linkTo{$d}{$l} = $f;
#&::printData(\%allBackupDirsWithLateLinks, "(i2) --allBackupDirsWithLateLinks-- + $d + $l");
$allBackupDirsWithLateLinks{$d} = 1;
$allBackupDirsWithLateLinks{$l} = 1;
}
close(FILE);
}
elsif ($entry =~ /\AlinkFrom\d+\Z/)
{
my $f = "$d/.storeBackupLinks/$entry";
$f =~ s/\/{2,}/\//og;
unless (-w $f)
{
$error++;
$prLog->print('-kind' => 'E',
'-str' => ["no write permissions on <$f>"]);
}
local *FILE;
#print "-10- open <$f>\n";
unless (open(FILE, $f))
{
$prLog->print('-kind' => 'E',
'-str' => ["cannot open <$f>"],
'-add' => [__FILE__, __LINE__]);
$error++;
next;
}
my $line;
$line = ;
chomp $line;
#print "-11- line = <$d/$line>\n";
my $l = &::absolutePath("$d/$line");
#print "-12- l = <$l>\n";
my $unfinishedDir = $l;
# $l = '' if -e ("$l/.md5CheckSums.notFinished");
$l = '' unless &::checkIfBackupWasFinished('-backupDir' => $l,
'-prLog' => $prLog,
'-count' => 5);
unless ($l)
{
$prLog->print('-kind' => $kindAuto,
'-str' => ["link <$line> to non existing " .
"dir in <$f>"]);
$error++;
if ($self->{'interactive'} or $autorepair)
{
my $answer;
if ($autorepair)
{
$answer = 'yes';
}
else
{
do
{
# if (-e "$unfinishedDir/.md5CheckSums.notFinished")
unless
(&::checkIfBackupWasFinished('-backupDir' => $unfinishedDir,
'-prLog' => $prLog,
'-count' => 6))
{
print "There was a backup <$line> refering to <$d>.\n",
"The backup <$line> is not finished\n",
"delete this reference?\n",
"yes / no -> ";
}
else
{
print "There was a backup <$line> refering to <$d>.\n",
"The backup <$line> cannot be found. This means:\n",
"- you didn't call $0 with all backup directories or\n",
"- the backup <$line> was deleted by somebody.\n",
"ONLY DELETE THIS REFERENCE IF THE BACKUP <$line> DOES\n",
"NOT EXIST ANY MORE!\n",
"delete this reference?\n",
"yes / no -> ";
}
$answer = ;
chomp $answer;
} while ($answer ne 'yes' and $answer ne 'no');
}
close(FILE);
closedir(DIR);
if ($answer eq 'yes')
{
if (unlink($f))
{
$prLog->print('-kind' => 'I',
'-str' => ["${ar}deleted <$f>"]);
}
else
{
$prLog->print('-kind' => 'E',
'-str' => ["${ar}cannot delete <$f>"],
'-exit' => 1);
}
}
$prLog->print('-kind' => $kindAuto,
'-str' => [
"----- repeating consistency check -----"]);
goto onceAgainBecauseOfErrorCorrection;
}
}
$linkFrom{$d}{$l} = $f;
#print "-13- linkFrom{$d}{$l} = $f\n";
#&::printData(\%allBackupDirsWithLateLinks, "(i3) --allBackupDirsWithLateLinks-- + $d + $l");
$allBackupDirsWithLateLinks{$d} = 1;
$allBackupDirsWithLateLinks{$l} = 1;
close(FILE);
}
elsif ($entry eq 'linkFile.bz2')
{
my $f = "$d/.storeBackupLinks/$entry";
$f =~ s/\/{2,}/\//og;
unless (-w $f)
{
$error++;
$prLog->print('-kind' => 'E',
'-str' => ["no write permissions on <$f>"]);
}
}
}
closedir(DIR);
}
if ($error and not $self->{'interactive'})
{
$prLog->print('-kind' => 'E',
'-str' => ["found $error inconsistencies, please " .
"repair and check again"],
'-exit' => 1);
}
#$self->printLinkRef('linkTo');
#$self->printLinkRef('linkFrom');
if ($self->checkLinkConsistency())
{
$prLog->print('-kind' => $kindAuto, # return == 1 only in
'-str' => # interactive mode
["", "----- repeating consistency check -----"]);
goto onceAgainBecauseOfErrorCorrection;
}
$prLog->print('-kind' => 'I',
'-str' => ["consistency check finished successfully"]);
# if ($verbose)
if (1)
{
my $link = undef;
my $numlinkTo = 0;
$link = $self->{'linkTo'} if defined $self->{'linkTo'};
my (@mes) = ();
if ($link)
{
my $path;
foreach $path (sort keys %$link)
{
++$numlinkTo;
push @mes, " $path";
my $hash = $$link{$path};
my $p;
foreach $p (sort keys %$hash)
{
push @mes, " -> $p";
}
}
}
if (@mes)
{
unshift @mes, "listing references:";
$prLog->print('-kind' => 'I',
'-str' => \@mes);
}
else
{
$prLog-> print('-kind' => 'I',
'-str' =>
["found no references to backups from lateLinks that " .
"need storeBackupUpdateBackup run"]);
}
$self->{'numLinkTo'} = $numlinkTo;
}
return $self;
}
########################################
sub getNumLinkTo
{
my $self = shift;
return $self->{'numLinkTo'};
}
########################################
sub checkLinkConsistency
{
my $self = shift;
my $interactive = $self->{'interactive'};
my $autorepair = $self->{'autorepair'};
my $kindAuto = $self->{'autorepairError'} ? 'E' : 'I';
my $ar = $autorepair ? "autorepair: " : "";
my $prLog = $self->{'prLog'};
my $verbose = $self->{'verbose'};
my $debug = $self->{'debug'};
my $checkLinkFromConsistency = $self->{'checkLinkFromConsistency'};
$prLog->print('-kind' => 'I',
'-str' => ["listing unresolved links"])
if $debug;
my $fromDir = $self->{'linkTo'};
my $toDir = $self->{'linkFrom'};
my $error = 0;
my $dir;
#print "interactive = <$interactive>\n";
#print "........... checkLinkConsistency ............\n";
foreach $dir (sort keys %$fromDir)
{
my $link;
my $hash = $$fromDir{$dir};
foreach $link (sort keys %$hash)
{
$prLog->print('-kind' => 'I',
'-str' => ["linkTo: $dir -> $link"])
if $debug;
#print "..1.. $dir $link\n";
if ($dir eq $link)
{
#print "..2.. equal\n";
$prLog->print('-kind' => 'E',
'-str' => ["\tdir <$dir> has link to itself!",
"\tin file " . $$fromDir{$dir}{$link},
"\tto correct, delete this link / line"]);
$error++;
if ($interactive or $autorepair)
{
my $answer;
if ($autorepair)
{
$answer = 'yes';
}
else
{
do
{
print "delete this link (it makes no sense at all)?\n",
"yes / no -> ";
$answer = ;
chomp $answer;
} while ($answer ne 'yes' and $answer ne 'no');
}
if ($answer eq 'yes')
{
$self->deleteLinkFromFileLinkTo($$fromDir{$dir}{$link},
$link, $dir, $ar);
$prLog->print('-kind' => 'W',
'-str' => ["${ar}link deleted"]);
}
return 1;
}
}
elsif (defined $$toDir{$link})
{
#print "..3.. toDir defined $link\n";
$prLog->print('-kind' => 'I',
'-str' => ["\tdirectory <$dir> has linkTo"])
if $debug;
if (defined $$toDir{$link}{$dir})
{
$prLog->print('-kind' => 'I',
'-str' =>
["\t\tand links back to <$dir>",
"\t\t\t(file " . $$fromDir{$dir}{$link} . ")",
"\t\t\t(file " . $$toDir{$link}{$dir} . ")"])
if $debug;
}
else
{
if ($checkLinkFromConsistency)
{
$prLog->print('-kind' => $kindAuto,
'-str' =>
["\t\t1 no link back to <$dir>",
"\t\t\t(file " . $$fromDir{$dir}{$link} . ")",
"\t\t\t(missing in directory " .
"$link/.storeBackupLinks/linkFrom...)"]);
$error++;
if ($interactive or $autorepair)
{
my $answer;
if ($autorepair)
{
$answer = 'yes';
}
else
{
do
{
print "write the link back (save)?\n",
"yes / no -> ";
$answer = ;
chomp $answer;
} while ($answer ne 'yes' and $answer ne 'no');
}
$self->writeFileLinkFrom($link, $dir, $ar);
return 1;
}
}
}
}
else
{
if ($checkLinkFromConsistency)
{
$prLog->print('-kind' => $kindAuto,
'-str' => ["\t1 directory <$link> has no " .
"linkFrom entry"]);
$error++;
if ($interactive or $autorepair)
{
my $answer;
if ($autorepair)
{
$answer = 'yes';
}
else
{
do
{
print "set entry in <$link>?\n",
"yes / no -> ";
$answer = ;
chomp $answer;
} while ($answer ne 'yes' and $answer ne 'no');
}
$self->writeFileLinkFrom($link, $dir, $ar)
if $answer eq 'yes';
return 1;
}
}
}
}
}
foreach $dir (sort keys %$toDir)
{
my $link;
my $hash = $$toDir{$dir};
foreach $link (sort keys %$hash)
{
$prLog->print('-kind' => 'I',
'-str' => ["linkTo: $dir -> $link"])
if $debug;
if ($dir eq $link)
{
$prLog->print('-kind' => 'E',
'-str' => ["\tdir <$dir> has link to itself!",
"\tin file " . $$toDir{$dir}{$link},
"\tto correct, delete this file"]);
$error++;
if ($interactive)
{ # covered through error handling above
$prLog->print('-kind' => 'E',
'-str' => ["error 1 in checkLinkConsistency",
"This should never happen",
"please write a bug report"],
'-exit' => 1);
}
}
elsif (defined $$fromDir{$link})
{
$prLog->print('-kind' => 'I',
'-str' => ["\tdirectory <$dir> has linkFrom"])
if $debug;
if (defined $$fromDir{$link}{$dir})
{
$prLog->print('-kind' => 'I',
'-str' =>
["\t\tand links back to <$dir>",
"\t\t\t(file " . $$toDir{$dir}{$link} . ")",
"\t\t\t(file " . $$fromDir{$link}{$dir} . ")"])
if $debug;
}
else
{
$prLog->print('-kind' => 'E',
'-str' =>
["\t\t2 no link back to <$dir>",
"\t\t\t(file " . $$toDir{$dir}{$link} . ")",
"\t\t\t(missing in directory " .
"$link/.storeBackupLinks/linkTo)"]);
$error++;
if ($interactive)
{ # covered through error handling above
$prLog->print('-kind' => 'E',
'-str' => ["error 1 in checkLinkConsistency",
"This should never happen",
"please write a bug report"],
'-exit' => 1);
}
}
}
else
{
$prLog->print('-kind' => 'E',
'-str' => ["\t2 directory <$link> has no entry",
"in linkTo to <$dir> but",
"<$dir> has linkFrom to <$link>"]);
$error++;
if ($interactive or $autorepair)
{
my $answer;
if ($autorepair)
{
$answer = 'yes';
}
else
{
do
{
print "set entry in <$link>?\n",
"yes / no -> ";
$answer = ;
chomp $answer;
} while ($answer ne 'yes' and $answer ne 'no');
}
$self->addLink2LinkTo($link, $dir, $ar)
if $answer eq 'yes';
return 1;
}
}
}
}
unless ($interactive)
{
if ($error)
{
$prLog->print('-kind' => 'E',
'-str' => ["found $error inconsistencies, please " .
"repair and check again"],
'-exit' => 1);
}
else
{
$prLog->print('-kind' => 'I',
'-str' => ["no unresolved links"])
if $debug;
}
}
return 0; # leave in non-interactive mode
}
########################################
sub listAllStoreBackupDirs
{
my $self = shift;
my $dir = shift;
return (0, 0, 0) if -l $dir;
$dir =~ s#/+$##; # remove trailing slash
my $prLog = $self->{'prLog'};
my $verbose = $self->{'verbose'};
my $includeRenamedBackupDirs = $self->{'includeRenamedBackupDirs'};
my ($series, $backup, $renamed) = (0, 0, 0);
my ($x, $entry) = ::splitFileDir($dir);
if ($entry =~ /\A\d{4}\.\d{2}\.\d{2}_\d{2}\.\d{2}\.\d{2}\Z/)
{
# next if -e "$dir/.md5CheckSums.notFinished";
next unless &::checkIfBackupWasFinished('-backupDir' => $dir,
'-prLog' => $prLog,
'-count' => 7);
$self->{'prLog'}->print('-kind' => 'I',
'-str' => ["\tfound <$dir>"])
if $self->{'verbose'};
++$backup;
push @{$self->{'allStbuDirs'}}, $dir;
}
elsif ($entry =~ /\A\d{4}\.\d{2}\.\d{2}_\d{2}\.\d{2}\.\d{2}-.*\Z/)
{
#print "----------elsif $entry\n";
push @{$self->{'allStbuDirs'}}, $dir
if $includeRenamedBackupDirs;
++$renamed;
}
else
{
$prLog->print('-kind' => 'I',
'-str' =>
["scanning directory <$dir> for existing backups"]);
++$series;
local *DIR;
unless (opendir(DIR, $dir))
{
$prLog->print('-kind' => 'E',
'-str' => ["cannot opendir <$dir>"],
'-add' => [__FILE__, __LINE__])
if $verbose;
return ($series, $backup, $renamed);
}
while ($entry = readdir DIR)
{
next if ($entry eq '.' or $entry eq '..');
my $fullEntry = "$dir/$entry";
next unless -d $fullEntry;
my ($s, $b, $r) = $self->listAllStoreBackupDirs($fullEntry);
$series += $s;
$backup += $b;
$renamed += $r;
}
close(DIR);
}
return ($series, $backup, $renamed);
}
########################################
sub getAllStoreBackupDirs
{
my $self = shift;
return $self->{'allStbuDirs'};
}
########################################
# delivers names of series
# delivers series in $backupDir
sub getAllStoreBackupSeries
{
my $self = shift;
my $backupDir = shift;
my $all = $self->getAllStoreBackupDirs();
my (%s) = ();
foreach my $a (@$all)
{
$a =~ s/(.*)\/(\d{4})\.(\d{2})\.(\d{2})_\d{2}\.\d{2}\.\d{2}/$1/;
$s{$1} = 1
if $a =~ m#$backupDir/(.*)\Z#;
}
return [sort keys %s];
}
########################################
sub checkDir
{
my $self = shift;
my $dir = shift; # must be an absolute path name
#print "\tchecking <$dir> against:\n";
#print "\t\t<", join('><', sort keys %{$self->{'allBackupDirsWithLateLinks'}}), ">\n";
return exists $self->{'allBackupDirsWithLateLinks'}{$dir};
}
########################################
sub checkDirHasLinkTo
{
my $self = shift;
my $dir = shift; # must be an absolute path name
return -e "$dir/.storeBackupLinks/linkTo";
}
########################################
sub getAllDirsWithLateLinks
{
my $self = shift;
return keys %{$self->{'allBackupDirsWithLateLinks'}};
}
########################################
sub getLinkToHash
{
my $self = shift;
return $self->{'linkTo'};
}
########################################
sub getLinkFromHash
{
my $self = shift;
return $self->{'linkFrom'};
}
########################################
sub printLinkRef
{
my $self = shift;
my $name = shift;
my $link = undef;
$link = $self->{$name} if defined $self->{$name};
return unless $link;
print "---- begin $name ----\n";
my $path;
foreach $path (sort keys %$link)
{
print "$path:\n";
my $hash = $$link{$path};
my $p;
foreach $p (sort keys %$hash)
{
print "\t$p\n";
}
}
print "---- end $name ----\n";
}
########################################
sub deleteLinkFromFileLinkTo
{
my $self = shift;
my $file = shift;
my $link = shift;
my $actDir = shift;
my $ar = shift;
#print ".........in deleteLinkFromFileLinkTo\n";
my $prLog = $self->{'prLog'};
# read whole file and filter
local *FILE;
open(FILE, $file) or
$prLog->print('-kind' => 'E',
'-str' => ["${ar}cannot open <$file>"],
'-add' => [__FILE__, __LINE__],
'-exit' => 1);
my ($l, @l);
while ($l = )
{
chomp $l;
push @l, $l unless $link eq ::absolutePath("$actDir/$l");
}
close(FILE) or
$prLog->print('-kind' => 'E',
'-str' => ["${ar}cannot close <$file>"],
'-exit' => 1);
# write data back
open(FILE, "> $file") or
$prLog->print('-kind' => 'E',
'-str' => ["${ar}cannot open <$file> for writing"],
'-add' => [__FILE__, __LINE__],
'-exit' => 1);
print FILE join("\n", @l), "\n";
close(FILE) or
$prLog->print('-kind' => 'E',
'-str' => ["cannot close <$file>"],
'-exit' => 1);
}
########################################
#sub setX1
sub addLink2LinkTo # adds a link in linkTo
{
my $self = shift;
my $dirOfLinkTo = shift;
my $refTo = shift;
my $ar = shift;
#print ".........in addLink2LinkTo\n";
my $prLog = $self->{'prLog'};
#print "\tdirOfLinkTo = <$dirOfLinkTo>\n";
#print "\trefTo = <$refTo>\n";
my $f = "$dirOfLinkTo/.storeBackupLinks/linkTo";
local *TO;
open(TO, ">> $f") or
$prLog->print('-kind' => 'E',
'-str' => ["${ar}cannot open for appending <$f>"],
'-exit' => 1);
my $relpath = ::relPath($dirOfLinkTo, $refTo);
print TO "$relpath\n" or
$prLog->print('-kind' => 'E',
'-str' => ["${ar}cannot write to <$f>"],
'-exit' => 1);
close(TO) or
$prLog->print('-kind' => 'E',
'-str' => ["${ar}cannot close <$f>"],
'-exit' => 1);
$prLog->print('-kind' => 'W',
'-str' => ["${ar}wrote linkTo <$refTo> in " .
"<$dirOfLinkTo>"]);
}
########################################
sub writeFileLinkFrom
{
my $self = shift;
my $dirWhereToSetLinkFrom = shift;
my $targetForLinkFrom = shift;
my $ar = shift;
#print ".........in writeFileLinkFrom\n";
my $prLog = $self->{'prLog'};
#print "\tdirWhereToSetLinkFrom = <$dirWhereToSetLinkFrom>\n";
#print "\ttargetForLinkFrom = <$targetForLinkFrom>\n";
my $i = 0;
local *FROM;
my $from = "$dirWhereToSetLinkFrom/.storeBackupLinks/linkFrom";
$i++ while -e "$from$i";
open(FROM, "> $from$i") or
$prLog->print('-kind' => 'E',
'-str' => ["${ar}cannot open for writing <$from$i>"],
'-exit' => 1);
my $relpath = ::relPath($dirWhereToSetLinkFrom, $targetForLinkFrom);
print FROM "$relpath\n" or
$prLog->print('-kind' => 'E',
'-str' => ["${ar}cannot write to <$from$i>"],
'-exit' => 1);
close(FROM) or
$prLog->print('-kind' => 'E',
'-str' => ["${ar}cannot close <$from$i>"],
'-exit' => 1);
my $kindAuto = $self->{'autorepairError'} ? 'W' : 'I';
$prLog->print('-kind' => $kindAuto,
'-str' => ["${ar}wrote linkFrom from <$dirWhereToSetLinkFrom>" .
" to <$targetForLinkFrom>"]);
}
############################################################
package evalInodeRule;
sub new
{
my $class = shift;
my $self = {};
# set default values for parameters
my (%params) = ('-line' => [],
'-keyName' => undef, # eg. includeRule
'-debug' => 0, # debug == 0: no output
# debug == 1: result per file
# debug == 2: debugging output
'-tmpdir' => '/tmp',
'-prLog' => undef
);
&::checkObjectParams(\%params, \@_, 'evalInodeRule::new',
['-line', '-keyName', '-prLog']);
&::setParamsDirect($self, \%params);
if ($self->{'line'})
{
my $prLog = $self->{'prLog'};
my (@allowedVars) = ('file', 'size', 'mode', 'ctime', 'mtime',
'uid', 'uidn', 'gid', 'gidn', 'type');
my $evalTools = evalTools->new('-linevector' => $self->{'line'},
'-allowedVars' => \@allowedVars,
'-tmpdir' => $self->{'tmpdir'},
'-prefix' => $self->{'keyName'},
'-prLog' => $prLog);
$evalTools->checkLineBug('-exitOnError' => 1,
'-printError' => 1);
$self->{'evalTools'} = $evalTools;
}
bless $self, $class;
}
########################################
sub checkRule
{
my $self = shift;
my ($file, $size, $mode, $ctime, $mtime, $uidn, $gidn, $type) = @_;
my $debug = $self->{'debug'};
my $evalTools = $self->{'evalTools'};
my $uid = getpwuid($uidn);
my $gid = getgrgid($gidn);
$uid = '' unless $uid;
$gid = '' unless $gid;
my (%values) = ('file' => $file,
'size' => $size,
'mode' => $mode,
'ctime' => $ctime,
'mtime' => $mtime,
'uid' => $uid,
'uidn' => $uidn,
'gid' => $gid,
'gidn' => $gidn,
'type' => $type);
my $ret;
if ($debug == 0 or $debug == 1)
{
$ret = $evalTools->fastEval(\%values);
$self->{'prLog'}->print('-kind' => 'D',
'-str' => [$self->{'keyName'} .
": <$ret> <== <$file>"])
if $debug == 1;
}
else # debug >= 2
{
$ret = $evalTools->checkLineDebug(\%values, ", <$file>: ");
}
return $ret;
}
########################################
sub setDebugFlag
{
my $self = shift;
$self->{'debug'} = shift; # 0, 1, 2
}
########################################
sub getLine
{
my $self = shift;
return $self->{'line'};
}
########################################
sub getLineString
{
my $self = shift;
return $self->{'line'} ? join(' ', @{$self->{'line'}}) : undef;
}
########################################
sub hasLine
{
my $self = shift;
return $self->{'line'} ? 1 : 0;
}
########################################
%main::DATE_Cache = ();
sub main::DATE
{
my $par = shift;
return $main::DATE_Cache{$par} if exists $main::DATE_Cache{$par};
my $ret = undef;
if ($par =~ /\A(\d{4})\.(\d{2})\.(\d{2})(_\d{2}\.\d{2}\.\d{2})?\Z/o)
{
my (@p) = ('-year' => $1,
'-month' => $2,
'-day' => $3);
my $t = $4;
if (defined $t)
{
$t =~ /\A_(\d{2})\.(\d{2})\.(\d{2})\Z/o;
push @p, ('-hour' => $1,
'-min' => $2,
'-sec' => $3);
}
my $d = dateTools->new(@p);
$ret = $d->getSecsSinceEpoch() if $d->isValid();
}
elsif (dateTools::checkStr('-str' => $par)) # ..d..h..m..s
{
my $now = dateTools->new();
$now->sub('-str' => $par);
$ret = $now->getSecsSinceEpoch();
}
else
{
$main::__prLog->print('-kind' => 'E',
'-str' => ["illegal format <$par> in ::DATE"],
'-exit' => 1);
}
$main::__prLog->print('-kind' => 'E',
'-str' => ["time <$par> before 1970 not possible"],
'-exit' => 1)
if $ret < 0;
$main::DATE_Cache{$par} = $ret;
return $ret;
}
########################################
%main::SIZE_Cache = ();
sub main::SIZE
{
my $par = shift;
return $main::SIZE_Cache{$par} if exists $main::SIZE_Cache{$par};
my ($ret) = &::revertHumanReadable($par);
$main::__prLog->print('-kind' => 'E',
'-str' => ["cannot convert <$par> in ::SIZE"],
'-exit' => 1)
unless defined $ret;
$main::SIZE_Cache{$par} = $ret;
return $ret;
}
########################################
sub main::COMPRESSION_CHECK
{
my $file = shift;
$file = $main::sourceDir . "/$file";
#print "###########$file##########\n";
local *IN;
unless (sysopen(IN, $file, "O_RDONLY"))
{
return 0; # no compression
}
my $inBuffer;
sysread(IN, $inBuffer, 10*1024**2);
close(IN);
return 0
if length($inBuffer) == 0;
my $outBuffer;
::gzip \$inBuffer => \$outBuffer, Level => 1;
if (length($outBuffer)/length($inBuffer) < 0.95)
{
#print "--$file--1\n";
$main::stat->incr_noComprCheckCompr();
return 1; # compression possible
}
else
{
#print "--$file--0\n";
$main::stat->incr_noComprCheckCp();
return 0; # no compression
}
}
########################################
%main::MARK_DIR_REC_Cache = ();
%main::MARK_DIR_INCL_REC_Cache = ();
sub main::MARK_DIR_REC
{
my $file = shift;
my $flagFile = shift;
$flagFile = '.storeBackupMarkRec' unless defined $flagFile;
#print "\n---------\n";
#foreach my $a (sort keys %main::MARK_DIR_REC_Cache)
#{
# print "#$a#\n";
# foreach my $b (sort keys %{$main::MARK_DIR_REC_Cache{$a}})
# {
# print "$a -> $b ->", $main::MARK_DIR_REC_Cache{$a}{$b}, "\n";
# }
#}
#print "---------\n";
#print "\n---------\n";
#foreach my $a (sort keys %main::MARK_DIR_REC_Cache)
#{
# my $b = $main::MARK_DIR_REC_Cache{$a};
# $b =~ s/\000/;/g;
# print "$a -> $b\n";
#}
#print "---------\n";
my $incl = undef;
for (;;)
{
my ($d, $f) = &::splitFileDir($file);
$incl = $d unless defined $incl;
#print "d = <$d>, f = <$f>, incl = <$incl>, flagFile = <$flagFile>\n";
# if (exists $main::MARK_DIR_INCL_REC_Cache{$d}{$flagFile})
if (&::existStr(\%main::MARK_DIR_INCL_REC_Cache, $d, $flagFile))
{
#print "-1-\n";
# $main::MARK_DIR_INCL_REC_Cache{$incl}{$flagFile} = 1 if $incl;
&::addToStr(\%main::MARK_DIR_INCL_REC_Cache, $incl, $flagFile) if $incl;
return 0;
}
#print "-2-\n";
# if (exists $main::MARK_DIR_REC_Cache{$d}{$flagFile})
if (&::existStr(\%main::MARK_DIR_REC_Cache, $d, $flagFile))
{
#print "-2.5-\n";
# $main::MARK_DIR_REC_Cache{$incl}{$flagFile} = 1;
&::addToStr(\%main::MARK_DIR_REC_Cache, $incl, $flagFile);
return 1;
}
#print "-3-\n";
if (-f "$main::sourceDir/$d/$flagFile")
{
#print "-4-\n";
# $main::MARK_DIR_REC_Cache{$d}{$flagFile} = 1;
&::addToStr(\%main::MARK_DIR_REC_Cache, $d, $flagFile);
$main::__prLog->print('-kind' => 'I',
'-str' =>
["MARK_DIR_REC matches <$main::sourceDir/$d>" .
" because of file <$flagFile>"])
if defined $d; # do not print in test run with 'eval'
#print "MARK_DIR_REC matches <$d> because of file <$flagFile>\n" if defined $d;
return 1;
}
#print "-5-\n";
# if ($d eq '.' or not defined $d)
if (not defined $d or $d eq '.')
{
#print "-6- REC_CACHE($incl)($flagFile) = 1\n";
# $main::MARK_DIR_INCL_REC_Cache{$incl}{$flagFile} = 1 if $incl;
&::addToStr(\%main::MARK_DIR_INCL_REC_Cache, $incl, $flagFile) if $incl;
return 0;
}
else
{
#print "-7-\n";
$file = $d;
}
#print "-8-\n";
}
#print "-9-\n";
}
########################################
%main::MARK_DIR_Cache = ();
sub main::MARK_DIR
{
my $file = shift;
my $flagFile = shift;
$flagFile = '.storeBackupMark' unless defined $flagFile;
my ($d, $f) = &::splitFileDir($file);
return 1
if &::existStr(\%main::MARK_DIR_Cache, "$main::sourceDir/$d", $flagFile);
# if exists $main::MARK_DIR_Cache{"$main::sourceDir/$d"}{$flagFile};
if (-f "$main::sourceDir/$d/$flagFile")
{
&::addToStr(\%main::MARK_DIR_Cache, "$main::sourceDir/$d", $flagFile);
# $main::MARK_DIR_Cache{"$main::sourceDir/$d"}{$flagFile} = 1;
$main::__prLog->print('-kind' => 'I',
'-str' => ["MARK_DIR matches <$main::sourceDir/$d> " .
"because of file <$flagFile>"]);
return 1;
}
return 0;
}
############################################################
# returns block size of first matching rule or 0
package evalInodeRuleMultiple;
sub new
{
my $class = shift;
my $self = {};
# set default values for parameters
my (%params) = ('-lines' => [], # set these three
'-blockSize' => [], # in parallel!
'-blockCompress' => [],
'-blockRead' => [],
'-blockParallel' => [],
'-keyName' => undef,# eg. includeRule
'-debug' => 0, # debug == 0: no output
# debug == 1: result per file
# debug == 2: debugging output
'-tmpdir' => '/tmp',
'-prLog' => undef
);
&::checkObjectParams(\%params, \@_, 'evalInodeRuleMultiple::new',
['-lines', '-blockSize', '-blockCompress',
'-blockRead', '-blockParallel', '-keyName',
'-prLog']);
&::setParamsDirect($self, \%params);
my $lines = $self->{'lines'};
my $blockSize = $self->{'blockSize'};
my $blockCompress = $self->{'blockCompress'};
my $blockRead = $self->{'blockRead'};
my $blockParallel = $self->{'blockParallel'};
my ($i, @evalInodeRule, %blockSize, %blockCompress, %blockRead,
%blockParallel);
@evalInodeRule = ();
foreach ($i = 0 ; $i < @$lines ; $i++)
{
my $line = $$lines[$i];
if (defined $line)
{
my $r =
evalInodeRule->new('-line' => $line,
'-keyName' => $self->{'keyName'} . $i,
'-debug' => $self->{'debug'},
'-tmpdir' => $self->{'tmpdir'},
'-prLog' => $self->{'prLog'});
push @evalInodeRule, $r;
$blockSize{$r} = $$blockSize[$i];
$blockCompress{$r} = $$blockCompress[$i];
$blockRead{$r} = $$blockRead[$i] ? $$blockRead[$i] : [];
$blockParallel{$r} = $$blockParallel[$i];
}
}
$self->{'evalInodeRule'} = \@evalInodeRule;
$self->{'blockSize'} = \%blockSize;
$self->{'blockCompress'} = \%blockCompress;
$self->{'blockRead'} = \%blockRead;
$self->{'blockParallel'} = \%blockParallel;
bless $self, $class;
}
########################################
sub checkRule
{
my $self = shift;
my ($file, $size, $mode, $ctime, $mtime, $uidn, $gidn, $type) = @_;
my $evalInodeRule = $self->{'evalInodeRule'};
my $blockSize = $self->{'blockSize'};
my $blockCompress = $self->{'blockCompress'};
my $blockRead = $self->{'blockRead'};
my $blockParallel = $self->{'blockParallel'};
my $e;
foreach $e (@$evalInodeRule)
{
if ($e->checkRule($file, $size, $mode, $ctime, $mtime, $uidn,
$gidn, $type))
{
return ($$blockSize{$e}, $$blockCompress{$e},
$$blockParallel{$e}, $$blockRead{$e});
}
}
return (0, undef, []);
}
########################################
sub setDebugFlag
{
my $self = shift;
my $evalInodeRule = $self->{'evalInodeRule'};
my $e;
foreach $e (@$evalInodeRule)
{
$e->setDebugFlag();
}
}
########################################
sub getLine
{
my $self = shift;
my $evalInodeRule = $self->{'evalInodeRule'};
my ($e, @line);
(@line) = ();
foreach $e (@$evalInodeRule)
{
push @line, (@{$e->getLine()}, '; ');
}
return \@line;
}
########################################
sub getLineString
{
my $self = shift;
return $self->getLine() ? join(' ', @{$self->getLine()}) : undef;
}
########################################
sub hasLine
{
my $self = shift;
my $evalInodeRule = $self->{'evalInodeRule'};
my $e = scalar @$evalInodeRule;
return $e;
}
##################################################
# Erzeugt und verwaltet DBM Dateien mit Informationen
# über bestehende Backup Verzeichnisse
package oldFilename;
sub new
{
my $class = shift;
my $self = {};
my (%params) = ('-dbmBaseName' => undef,
'-indexDir' => undef,
'-progressReport' => undef,
'-aktDir' => undef,
'-otherBackupSeries' => [],
'-prLog' => undef,
'-checkSumFile' => undef,
'-debugMode' => 'no',
'-saveRAM' => 0,
'-flagBlockDevice' => 0,
'-suppressInfo' => undef,
'-tmpdir' => undef
);
&::checkObjectParams(\%params, \@_, 'oldFilename::new',
['-dbmBaseName', '-indexDir',
'-otherBackupSeries',
'-prLog', '-checkSumFile', '-tmpdir']);
&::setParamsDirect($self, \%params);
my $otherBackupSeries = $self->{'otherBackupSeries'};
#print "###otherBackupSeries = <", join('><', @$otherBackupSeries), ">\n";
my $prLog = $self->{'prLog'};
my $suppressInfo = $self->{'suppressInfo'};
my $flagBlockDevice = $self->{'flagBlockDevice'};
my (%DBMfilename, %DBMmd5, %DBMblock);
$self->{'DBMfilename'} = \%DBMfilename;
$self->{'DBMmd5'} = \%DBMmd5;
$self->{'DBMblock'} = \%DBMblock;
if ($self->{'saveRAM'})
{
my ($DBMfilename, $DBMmd5, $DBMblock);
$self->{'DBMfilenameString'} = $DBMfilename =
&::uniqFileName($self->{'dbmBaseName'} . ".file.$$.");
$self->{'DBMmd5String'} = $DBMmd5 =
&::uniqFileName($self->{'dbmBaseName'} . ".md5.$$.");
$self->{'DBMblockString'} = $DBMblock =
&::uniqFileName($self->{'dbmBaseName'} . ".block.$$.");
# testen auf alter Datei und Erzeugen der beiden dbm-Files
&::checkDelSymLink($DBMfilename, $prLog, 0x01);
if (-e $DBMfilename)
{
$prLog->print('-kind' => 'W',
'-str' => ["deleting <$DBMfilename>"]);
unlink $DBMfilename or
$prLog->print('-kind' => 'E',
'-str' =>
["cannot delete <$DBMfilename>, exiting"],
'-exit' => 1);
}
dbmopen(%DBMfilename, $DBMfilename, 0600);
&::checkDelSymLink($DBMmd5, $prLog, 0x01);
if (-e $DBMmd5)
{
$prLog->print('-kind' => 'W',
'-str' => ["deleting <$DBMfilename>"]);
unlink $DBMmd5 or
$prLog->print('-kind' => 'E',
'-str' =>
["cannot delete <$DBMfilename>, exiting"],
'-exit' => 1);
}
dbmopen(%DBMmd5, $DBMmd5, 0600);
&::checkDelSymLink($DBMblock, $prLog, 0x01);
if (-e $DBMblock)
{
$prLog->print('-kind' => 'W',
'-str' => ["deleting <$DBMblock>"]);
unlink $DBMblock or
$prLog->print('-kind' => 'E',
'-str' =>
["cannot delete <$DBMblock>, exiting"],
'-exit' => 1);
}
dbmopen(%DBMblock, $DBMblock, 0600);
}
# Liste mit allen Directories erstellen
my (@backupDirs) = ($self->{'aktDir'});
push @backupDirs, @$otherBackupSeries;
$self->{'backupDirs'} = \@backupDirs;
my (@bd, $dir, %inode, $devDir);
my $dev = undef;
foreach $dir (@backupDirs)
{
unless ($dir)
{
push @bd, $dir;
next;
}
# next unless $dir; # if previous backup of own series does not exist and
# therefore stored as
#print "-1--$dir--\n";
my ($_dev, $_inode) = (stat($dir))[0,1];
if ($dev) # überprüfen, ob alle im selben device
{
if ($dev ne $_dev)
{
rmdir $self->{'aktDir'};
$prLog->print('-kind' => 'E',
'-str' => ["<$devDir> and <$dir> are " .
"not on the same device"],
'-exit' => 1);
}
}
else
{
$dev = $_dev; # merken
$devDir = $dir;
}
if (exists $inode{$_inode})
{
$prLog->print('-kind' => 'I',
'-str' => ["<$dir> is the same directory as <" .
$inode{$_inode} . ">, ignoring"]);
next;
}
else
{
$inode{$_inode} = $dir;
}
push @bd, $dir;
}
@backupDirs = @bd;
#print "backupDirs = <", join('><', @backupDirs), ">\n";
my $i;
my $noEntriesInDBM = 0;
my $noEntriesBlockCheck = 0;
for ($i = 1 ; $i < @backupDirs ; $i++)
{
my $d = $backupDirs[$i];
#print "$i -> $d\n";
next if $i == 1 and not defined $d;
if (-r "$d/.md5CheckSums.bz2" or -r "$d/.md5CheckSums")
{
my ($e1, $e2) =
&::buildDBMs('-dbmKeyIsFilename' => \%DBMfilename,
'-dbmKeyIsMD5Sum' => \%DBMmd5,
'-dbmBlockCheck' => \%DBMblock,
'-flagBlockDevice' => $flagBlockDevice,
'-indexDir' => $self->{'indexDir'},
'-backupRoot' => $d,
'-backupDirIndex' => $i,
'-noBackupDir' => scalar @backupDirs,
'-checkSumFile' => '.md5CheckSums',
'-checkSumFileVersion'
=> $main::checkSumFileVersion,
'-blockCheckSumFile' => '.md5BlockCheckSums',
'-progressReport' => $self->{'progressReport'},
'-prLog' => $prLog,
'-suppressInfo' => $suppressInfo,
'-saveRAM' => $self->{'saveRAM'},
'-dbmBaseName' => $self->{'dbmBaseName'},
'-tmpdir' => $self->{'tmpdir'});
$noEntriesInDBM += $e1;
$noEntriesBlockCheck += $e2;
}
}
$prLog->print('-kind' => 'I',
'-str' => ["$noEntriesInDBM entries in dbm files",
"$noEntriesBlockCheck entries in dbm block files"]);
bless $self, $class;
}
########################################
sub getOtherBackupSeries
{
my $self = shift;
return $self->{'otherBackupSeries'};
}
########################################
sub getDBMmd5
{
my $self = shift;
return $self->{'DBMmd5'};
}
########################################
sub getInodebackupComprCtimeMtimeSizeMD5
{
my $self = shift;
my $filename = shift;
my $DBMfilename = $self->{'DBMfilename'};
$filename = $self->{'indexDir'}->setIndex($filename);
if (exists $$DBMfilename{$filename})
{
return unpack('aIIFH32', $$DBMfilename{$filename});
}
else
{
return ();
}
}
########################################
# returns ($inodeBackup $compr $backupDirIndex $backupDir $filename)
sub getFilename
{
my $self = shift;
my $md5sum = shift;
my $DBMmd5 = $self->{'DBMmd5'};
#print "-2-$md5sum ($DBMmd5)\n";
my $md5pack = pack('H32', $md5sum);
if (exists $$DBMmd5{$md5pack})
{
#print "\tgefunden\n";
my (@r) = unpack('FaSa*', $$DBMmd5{$md5pack});
my $backupDirs = $self->{'backupDirs'};
my $f = $self->{'indexDir'}->replaceIndex($r[3]);
return (@r[0..2], $$backupDirs[$r[2]], $f);
}
return ();
}
########################################
sub getBlockFilenameCompr
{
my $self = shift;
my $md5sum = shift;
my $DBMblock = $self->{'DBMblock'};
if (exists $$DBMblock{$md5sum})
{
my ($compr, $f) = (split(/\s/, $$DBMblock{$md5sum}, 2));
my $fall = $self->{'indexDir'}->replaceIndex($f);
return ($compr, $fall);
}
return ();
}
########################################
sub setBlockFilenameCompr
{
my $self = shift;
my $md5sum = shift;
my $filename = shift;
my $compr = shift;
my ($fbase, $fname, $index) =
$self->{'indexDir'}->newFile($filename);
my $DBMblock = $self->{'DBMblock'};
$$DBMblock{$md5sum} = "$compr $index/$fname";
}
########################################
sub deleteEntry
{
my $self = shift;
my $md5sum = shift;
my $f = shift;
my $DBMmd5 = $self->{'DBMmd5'};
my $md5pack = pack('H32', $md5sum);
delete $$DBMmd5{$md5pack};
my $DBMfilename = $self->{'DBMfilename'};
$f = $self->{'indexDir'}->setIndex($f);
delete $$DBMfilename{$f};
}
########################################
sub readDBMFilesSize
{
my $self = shift;
if ($self->{'saveRAM'})
{
my $size = 0;
my $f;
foreach $f ($self->{'DBMfilenameString'}, $self->{'DBMmd5String'})
{
$main::stat->addSumDBMFiles( (stat($f))[7] );
}
}
}
########################################
sub delDBMFiles
{
my $self = shift;
if ($self->{'saveRAM'})
{
dbmclose(%{$self->{'DBMmd5'}});
dbmclose(%{$self->{'DBMfilename'}});
dbmclose(%{$self->{'DBMblock'}});
my $f1 = $self->{'DBMfilenameString'};
my $f2 = $self->{'DBMmd5String'};
my $f3 = $self->{'DBMblockString'};
$self->{'prLog'}->print('-kind' => 'I',
'-str' => ["unlink $f1, $f2, $f3"]);
unlink $f1;
unlink $f2;
unlink $f3;
}
}
############################################################
# new blocks are bufferd in memory, written to temp disk and
# transferred finally to the global hash for blocked files
# ###########!!!!!!!!!!!!!!!!! SCHREIBEN FEHLT NOCH
package manageNewBlockMD5toFilename;
sub new
{
my $class = shift;
my $self = {};
my (%params) = ('-oldFilename' => undef, # pointer to object of that class
'-dir' => undef, # identifier / path to blocked file
'-relPath' => undef, # relative path of file to save
'-prLog' => undef
);
&::checkObjectParams(\%params, \@_, 'manageNewBlockMD5toFilename::new',
['-oldFilename', '-dir', '-relPath', '-prLog']);
&::setParamsDirect($self, \%params);
#print "-1- initialize, oldFilename=<$oldFilename>, dir=<$dir>\n";
my (%md5toFilename) = (); # initialize cache
$self->{'md5toFilename'} = \%md5toFilename;
bless $self, $class;
}
########################################
sub getBlockFilename
{
my $self = shift;
my $md5sum = shift;
#print "-2- md5sum=<$md5sum>\n";
my $md5toFilename = $self->{'md5toFilename'};
if (exists $$md5toFilename{$md5sum})
{
my ($compr, $f) = (split(/\s/, $$md5toFilename{$md5sum}, 2));
#print "-2.1- f=<$f>\n";
return ($compr, $self->{'dir'} . "/$f");
}
#print "-2.2-\n";
return ($self->{'oldFilename'}->getBlockFilenameCompr($md5sum));
}
########################################
sub setBlockFilename
{
my $self = shift;
my $md5sum = shift;
my $filename = shift;
my $compr = shift;
my $md5toFilename = $self->{'md5toFilename'};
#print "-3- md5sum=<$md5sum>, filename=<$filename>, compr=<$compr>\n";
$$md5toFilename{$md5sum} = "$compr $filename";
#print "-3.1- <", $$md5toFilename{$md5sum}, ">\n";
}
############################################################
package writeBugsToFiles;
sub new
{
my $class = shift;
my $self = {};
my (%params) = ('-filePrefix' => undef,
'-backupDir' => undef,
'-prLog' => undef,
'-fileMissing' => 1,
'-md5Missing' => 1,
'-md5Wrong' => 1
);
&::checkObjectParams(\%params, \@_, 'writeBugsToFiles::new',
['-filePrefix', '-backupDir', '-prLog']);
&::setParamsDirect($self, \%params);
my $prefix = $self->{'filePrefix'};
my $prLog = $self->{'prLog'};
if ($prefix)
{
$prLog->print('-kind' => 'E',
'-str' =>
["file <${prefix}files.missing.txt> already exists"],
'-exit' => 1)
if -e "${prefix}files.missing.txt";
if ($self->{'fileMissing'})
{
local *WFT_FILES_MISSING;
open(WFT_FILES_MISSING, '>', "${prefix}files.missing.txt") or
$prLog->print('-kind' => 'E',
'-str' =>
["cannot open <${prefix}files.missing.txt>"],
'-exit' => 1);
$self->{'wft_files_missing'} = *WFT_FILES_MISSING;
}
$prLog->print('-kind' => 'E',
'-str' =>
["file <${prefix}md5sums.missing.txt> already exists"],
'-exit' => 1)
if -e "${prefix}md5sums.missing.txt";
if ($self->{'md5Missing'})
{
local *WFT_MD5SUMS_MISSING;
open(WFT_MD5SUMS_MISSING, '>', "${prefix}md5sums.missing.txt") or
$prLog->print('-kind' => 'E',
'-str' =>
["cannot open <${prefix}md5sums.missing.txt>"],
'-exit' => 1);
$self->{'wft_md5sums_missing'} = *WFT_MD5SUMS_MISSING;
}
$prLog->print('-kind' => 'E',
'-str' =>
["file <${prefix}md5sums.wrong.txt> already exists"],
'-exit' => 1)
if -e "${prefix}md5sums.wrong.txt";
if ($self->{'md5Wrong'})
{
local *WFT_MD5SUMS_WRONG;
open(WFT_MD5SUMS_WRONG, '>', "${prefix}md5sums.wrong.txt") or
$prLog->print('-kind' => 'E',
'-str' =>
["cannot open <${prefix}md5sums.wrong.txt>"],
'-exit' => 1);
$self->{'wft_md5sums_wrong'} = *WFT_MD5SUMS_WRONG;
}
}
bless $self, $class;
}
##################################################
sub print
{
my $self = shift;
my $line = shift;
my $type = shift; # 'fileMissing', 'md5Missing', 'md5Wrong'
if ($self->{'filePrefix'})
{
local *OUT;
if ($type eq 'fileMissing')
{
*OUT = $self->{'wft_files_missing'};
}
elsif ($type eq 'md5Missing')
{
*OUT = $self->{'wft_md5sums_missing'};
}
elsif ($type eq 'md5Wrong')
{
*OUT = $self->{'wft_md5sums_wrong'};
}
else
{
print STDERR
"this should never happen ($type), writeBugsToFiles::print\n";
}
$line =~ s/\\/\\5C/og; # '\\' stored as \5C
$line =~ s/\n/\\0A/sog; # '\n' stored as \0A
my $relPath = &::substractPath($line, $self->{'backupDir'});
print OUT "$relPath\n";
}
}
##################################################
sub DESTROY
{
my $self = shift;
my $prefix = $self->{'filePrefix'};
if ($prefix)
{
local *WFT_FILES_MISSING = $self->{'wft_files_missing'};
close(WFT_FILES_MISSING);
local *WFT_MD5SUMS_MISSING = $self->{'wft_md5sums_missing'};
close(WFT_MD5SUMS_MISSING);
local *WFT_MD5SUMS_WRONG = $self->{'wft_md5sums_wrong'};
close(WFT_MD5SUMS_WRONG);
}
}
##################################################
#new
# setze "Datei Fail zum schreiben auf geöffnet -> 0
# setze Datei Fail in Hash gelesen auf -> 0
#writeEntry
# 1. Aufruf:
# öffne Schreiben Datei und setze geöffnet -> 1
# 1 und alle weiteren Aufrufe: schreibe Zeile in Datei
# checksumFails
# 1. Aufruf: lade aus Datei in Hash (checksumHash). föag > 1
# 1. und alle weiteren Aufrufe: return 0/1 - Hit in Hash
#DESTROY
# schließe File für writeEntry
package missingLinks;
sub new
{
my $class = shift;
my $self = {};
my (%params) = ('-backupDir' => undef,
'-missingLinkFile' => undef,
'-missingLinkBlockFile' => undef,
'-prLog' => undef);
&::checkObjectParams(\%params, \@_, 'missingLinks:new',
['-backupDir',
'-missingLinkFile',
'-missingLinkBlockFile', '-prLog']);
&::setParamsDirect($self, \%params);
my $prLog = $self->{'prLog'};
my $backupDir = $self->{'backupDir'};
my $otherBackupSeries = $self->{'otherBackupSeries'};
# print "-0-$backupDir\n";
## my $missingLinkFile = $self->{'missingLinkFile'};
## my $missingLinkBlockFile = $self->{'missingLinkBlockFile'};
$self->{'missingLinkFileOpened'} = 0;
my $backupDir = $self->{'backupDir'};
$self->{'checksumHash'} = undef;
bless $self, $class;
}
sub writeEntry
{
my $self = shift;
my (%params) = ('-checksum' => undef,
'-file' => undef
);
&::checkObjectParams(\%params, \@_, 'missingLinks::swriteEntry',
['-checksum']);
my $checksum = $params{'-checksum'};
my $file = $params{'-file'};
my $prLog = $self->{'prLog'};
my $backupDir = $self->{'backupDir'};
my $missingLinkFile = $self->{'missingLinkFile'};
my $missingLinkBlockFile = $self->{'missingLinkBlockFile'};
# print "-1-+++++++++++++++++++\n";
unless ($self->{'missingLinkFileOpened'})
{
local *ML_FILE;
my $ml = "$backupDir/$missingLinkFile";
#print "-1-$ml\n";
if (open(ML_FILE, '>>', $ml))
{
# print "-2- opened <$ml>\n";
$self->{'missingLink_FD'} = *ML_FILE;
$self->{'missingLinkFileOpened'} = 1;
}
else
{
# print "-3-\n";
$prLog->print('-kind' => 'E',
'-str' => ["cannot open fail 2 <$ml>"]);
return 0;
}
}
local *ML_FILE = $self->{'missingLink_FD'};
print ML_FILE "$checksum $file\n";
# print "writeEntry ++++++++++++ $checksum $file\n";
return 1;
}
sub checksumFails
{
my $self = shift;
my (%params) = ('-checksum' => undef
);
&::checkObjectParams(\%params, \@_, 'missingLinks::schecksumFails',
['-checksum']);
my $checksum = $params{'-checksum'};
my $backupDir = $self->{'backupDir'};
my $prLog = $self->{'prLog'};
# print "+++++Einlesen von+++++++++++\n";
if (not defined $self->{'checksumHash'})
{
my $missingLinkFile = $self->{'missingLinkFile'};
my $fail = "$backupDir/$missingLinkFile";
# print "-0.2-$fail\n";
if (-r $fail)
{
my %checksumHash = ();
# print "-0.3-$fail\n";
local *FILE_LOAD;
if (open(FILE_LOAD, '<', $fail))
{
while (my $l = )
{
chomp $l;
my ($md5, $f) = split(/\s+/, $l, 2);
$checksumHash{$md5} = $f;
# print "l -> $l\n";
# print " -> $md5 $f\n";
}
close(FILE_LOAD);
$self->{'checksumHash'} = \%checksumHash;
}
else
{
# print "-3-\n";
$prLog->print('-kind' => 'E',
'-str' => ["cannot open fail 1 <$fail>"]);
}
}
#
}
# print "+++++Einlesen bis+++++++++++\n";
my $checksumHash = $self->{'checksumHash'};
# print "+++++Ausgaben von+++++++++++\n";
foreach my $a (keys %$checksumHash)
{
my $b = $$checksumHash{$a};
# print "$a --> $b\n";
}
# print "+++++Ausgaben bis+++++++++++\n";
if (exists $$checksumHash{$checksum})
{
# print "$checksum MATCHES!\n";
return 1;
}
else
{
# print "$checksum doesnt matche\n";
return 0;
}
}
sub DESTROY
{
my $self = shift;
# print "-4-\n";
if ($self->{'missingLinkFileOpened'})
{
# print "-5-\n";
*ML_FILE = $self->{'missingLink_FD'};
close(ML_FILE);
}
}
1