#! /usr/bin/env perl

#
#   Copyright (C) Dr. Heinz-Josef Claes (2008-2012)
#                 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 <http://www.gnu.org/licenses/>.
#


use POSIX;
use strict;
use warnings;

use Fcntl qw(O_RDWR O_CREAT);
use POSIX;

my $VERSION = '$Id: storeBackupUpdateBackup.pl 344 2008-08-26 10:47:23Z hjc $ ';
our @VERSION;
push @VERSION, $VERSION;
my ($VERSIONpName, $VERSIONsvnID) = $VERSION =~ /Id:\s+(\S+)\s+(\d+)/;
$main::STOREBACKUPVERSION = undef;


sub libPath
{
    my $file = shift;

    my $dir;

    # Falls Datei selbst ein symlink ist, solange folgen, bis aufgelöst
    if (-f $file)
    {
	while (-l $file)
	{
	    my $link = readlink($file);

	    if (substr($link, 0, 1) ne "/")
	    {
		$file =~ s/[^\/]+$/$link/;
	    }
	    else
	    {
		$file = $link;
	    }
	}

	($dir, $file) = &splitFileDir($file);
	$file = "/$file";
    }
    else
    {
	print STDERR "<$file> does not exist!\n";
	exit 1;
    }

    $dir .= "/../lib";           # Pfad zu den Bibliotheken
    my $oldDir = `/bin/pwd`;
    chomp $oldDir;
    if (chdir $dir)
    {
	my $absDir = `/bin/pwd`;
	chop $absDir;
	chdir $oldDir;

	return (&splitFileDir("$absDir$file"));
    }
    else
    {
	print STDERR "<$dir> does not exist, exiting\n";
    }
}
sub splitFileDir
{
    my $name = shift;

    return ('.', $name) unless ($name =~/\//);    # nur einfacher Dateiname

    my ($dir, $file) = $name =~ /^(.*)\/(.*)$/s;
    $dir = '/' if ($dir eq '');                   # gilt, falls z.B. /filename
    return ($dir, $file);
}
my ($req, $prog) = &libPath($0);
(@INC) = ($req, @INC);

require 'storeBackupLib.pl';
require 'checkParam2.pl';
require 'checkObjPar.pl';
require 'prLog.pl';
require 'version.pl';
require 'dateTools.pl';
require 'fileDir.pl';
require 'humanRead.pl';

my $lockFile = '/tmp/storeBackup.lock';   # default value
my $checkSumFile = '.md5CheckSums';
my $blockCheckSumFile = '.md5BlockCheckSums';

=head1 NAME

storeBackupUpdateBackup.pl - updates / finalizes backups created by storeBackup.pl with option --lateLink, --lateCompress

=head1 SYNOPSIS

	storeBackupUpdateBackup.pl -b backupDirectory [--autorepair]
	      [--print] [--verbose] [--debug] [--lockFile] [--noCompress]
	      [--progressReport number] [--checkOnly]
	      [--logFile
	       [--suppressTime] [-m maxFilelen]
	       [[-n noOfOldFiles] | [--saveLogs]]
	       [--compressWith compressprog]] 

	storeBackupUpdateBackup.pl --interactive --backupDir topLevlDir
	      [--autorepair] [--print]

=head1 WARNING

  !!! USAGE IN PARALLEL WITH storeBackup.pl CAN DESTROY YOUR BACKUPS !!!

=head1 OPTIONS

=over 8

=item B<--interactive>, B<-i>

    interactive mode for reparing / deleting currupted
    backups created with option '--lateLinks'

=item B<--backupDir>, B<-b>

    top level directory of all backups (must exist)

=item B<--autorepair>, B<-a>

    repair simple inconsistencies automatically without
    requesting the action

=item B<--print>

    print configuration read from configuration file and stop

=item B<--verbose>, B<-v>

    verbose messages

=item B<--debug>, B<-d>

    generate detailed information about the files
    with the linking information in it

=item B<--lockFile>, B<-L>

    lock file, if exist, new instances will finish if
    an old is already running
    If set to the same file as in storeBackup it will
    prevent $prog from running in parallel
    to storeBackup, default is $lockFile

=item B<--noCompress>

    maximal number of parallel compress operations,
    default = chosen automatically

=item B<--checkOnly> B<-c>

    do not perform any action, only check consistency

=item B<--progressReport>

    print progress report:

=over 4

=item after each 'number' files when compressing

=item after each 'number * 1000' files when linking

=item after each 'number * 10000' files when performing chmod

=back

=item B<--logFile>, B<-l>

    logFile, Default: stdout

=item B<--suppressTime>

    suppress output of time in logfile

=item B<--maxFilelen>, B<-m>

    maximal length of log file, default = 1e6

=item B<--noOfOldFiles>, B<-n>

    number of old log files, default = 5

=item B<--saveLogs>

    save log files with date and time instead of deleting the
    old (with [-noOldFiles])

=item B<--compressWith>

    compress saved log files (e.g. with 'gzip -9').
    default is 'bzip2'

=back

=head1 COPYRIGHT

Copyright (c) 2008,2012 by Heinz-Josef Claes.
Published under the GNU General Public License v3 or any later version

=cut

my $Help = join('', grep(!/^\s*$/, `pod2text $0`));
$Help = "cannot find pod2text, see documentation for details\n"
    unless $Help;

&printVersions(\@ARGV, '-V');

my $startDate = dateTools->new();
my $CheckPar =
    CheckParam->new('-list' => [Option->new('-name' => 'backupDir',
					    '-cl_option' => '-b',
					    '-cl_alias' => '--backupDir',
					    '-must_be' => 'yes',
					    '-param' => 'yes'),
				Option->new('-name' => 'autorepair',
					    '-cl_option' => '--autorepair',
					    '-cl_alias' => '-a'),
                                Option->new('-name' => 'print',
					    '-cl_option' => '--print'),
				Option->new('-name' => 'interactive',
					    '-cl_option' => '-i',
					    '-cl_alias' => '--interactive'),
				Option->new('-name' => 'lockFile',
					    '-cl_option' => '-L',
                                            '-cl_alias' => '--lockFile',
					    '-only_if' => 'not [interactive]',
                                            '-default' => $lockFile),
				Option->new('-name' => 'noCompress',
					    '-cl_option' => '--noCompress',
					    '-param' => 'yes',
					    '-pattern' => '\A[1-9]\d*\Z'),
				Option->new('-name' => 'checkOnly',
					    '-cl_option' => '-c',
					    '-cl_alias' => '--checkOnly',
					    '-only_if' => 'not [interactive]'),
				Option->new('-name' => 'progressReport',
					    '-cl_option' => '--progressReport',
					    '-default' => 0,
					    '-pattern' => '\A\d+\Z'),
				Option->new('-name' => 'verbose',
					    '-cl_option' => '-v',
					    '-only_if' => 'not [interactive]',
					    '-cl_alias' => '--verbose'),
				Option->new('-name' => 'debug',
					    '-cl_option' => '--debug',
					    '-cl_option' => '-d',
					    '-only_if' => 'not [interactive]'),
				Option->new('-name' => 'logFile',
					    '-cl_option' => '-l',
					    '-cl_alias' => '--logFile',
					    '-param' => 'yes',
					    '-only_if' => 'not [interactive]'),
				Option->new('-name' => 'suppressTime',
					    '-cl_option' => '--suppressTime'),
				Option->new('-name' => 'maxFilelen',
					    '-cl_option' => '-m',
					    '-cl_alias' => '--maxFilelen',
					    '-default' => 1e6,
					    '-pattern' => '\A[e\d]+\Z',
                                            '-only_if' =>"[logFile]"),
				Option->new('-name' => 'noOfOldFiles',
					    '-cl_option' => '-n',
					    '-cl_alias' => '--noOfOldFiles',
					    '-default' => '5',
					    '-pattern' => '\A\d+\Z',
                                            '-only_if' =>"[logFile]"),
                                Option->new('-name' => 'saveLogs',
					    '-cl_option' => '--saveLogs',
                                            '-default' => 'no',
                                            '-only_if' => "[logFile]"),
                                Option->new('-name' => 'compressWith',
					    '-cl_option' => '--compressWith',
					    '-quoteEval' => 'yes',
                                            '-default' => 'bzip2',
                                            '-only_if' =>"[logFile]")
				]
		    );

$CheckPar->check('-argv' => \@ARGV,
                 '-help' => $Help
                 );

# Auswertung der Parameter
my $autorepair = $CheckPar->getOptWithoutPar('autorepair');
my $print = $CheckPar->getOptWithoutPar('print');
my $interactive = $CheckPar->getOptWithoutPar('interactive');
my $verbose = $CheckPar->getOptWithoutPar('verbose');
my $debug = $CheckPar->getOptWithoutPar('debug');
$lockFile = $CheckPar->getOptWithPar('lockFile');
my $noCompress = $CheckPar->getOptWithPar('noCompress');
my $checkOnly = $CheckPar->getOptWithoutPar('checkOnly');
my $progressReport = $CheckPar->getOptWithPar('progressReport');
my $logFile = $CheckPar->getOptWithPar('logFile');
my $withTime = not $CheckPar->getOptWithoutPar('suppressTime');
$withTime = $withTime ? 'yes' : 'no';
my $maxFilelen = $CheckPar->getOptWithPar('maxFilelen');
my $noOfOldFiles = $CheckPar->getOptWithPar('noOfOldFiles');
my $saveLogs = $CheckPar->getOptWithPar('saveLogs');
my $compressWith = $CheckPar->getOptWithPar('compressWith');
my (@backupDirs) = $CheckPar->getOptWithPar('backupDir');

unless ($noCompress)
{
    local *FILE;
    if (open(FILE, "/proc/cpuinfo"))
    {
	my $l;
	$noCompress = 1;
	while ($l = <FILE>)
	{
	    $noCompress++ if $l =~ /processor/;
	}
	close(FILE);
    }
    $noCompress = 2 if $noCompress < 2;
}

if ($print)
{
    $CheckPar->print();
    exit 0;
}

if ($interactive)
{
    $verbose = 1;
    $debug = 1;
}


if ($interactive)
{
    my $answer;
    do
    {
	print "\nBefore trying to repair any damages of the backup\n",
	"you should make a backup of the files beeing manipulated by\n",
	"this program. Do this by eg. executing\n",
	"# tar cf /savePlace.tar <backup-dirs>/..storeBackupLinks\n",
	"for all affected backup directories or simply all of your backups.\n",
	"continue?\n",
	"yes / no  -> ";
	$answer = <STDIN>;
	chomp $answer;
    } while ($answer ne 'yes' and $answer ne 'no');

    exit 0
	if $answer eq 'no';
}


my (@par) = ();
if (defined $logFile)
{
    push @par, ('-file' => $logFile,
		'-multiprint' => 'yes');
}
else
{
    push @par, ('-filedescriptor', *STDOUT);
}

my ($prLogKind) = ['A:BEGIN',
		   'Z:END',
		   'V:VERSION',
		   'I:INFO',
		   'W:WARNING',
		   'E:ERROR',
		   'P:PROGRESS',
		   'S:STATISTIC',
		   'D:DEBUG'];
my $prLog = printLog->new('-kind' => $prLogKind,
			  @par,
			  '-withTime' => $withTime,
			  '-maxFilelen' => $maxFilelen,
			  '-noOfOldFiles' => $noOfOldFiles,
			  '-saveLogs' => $saveLogs,
			  '-compressWith' => $compressWith);

$prLog->print('-kind' => 'A',
	      '-str' => ["checking references in <@backupDirs>"]);
$prLog->print('-kind' => 'V',
	      '-str' => ["$VERSIONpName, $main::STOREBACKUPVERSION, " .
			 "build $VERSIONsvnID"]);

::checkLockFile($lockFile, $prLog);

my $allLinks = lateLinks->new('-dirs' => \@backupDirs,
			      '-kind' => 'recursiveSearch',
			      '-checkLinkFromConsistency' => 1,
			      '-verbose' => $verbose,
			      '-debug' => $debug,
			      '-prLog' => $prLog,
			      '-interactive' => $interactive,
			      '-autorepair' => $autorepair);

if ($checkOnly)
{
    unlink $lockFile;
    exit 0;
}

if ($interactive)
{
    my $answer;
    do
    {
	print "\ncontinue with updating the backup(s)?\n",
	"(compressing and setting hard links)\n",
	"yes / no  -> ";
	$answer = <STDIN>;
	chomp $answer;
    } while ($answer ne 'yes' and $answer ne 'no');

    exit 0
	if $answer eq 'no';
}

#
# set links and compress files
#
my $updateDirFlag = 0;
my (@lateLinkDirs);
while (((@lateLinkDirs) = $allLinks->getAllDirsWithLateLinks()) > 0)
{
    my $d;
    foreach $d (sort @lateLinkDirs)
    {
	my $linkToHash = $allLinks->getLinkToHash();
	my $linkFromHash = $allLinks->getLinkFromHash();

#       print "checking <$d>\n";
       if (-e "$d/.storeBackupLinks/linkFile.bz2")
       {
#	   print "\t$d/.storeBackupLinks/linkFile.bz2 exists\n";
	   my $linkToDir;
	   my $needsUpdate = 0;
	   my $hash = $$linkToHash{$d};
	   foreach $linkToDir (sort keys %$hash)
	   {
#	       print "\t\tchecking $linkToDir for linkFile.bz2: ";
	       if (-e "$linkToDir/.storeBackupLinks/linkFile.bz2")
	       {
		   $needsUpdate = 1;
#		   print "needs Update!\n";
		   last;
	       }
	       else
	       {
#		   print "ok, is updated\n";
	       }
	   }
	   if ($needsUpdate == 0)
	   {
#	       print "update $d\n";
	   }
	   else
	   {
	       next;
	   }
       }
       else
       {
	   next;
       }

	$updateDirFlag = 1;
	::updateBackupDir($d, $noCompress, $progressReport, $prLog,
			  $interactive);

	# delete processed files
	my $f = "$d/.storeBackupLinks/linkFile.bz2";
	if ((unlink $f) != 1)
	{
	    $prLog->print('-kind' => 'E',
			  '-str' => ["1 cannot delete <$f>"]);
	}
	else
	{
	    $prLog->print('-kind' => 'I',
			  '-str' => ["1 deleted <$f>"])
		if $verbose;
	}

	$f = "$d/.storeBackupLinks/linkTo";
	if (-e $f)
	{
	    if ((unlink $f) != 1)
	    {
		$prLog->print('-kind' => 'E',
			      '-str' => ["2 cannot delete <$f>"]);
	    }
	    else
	    {
		$prLog->print('-kind' => 'I',
			      '-str' => ["2 deleted <$f>"])
		    if $verbose;
	    }
	}

#	print "delete linkTo:\n";
#       print "\t$d:\n";
        my $k;
	my $hash = $$linkToHash{$d};
	foreach $k (sort keys %$hash)
	{
	    $f = $$hash{$k};
#	    print "\t\t$k -> ", $$hash{$k}, "\n";

	    if (-e $f)
	    {
		if ((unlink $f) != 1)
		{
		    $prLog->print('-kind' => 'E',
				  '-str' => ["3 cannot delete <$f>"]);
		}
		else
		{
		    $prLog->print('-kind' => 'I',
				  '-str' => ["3 deleted <$f>"])
			if $verbose;
		}
	    }

	    $f = $$linkFromHash{$k}{$d};
#	    print "delete linkFrom: <$f>\n";
	    if ((unlink $f) != 1)
	    {
		$prLog->print('-kind' => 'E',
			      '-str' => ["3 cannot delete <$f>"]);
	    }
	    else
	    {
		$prLog->print('-kind' => 'I',
			      '-str' => ["3 deleted <$f>"])
		    if $verbose;
	    }
	    
	}

        goto nextLoop;
    }

nextLoop:

    $allLinks = lateLinks->new('-dirs' => \@backupDirs,
			       '-kind' => 'recursiveSearch',
			       '-checkLinkFromConsistency' => 1,
			       '-verbose' => $verbose,
			       '-debug' => $debug,
			       '-prLog' => $prLog,
			       '-interactive' => $interactive);

}

$prLog->print('-kind' => 'I',
	      '-str' => ["everything is updated, nothing to do"])
    unless $updateDirFlag;


# Statistik über Dauer und CPU-Verbrauch

my (@l);
my ($user,$system,$cuser,$csystem) = times;
my ($trenn) = "-------+----------+----------";
push @l, sprintf("%-7s|%10s|%10s", " [sec]", "user", "system");
push @l, "$trenn";
push @l, sprintf("%-7s|%10.2f|%10.2f", "process", $user, $system);
push @l, sprintf("%-7s|%10.2f|%10.2f", "childs", $cuser, $csystem);
push @l, "$trenn";
my ($u, $s) = ($cuser + $user, $csystem + $system);
push @l, sprintf("%-7s|%10.2f|%10.2f => %.2f", "sum", $u, $s, $u + $s);

my (@startDate) = ();
if ($startDate)
{
    push @startDate, '           precommand duration = ' .
	$startDate->deltaInStr('-secondDate' => $startDate);
}

my $dEnd = dateTools->new();
my $duration = $startDate->deltaInSecs('-secondDate' => $dEnd);
$duration = 1 if ($duration == 0);   # Minimaler Wert

$prLog->print('-kind' => 'S',
	      '-str' =>
	      ['                      duration = ' .
	       dateTools::valToStr('-sec' => $duration),
	       @l
	       ]);

unlink $lockFile;

$prLog->print('-kind' => 'I',
	      '-str' => ["syncing ..."]);
system "/bin/sync";

$prLog->print('-kind' => 'Z',
	      '-str' => ["checking references in <@backupDirs>"]);

exit 0;



############################################################
sub updateBackupDir
{
    my $dir = shift;
    my $noCompress = shift;
    my $progressReport = shift;
    my $prLog = shift;
    my $interactive = shift;

    #
    # read compress from .md5CheckSum.info
    #
    $prLog->print('-kind' => 'I',
		  '-str' => ["updating <$dir>"]);

    my $rcsf = readCheckSumFile->new('-checkSumFile' =>
				     "$dir/.md5CheckSums",
				     '-prLog' => $prLog);

#    my $meta = $rcsf->getMetaValField();

#    my ($compr, @comprPar) = @{$$meta{'compress'}};
#    my $comprPostfix = ($$meta{'postfix'})->[0];
    my ($compr, @comprPar) = @{$rcsf->getInfoWithPar('compress')};
    my $comprPostfix = $rcsf->getInfoWithPar('postfix');
#print "compr = <$compr>, comprPar = <@comprPar>\n";

    #
    # set links and compress
    #
    my (%md5ToFile);      # store md5sums of copied files because
                          # number of links is exhausted
    my $f = "$dir/.storeBackupLinks/linkFile.bz2";

    return unless -e $f;

    #
    #
    #
    $prLog->print('-kind' => 'I',
		  '-str' => ["phase 1: mkdir, symlink and compressing files"]);

    my $l;
    my $parForkProc = parallelFork->new('-maxParallel' => $noCompress,
					'-prLog' => $prLog,
					'-firstFast' => 1,
					'-maxWaitTime' => .2,
					'-noOfWaitSteps' => 100);

    my $noCompressedFiles = 0;
    my $noMkdir = 0;
    my $noSymLink = 0;
    my ($oldSize, $newSize) = (0, 0);
    my $linkFile = pipeFromFork->new('-exec' => 'bzip2',
				     '-param' => ['-d'],
				     '-stdin' => $f,
				     '-outRandom' => '/tmp/stbuPipeFrom10-',
				     '-prLog' => $prLog);

    while ($l = $linkFile->read())
    {
	next if $l =~ /^#/;
	chomp $l;
	my ($what, $md5) = split(/\s+/, $l, 2);

	if ($what eq 'dir')
	{
	    $md5 =~ s/\0/\n/og;    # name of directory!
	    unless (-d "$dir/$md5")
	    {
		$prLog->print('-kind' => 'E',
			      '-str' =>
			      ["cannot create directory <$dir/$md5>"],
			      '-exit' => 1)
		    unless mkdir "$dir/$md5", 0700;
	    }
	    $noMkdir++;
	}
	elsif ($what eq 'link' or $what eq 'linkblock' or
	    $what eq 'linkSymlink')
	{
	    my $existingFile = $linkFile->read();
	    $existingFile = "$dir/$existingFile";
	    $prLog->print('-kind' => 'E',
			  '-str' =>
			  ["file <$f> ends unexpected at line $."],
			  '-exit' => 1)
		unless $existingFile;

	    my $newLink = $linkFile->read();
	    $prLog->print('-kind' => 'W',
			  '-str' =>
			  ["file <$f> ends unexpected at line $."],
			  '-exit' => 1)
		unless $newLink;
	} 
	elsif ($what eq 'symlink')
	{
	    $md5 =~ s/\0/\n/og;     # file (not md5sum)
	    $md5 = "$dir/$md5";
	    my $target = $linkFile->read();
	    $prLog->print('-kind' => 'E',
			  '-str' =>
			  ["file <$f> ends unexpected at line $."],
			  '-exit' => 1)
		unless $target;
	    chomp $target;
	    $target =~ s/\0/\n/og;
	    $prLog->print('-kind' => 'E',
			  '-str' =>
			  ["cannot create symlink from <$md5> -> <$target>"])
		unless symlink $target, $md5;
	    $noSymLink++;
	}
	elsif ($what eq 'compress')
	{
	    my $file = $linkFile->read();
	    $prLog->print('-kind' => 'E',
			  '-str' =>
			  ["file <$f> ends unexpected at line $."],
			  '-exit' => 1)
		unless $file;
	    chomp $file;

	    $file =~ s/\0/\n/og;
	    $file = "$dir/$file";        # file to compress
	    my $st = (stat($file))[7];
	    $oldSize += $st if defined $st;
	    my ($old, $new) =
		$parForkProc->add_block('-exec' => $compr,
					'-param' => \@comprPar,
					'-outRandom' => '/tmp/bzip2-',
					'-stdin' => $file,
					'-stdout' => "$file$comprPostfix",
					'-delStdout' => 'no',
					'-info' => $file);
	    if ($old)
	    {
		$noCompressedFiles++;
		$prLog->print('-kind' => 'S',
			      '-str' => ["compressed $noCompressedFiles files"])
		    if ($progressReport and
			$noCompressedFiles % $progressReport == 0);

		my $f = $old->get('-what' => 'info');
		&::waitForFile("$f$comprPostfix");
		$newSize += (stat("$f$comprPostfix"))[7];
		my $out = $old->getSTDERR();
		$prLog->print('-kind' => 'E',
			      '-str' => ["STDERR of <$compr @comprPar " .
					 "<$f >$f$comprPostfix>:", @$out])
		    if (@$out > 0);
		$prLog->print('-kind' => 'E',
			      '-str' => ["cannot delete <$f>"])
		    if (unlink $f) != 1;
	    }
	}
	else
	{
	    $prLog->print('-kind' => 'E',
			  '-str' => ["illegal keyword <$what> " .
				     "at line $. in file <$f>:",
				     "\t<$l>"],
			  '-exit' => 1);
	}
    }
    $linkFile->wait();
    my $out = $linkFile->getSTDERR();
    if (@$out)
    {
	$prLog->print('-kind' => 'E',
		      '-str' => ["reading linkFile file reports errors:",
				 @$out]);
	exit 1;
    }
    $linkFile->close();
    my $old;
    while ($old = $parForkProc->waitForAllJobs())
    {
	$noCompressedFiles++;
	&::waitForFile("$f$comprPostfix");
 	my $f = $old->get('-what' => 'info');
	$newSize += (stat("$f$comprPostfix"))[7];
	my $out = $old->getSTDERR();
	$prLog->print('-kind' => 'E',
		      '-str' => ["STDERR of <$compr @comprPar " .
				 "<$f >$f$comprPostfix>:", @$out])
	    if (@$out > 0);
	$prLog->print('-kind' => 'E',
		      '-str' => ["cannot delete <$f>"])
	    if (unlink $f) != 1;
    }

    $prLog->print('-kind' => 'S',
		  '-str' => ["created $noMkdir directories",
			     "created $noSymLink symbolic links",
			     "compressed $noCompressedFiles files",
			     "used " . (&::humanReadable($newSize))[0] .
			     " instead of " . (&::humanReadable($oldSize))[0] .
			     " ($newSize <- $oldSize)"]);

    #
    # set hard links
    #
    $prLog->print('-kind' => 'I',
		  '-str' => ["phase 2: setting hard links"]);

    my $withBlockedFiles = 0;
    my $noHardLinks = 0;
    my $noCopiedFiles = 0;
    my $pr = $progressReport * 200;
    $linkFile = pipeFromFork->new('-exec' => 'bzip2',
				  '-param' => ['-d'],
				  '-stdin' => $f,
				  '-outRandom' => '/tmp/stbuPipeFrom11-',
				  '-prLog' => $prLog);

    local *BLOCKMD5;
    if (-e "$dir/.md5BlockCheckSums")
    {
	$withBlockedFiles = 1;
	open(BLOCKMD5, ">>", "$dir/.md5BlockCheckSums") or
	    $prLog->print('-kind' => 'E',
			  '-str' =>
			  ["cannot append to <$dir/.md5BlockCheckSums>"],
			  '-exit' => 1);
    }

    while ($l = $linkFile->read())
    {
	next if $l =~ /^#/;
	chomp $l;
	my ($what, $md5) = split(/\s+/, $l, 2);
	my $lineNr = $linkFile->get('-what' => 'lineNr');
	if ($what eq 'link')
	{
	    my $existingFile = $linkFile->read();
	    $existingFile = "$dir/$existingFile";
	    $prLog->print('-kind' => 'E',
			  '-str' => ["file <$f> ends unexpected at line $lineNr"],
			  '-exit' => 1)
		unless $existingFile;
	    chomp $existingFile;
	    $existingFile =~ s/\0/\n/og;

	    my $newLink = $linkFile->read();
	    $prLog->print('-kind' => 'E',
			  '-str' => ["file <$f> ends unexpected at line $lineNr"],
			  '-exit' => 1)
		unless $newLink;
	    chomp $newLink;
	    $newLink =~ s/\0/\n/og;
	    $newLink = "$dir/$newLink";
	    $existingFile = $md5ToFile{$md5} if exists $md5ToFile{$md5};
	    if (link $existingFile, $newLink)
	    {
		$noHardLinks++;
		$prLog->print('-kind' => 'S',
			      '-str' => ["linked $noHardLinks files"])
			if ($pr and $noHardLinks % $pr == 0);
	    }
	    else
	    {
		# copy file
                unless (::copyFile("$existingFile", "$newLink"))
                {
                    $prLog->print('-kind' => 'E',
                                  '-str' => ["could not link/copy " .
					     "$existingFile $newLink"]);
                    next;
                }
		$noCopiedFiles++;
		$md5ToFile{$md5} = $newLink;
	    }
	}
	elsif ($what eq 'dir')
	{
	}
	elsif ($what eq 'compress' or $what eq 'symlink')
	{
	    my $file = $linkFile->read();
	    $prLog->print('-kind' => 'E',
			  '-str' => ["file <$f> ends unexpected at line $lineNr"],
			  '-exit' => 1)
		unless $file;
	}
	elsif ($what eq 'linkSymlink')
	{
	    my $existingFile = $linkFile->read();
	    $existingFile = "$dir/$existingFile";
	    $prLog->print('-kind' => 'E',
			  '-str' => ["file <$f> ends unexpected at line $lineNr"],
			  '-exit' => 1)
		unless $existingFile;
	    chomp $existingFile;
	    $existingFile =~ s/\0/\n/og;

	    my $newLink = $linkFile->read();
	    $prLog->print('-kind' => 'E',
			  '-str' => ["file <$f> ends unexpected at line $lineNr"],
			  '-exit' => 1)
		unless $newLink;
	    chomp $newLink;
	    $newLink =~ s/\0/\n/og;
	    $newLink = "$dir/$newLink";
	    if (link $existingFile, $newLink)
	    {
		$noHardLinks++;
		$prLog->print('-kind' => 'S',
			      '-str' => ["linked $noHardLinks files"])
			if ($pr and $noHardLinks % $pr == 0);
	    }
	    else
	    {
		# create symlink
		$prLog->print('-kind' => 'E',
			      '-str' =>
			      ["cannot create symlink from <$newLink> -> <$md5>"])
		unless symlink $md5, $newLink;
	    $noSymLink++;
	    }
	}
	elsif ($what eq 'linkblock')
	{
	    my $existingFile = $linkFile->read();
	    $existingFile = "$dir/$existingFile";
	    $prLog->print('-kind' => 'E',
			  '-str' => ["file <$f> ends unexpected at line $lineNr"],
			  '-exit' => 1)
		unless $existingFile;
	    chomp $existingFile;
	    $existingFile =~ s/\0/\n/og;

	    my $newLink = $linkFile->read();
	    $newLink = "$dir/$newLink";
	    $prLog->print('-kind' => 'E',
			  '-str' => ["file <$f> ends unexpected at line $lineNr"],
			  '-exit' => 1)
		unless $newLink;
	    chomp $newLink;
	    $newLink =~ s/\0/\n/og;

	    $noHardLinks +=
		&::hardLinkDir($existingFile, $newLink, '\A\d.*', $prLog);

	    my $blockLocal =
		pipeFromFork->new('-exec' => 'bzip2',
				  '-param' => ['-d'],
				  '-stdin' => "$newLink/.md5BlockCheckSums.bz2",
				  '-outRandom' => '/tmp/stbuPipeFrom12-',
				  '-prLog' => $prLog);

	    my $l;
	    while ($l = $blockLocal->read())
	    {
		print BLOCKMD5 $l;
	    }
	    $blockLocal->wait();
	    my $out = $blockLocal->getSTDERR();
	    if (@$out)
	    {
		$prLog->print('-kind' => 'E',
			      '-str' => ["reading linkFile file reports errors:",
					 @$out]);
		exit 1;
	    }
	    $blockLocal->close();
	}
	else
	{
	    $prLog->print('-kind' => 'E',
			  '-str' => ["illegal keyword <$what> " .
				     "at line $lineNr in file <$f>:",
			             "\t<$l>"],
			  '-exit' => 1);
	}

    }
    if ($withBlockedFiles)
    {
	close(BLOCKMD5) or
	    $prLog->print('-kind' => 'E',
			  '-str' =>
			  ["cannot close file <$dir/.md5BlockCheckSums>"],
			  '-exit' => 1);
    }
    $linkFile->wait();
    $out = $linkFile->getSTDERR();
    if (@$out)
    {
	$prLog->print('-kind' => 'E',
		      '-str' => ["reading linkFile file reports errors:",
				 @$out]);
	exit 1;
    }
    $linkFile->close();
    $prLog->print('-kind' => 'S',
		  '-str' => ["linked $noHardLinks files"]);
    $prLog->print('-kind' => 'S',
		  '-str' => ["copied $noCopiedFiles files"])
	if $noCopiedFiles;

    my $comprMd5BlockCheckSums;
    if ($withBlockedFiles and -e "$dir/.md5CheckSums.bz2")
    {
	# compress .md5BlockCheckSums
	$comprMd5BlockCheckSums =
	    forkProc->new('-exec' => 'bzip2',
			  '-param' => ["$dir/.md5BlockCheckSums"],
			  '-outRandom' =>
			  '/tmp/stbu-compr-',
			  '-prLog' => $prLog);
    }

    #
    # set file permissions
    #
    my $preservePerms =
	$rcsf->getInfoWithPar('preservePerms') eq 'no' ? 0 : 1;
#	(($$meta{'preservePerms'})->[0] eq 'no') ? 0 : 1;
    $pr = $progressReport * 2000;
    if ($preservePerms)
    {
	$prLog->print('-kind' => 'I',
		      '-str' => ["phase 3: setting file permissions"]);
#	my $comprPostfix = ($$meta{'postfix'})->[0];
	my $comprPostfix = $rcsf->getInfoWithPar('postfix');

	my $noFiles = 0;
	my $rcsf = readCheckSumFile->new('-checkSumFile' => "$dir/.md5CheckSums",
					 '-prLog' => $prLog);
	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)
	{
	    my $file = "$dir/$f";
	    next if ($md5sum eq 'dir');

	    $file .= $comprPostfix if $compr eq 'c';

	    if (not -l $file and not -e $file)
	    {
		$prLog->print('-kind' => 'E',
			      '-str' => ["cannot acces <$file>"]);
		next;
	    }
	    $noFiles++;
	    $prLog->print('-kind' => 'S',
			  '-str' => ["set permissions of $noFiles files"])
			if ($pr and $noFiles % $pr == 0);

	    next if $md5sum eq 'symlink';

	    utime $atime, $mtime, $file;
	    chown $uid, $gid, $file;
	    if ($compr eq 'b')         # block file
	    {
		$mode &= 0777;    # strip special permissions
		$mode |= 0111;    # add directory permissions
	    }
	    chmod $mode, $file;
	}

	$prLog->print('-kind' => 'S',
		      '-str' => ["set permissions for $noFiles files"]);
    }
    else
    {
	$prLog->print('-kind' => 'I',
		      '-str' => ["phase 3: file permissions not set because " .
				 "preservePerms not set in storeBackup.pl"]);
    }

    if ($withBlockedFiles and -e "$dir/.md5CheckSums.bz2")
    {
	# compress .md5BlockCheckSums
	$comprMd5BlockCheckSums->wait();
	my $out = $comprMd5BlockCheckSums->getSTDOUT();
	$prLog->print('-kind' => 'W',
		      '-str' => ["STDERR of <uname>:", @$out])
	    if (@$out > 0);
	$out = $comprMd5BlockCheckSums->getSTDERR();
	$prLog->print('-kind' => 'E',
		      '-str' => ["STDERR of <uname>:", @$out])
	    if (@$out > 0);
    }

    #
    # set directory permissions
    #
    if ($preservePerms)
    {
	$prLog->print('-kind' => 'I',
		      '-str' => ["phase 4: setting directory permissions"]);
#	my $comprPostfix = ($$meta{'postfix'})->[0];
	my $comprPostfix = $rcsf->getInfoWithPar('postfix');

	my $noDirs = 0;
	my $rcsf = readCheckSumFile->new('-checkSumFile' => "$dir/.md5CheckSums",
					 '-prLog' => $prLog);
	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)
	{
	    my $file = "$dir/$f";
	    if ($md5sum eq 'dir')
	    {
		unless (-e $file)
		{
		    $prLog->print('-kind' => 'E',
				  '-str' => ["cannot acces <$file>"]);
		    next;
		}
		chown $uid, $gid, $file;
		chmod $mode, $file;
		utime $atime, $mtime, $file;

		$noDirs++;
		$prLog->print('-kind' => 'S',
			  '-str' => ["set permissions of $noDirs directories"])
			if ($pr and $noDirs % $pr == 0);
	    }
	}

	$prLog->print('-kind' => 'S',
		      '-str' => ["set permissions for $noDirs directories"]);
    }
    else
    {
	$prLog->print('-kind' => 'I',
		      '-str' => ["phase 4: directory permissions not set because " .
				 "preservePerms not set in storeBackup.pl"]);
    }

}