#! /usr/bin/env perl

#
#   Copyright (C) Dr. Heinz-Josef Claes (2002-2009)
#                 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/>.
#


my $VERSION = '$Id: storeBackupRecover.pl 360 2009-05-22 21:04:50Z hjc $ ';
push @VERSION, $VERSION;
my ($VERSIONpName, $VERSIONsvnID) = $VERSION =~ /Id:\s+(\S+)\s+(\d+)/;
$main::STOREBACKUPVERSION = undef;


use strict;
use DB_File;           # Berkeley DB version 1


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);
push @INC, "$req";

require 'checkParam2.pl';
require 'checkObjPar.pl';
require 'prLog.pl';
require 'version.pl';
require 'fileDir.pl';
require 'forkProc.pl';
require 'storeBackupLib.pl';


my $md5CheckSumVersion = '1.1';
my $noRestoreParallel = 12;
my $checkSumFile = '.md5CheckSums';

my $tmpdir = '/tmp';              # default value
$tmpdir = $ENV{'TMPDIR'} if defined $ENV{'TMPDIR'};

=head1 NAME

storeBackupRecover.pl - recovers files saved with storeBackup.pl.

=head1 SYNOPSIS

	storeBackupRecover.pl -r restore [-b root] -t targetDir [--flat]
		[-o] [--tmpdir] [--noHardLinks] [-p number] [-v] [-n]
		[--cpIsGnu] [--noGnuCp]

=head1 OPTIONS

=over 8

=item B<--restoreTree>, B<-r>

    file or (part of) the tree to restore
    when restoring a file, the file name in the backup has
    to be used (eg. with compression suffix)

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

    root of storeBackup tree, normally not needed

=item B<--targetDir>, B<-t>

    directory for unpacking

=item B<--flat>

    do not create subdirectories

=item B<--overwrite>, B<-o>

    overwrite existing files

=item B<--tmpdir>, B<-T>

    directory for temporary file, default is <$tmpdir>

=item B<--noHardLinks>

    do not reconstruct hard links in restore tree

=item B<--noRestoreParallel>, B<-p>

    max no of paralell programs to unpack, default is 12

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

    print verbose messages

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

    print number of restored dirs, hardlinks, symlinks, files, ...

=item B<--noGnuCp>

    overwrite information in backup: you do not have gnucp
    installed
    (only relevant for sockets, block and character devices)

=back

=head1 COPYRIGHT

Copyright (c) 2002-2009 by Heinz-Josef Claes (see README).
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 $CheckPar =
    CheckParam->new('-allowLists' => 'no',
		    '-list' => [Option->new('-name' => 'restoreTree',
					    '-cl_option' => '-r',
					    '-cl_alias' => '--restoreTree',
					    '-param' => 'yes',
					    '-must_be' => 'yes'),
				Option->new('-name' => 'backupRoot',
					    '-cl_option' => '-b',
					    '-cl_alias' => '--backupRoot',
					    '-default' => ''),
				Option->new('-name' => 'targetDir',
					    '-cl_option' => '-t',
					    '-cl_alias' => '--targetDir',
					    '-param' => 'yes',
					    '-must_be' => 'yes'),
				Option->new('-name' => 'flat',
					    '-cl_option' => '--flat'),
				Option->new('-name' => 'overwrite',
					    '-cl_option' => '-o',
					    '-cl_alias' => '--overwrite'),
				Option->new('-name' => 'tmpDir',
					    '-cl_option' => '-T',
					    '-cl_alias' => '--tmpdir',
					    '-default' => $tmpdir),
				Option->new('-name' => 'noHardLinks',
					    '-cl_option' => '--noHardLinks'),
				Option->new('-name' => 'noRestoreParallel',
					    '-cl_option' => '-p',
					    '-cl_alias' => '--noRestoreParallel',
					    '-pattern' => '\A\d+\Z',
					    '-default' => $noRestoreParallel),
				Option->new('-name' => 'verbose',
					    '-cl_option' => '-v',
					    '-cl_alias' => '--verbose'),
				Option->new('-name' => 'noRestored',
					    '-cl_option' => '-n',
					    '-cl_alias' => '--noRestored'),
				Option->new('-name' => 'noGnuCp',
					    '-cl_option' => '--noGnuCp')
				]
		    );

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

# Auswertung der Parameter
my $restoreTree = $CheckPar->getOptWithPar('restoreTree');
my $backupRoot = $CheckPar->getOptWithPar('backupRoot');
my $targetDir = $CheckPar->getOptWithPar('targetDir');
my $flat = $CheckPar->getOptWithoutPar('flat');
my $overwrite = $CheckPar->getOptWithoutPar('overwrite');
$tmpdir = $CheckPar->getOptWithPar('tmpDir');
my $noHardLinks = $CheckPar->getOptWithoutPar('noHardLinks');
my $noRestoreParallel = $CheckPar->getOptWithPar('noRestoreParallel');
my $verbose = $CheckPar->getOptWithoutPar('verbose');
my $noRestored = $CheckPar->getOptWithoutPar('noRestored');
my $noGnuCp = $CheckPar->getOptWithoutPar('noGnuCp');


my $prLog = printLog->new('-kind' => ['I:INFO', 'W:WARNING', 'E:ERROR',
				      'S:STATISTIC', 'D:DEBUG', 'V:VERSION']);

$prLog->print('-kind' => 'E',
	      '-str' => ["target directory <$targetDir> does not exist"],
	      '-exit' => 1)
    unless (-d $targetDir);

$prLog->print('-kind' => 'V',
	      '-str' => ["$VERSIONpName, $main::STOREBACKUPVERSION, " .
			 "build $VERSIONsvnID"])
    if $verbose;

my $rt = $restoreTree;
my $restoreTree = &absolutePath($restoreTree);
$restoreTree = $1 if $restoreTree =~ /(.*)\/$/;  # remove trailing '/'

#
# md5CheckSum - Datei finden
$prLog->print('-kind' => 'E',
	      '-str' => ["directory or file <$rt> does not exist"],
	      '-exit' => 1)
    unless (-e $rt);
my $isFile = 1 if (-f $rt);

if ($backupRoot)
{
    $prLog->print('-kind' => 'E',
		  '-str' => ["directory <$backupRoot> does not exit"],
		  '-exit' => 1)
	unless (-d $backupRoot);
    $backupRoot = &absolutePath($backupRoot);
}
else
{
    my $dir = $restoreTree;
    $dir =~ s/(\/\.)*$//;      # remove trailing /.

    $backupRoot = undef;
    do
    {
	$dir =~ s/\/\.\//\//g;   # substitute /./ -> /

	# 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, $_) = &splitFileDir($dir);
    } while ($dir ne '/');


    $prLog->print('-kind' => 'E',
		  '-str' => ["did not find info file <$checkSumFile>"],
		  '-exit' => 1)
	unless ($backupRoot);
}

#$restoreTree =~ s/$backupRoot\/*//;
$restoreTree = substr($restoreTree, length($backupRoot) + 1);


# ^^^
# $backupRoot beinhaltet jetzt den Pfad zum Archiv
# $restoreTree beinhaltet jetzt den relativen Pfad innerhalb des Archivs

$prLog->print('-kind' => 'E',
	      '-str' => ["cannot restore <$backupRoot> because of unresolved links",
	      "run storeBackupUpdateBackup.pl to resolve"],
	      '-exit' => 1)
    if -e "$backupRoot/.storeBackupLinks/linkFile.bz2";

my (%setPermDirs);
unless ($flat)
{
    # Subtree unter dem Zieldirectory erzeugen
    &::makeFilePath("$targetDir/$restoreTree", $prLog);

    my (@d) = split(/\/+/, $restoreTree);
    my $i;
    for ($i = 0 ; $i < @d ; $i++)
    {
	$setPermDirs{join('/', @d[0..$i])} = 1;
    }
}

#
# Jezt Infofile einlesen und die gewünschten Dateien aussortieren
#

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

my $fork = parallelFork->new('-maxParallel' => $noRestoreParallel,
			     '-prLog' => $prLog);

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

my ($uncompr, @uncomprPar) = @{$$meta{'uncompress'}};
my ($cp, @cpPar) = ('cp', '-dPR');
my $postfix = ($$meta{'postfix'})->[0];
my $gnucp = ($$meta{'cpIsGnu'})->[0];
$gnucp = ($gnucp eq 'yes') ? 1 : 0;
$gnucp = 0 if $noGnuCp;

$main::IOCompressDirect = 0;
if ($uncompr eq 'bzip2' or $uncompr eq 'bunzip2')
{
    eval "use IO::Uncompress::Bunzip2 qw(bunzip2)";
    if ($@)
    {
	$prLog->print('-kind' => 'I',
		      '-str' => ["please install IO::Uncompress::Bunzip2 from " .
				 "CPAN for better performance"]);
    }
    else
    {
	$main::IOCompressDirect = 1;
    }
}

# dbm-File öffnen
my %DBMHardLink;        # key: dev-inode (oder undef), value: filename
my %hasToBeLinked = (); # hier werden die zu linkenden Dateien gesammelt,
                        # bis die Referenzdatei vollständig zurückgesichert ist
unless ($noHardLinks)
{
    dbmopen(%DBMHardLink, "$tmpdir/stbrecover.$$", 0600);
}

my $noFilesCopy = 0;
my $noFilesCompr = 0;
my $noFilesBlocked = 0;
my $noSymLinks = 0;
my $noNamedPipes = 0;
my $noSockets = 0;
my $noBlockDevs = 0;
my $noCharDevs = 0;
my $noDirs = 0;
my $hardLinks = 0;

# Zurücksichern der Dateien
$restoreTree =~ s/\/\.//g;
$restoreTree = '' if $restoreTree eq '.';
my $lrestoreTree = length($restoreTree);
my ($md5sum, $compr, $devInode, $inodeBackup, $ctime, $mtime, $atime,
    $size, $uid, $gid, $mode, $filename);
#print "restoreTree = <$restoreTree>\n";
#print "lrestoreTree = <$lrestoreTree>\n";
#print "isFile = <$isFile>\n";
while ((($md5sum, $compr, $devInode, $inodeBackup, $ctime, $mtime, $atime,
	 $size, $uid, $gid, $mode, $filename) = $rcsf->nextLine()) > 0)
{
    my $f = $filename;
    if (exists($setPermDirs{$f}))
    {
	chown $uid, $gid, "$targetDir/$f";
	chmod $mode, "$targetDir/$f";
	utime $atime, $mtime, "$targetDir/$f";
    }
    if ($isFile and length($md5sum) == 32)
    {
	$f .= $postfix if ($compr eq 'c');
    }
#print "from .md5CheckSums: <$f> <$restoreTree> $lrestoreTree\n";
    if ($restoreTree eq '' or "$restoreTree/" eq substr("$f/", 0, $lrestoreTree + 1)
	or ($isFile and $restoreTree eq $f))
    {
#print "---> restore!\n";
	my $targetFile;
	if ($flat)
	{
	    ($_, $targetFile) = &splitFileDir($filename);
	    $targetFile = "$targetDir/$targetFile";
	}
	else
	{
	    $targetFile = "$targetDir/$filename";
	}

	my $useGnuCp = $gnucp and ($md5sum eq 'socket' or
				   $md5sum eq 'blockdev' or
				   $md5sum eq 'chardev');

	if ($md5sum eq 'dir')
	{
	    if (not $flat and not -e $targetFile)
	    {
		++$noDirs;
		$prLog->print('-kind' => 'E',
			      '-str' =>
			      ["cannot create directory <$targetFile>"],
			      '-exit' => 1)
		    unless mkdir $targetFile;
		chown $uid, $gid, $targetFile;
		chmod $mode, $targetFile;
		utime $atime, $mtime, $targetFile;
		$prLog->print('-kind' => 'I',
			      '-str' => ["mkdir $targetFile"])
		    if ($verbose);
	    }
	}
	elsif ($md5sum eq 'symlink')
	{
	    unless ($noHardLinks)
	    {
		if (exists($DBMHardLink{$devInode}))   # muss nur gelinkt werden
		{
		    if (link $DBMHardLink{$devInode}, $targetFile)
		    {
			$prLog->print('-kind' => 'I',
				      '-str' =>
				      ["link " . $DBMHardLink{$devInode} .
				       " $targetFile"])
			    if $verbose;
#			utime $atime, $mtime, $f;
			++$hardLinks;
		    }
		    else
		    {
			$prLog->print('-kind' => 'E',
				      '-str' =>
				      ["failed: link " .
				       $DBMHardLink{$devInode} .
				       " $targetFile"]);
		    }
		    goto contLoop;
		}
		else
		{
		    $DBMHardLink{$devInode} = $targetFile;
		}
	    }
	    my $linkTo = readlink "$backupRoot/$filename";
	    if (not $overwrite and -e $targetFile)
	    {
		$prLog->print('-kind' => 'W',
			      '-str' => ["target $targetFile already exists:",
					 "\tln -s $linkTo $targetFile"]);
	    }
	    else
	    {
		++$noSymLinks;
		symlink $linkTo, $targetFile;

		# bei einigen Betriebssystem (z.B. Linux) wird bei Aufruf
		# des Systemcalls chmod bei symlinks nicht der Symlink selbst
		# geaendert, sondern die Datei, auf die er verweist.
		# (dann muss lchown genommen werden -> Inkompatibilitaeten!?)
		my $chown = forkProc->new('-exec' => 'chown',
					  '-param' => ['-h', "$uid:$gid",
						       "$targetFile"],
					  '-outRandom' => "$tmpdir/chown-",
					  '-prLog' => $prLog);
		$chown->wait();
#		utime $atime, $mtime, $targetFile;
		$prLog->print('-kind' => 'I',
			      '-str' => ["ln -s $linkTo $targetFile"])
		    if ($verbose);
	    }
	}
	elsif ($md5sum eq 'pipe')
	{
	    my $mknod = forkProc->new('-exec' => 'mknod',
				      '-param' => ["$targetFile", 'p'],
				      '-outRandom' => "$tmpdir/mknod-",
				      '-prLog' => $prLog);
	    $mknod->wait();
	    my $out = $mknod->getSTDOUT();
	    $prLog->print('-kind' => 'E',
			  '-str' =>
			  ["STDOUT of <mknod $targetFile p>:", @$out])
		if (@$out > 0);
	    $out = $mknod->getSTDERR();
	    $prLog->print('-kind' => 'E',
			  '-str' =>
			  ["STDERR of <mknod $targetFile p>:", @$out])
		if (@$out > 0);
	    chown $uid, $gid, $targetFile;
	    chmod $mode, $targetFile;
	    utime $atime, $mtime, $targetFile;
	}
	elsif (length($md5sum) == 32 or     # normal file
	       $useGnuCp)                   # special file
	{
# Idee zur Lösung des parallelitäts-Prolems beim Zurücksichern
# in Verbindung mit dem Setzen der hard links:
# erste Datei:
# dev-inode => '.' in dbm-file (%DBMHardLink)
# fork->add_block
# wenn fertig, dann dev-inode => filename in dbm-file
#
# zweite Datei (hard link)
# nachsehen in dbm-file
# wenn '.' -> in Warteschlange hängen (hash)
# wenn filename -> linken
# unten immer Warteschlange in dbm-file überprüfen
	    my ($old, $new) = (undef, undef);

	    unless ($noHardLinks) # Hard Link überprüfen
	    {
		if (exists($DBMHardLink{$devInode}))   # muss nur gelinkt werden
		{
		    $hasToBeLinked{$targetFile} = [$devInode, $uid, $gid, $mode,
						   $atime, $mtime];
		    $hardLinks++;
		    goto contLoop;
		}
		else
		{
		    $DBMHardLink{$devInode} = '.';   # ist in Bearbeitung
		}
	    }
	    if ($compr eq 'u')    # was not compressed, also valid for socket,
	    {                     # blockdev, chardev
		if (not $overwrite and -e $targetFile)
		{
		    $prLog->print('-kind' => 'W',
				  '-str' =>
				  ["target $targetFile already exists:",
				   "\t$cp @cpPar $backupRoot/$filename " .
				   "$targetFile"]);
		}
		else
		{
		    $noFilesCopy++ unless $useGnuCp;
		    $noSockets++ if $md5sum eq 'socket';
		    $noBlockDevs++ if $md5sum eq 'blockdev';
		    $noCharDevs++ if $md5sum eq 'chardev';

		    ($old, $new) =
			$fork->add_block('-exec' => $cp,
				   '-param' => [@cpPar, "$backupRoot/$filename",
						"$targetFile"],
				   '-outRandom' => "$tmpdir/recover-",
				   '-info' => [$targetFile, $uid, $gid, $mode,
					       $atime, $mtime, $devInode]);
		    $prLog->print('-kind' => 'I',
				  '-str' =>
				  ["cp $backupRoot/$filename $targetFile"])
			if ($verbose);
		}
	    }
	    elsif ($compr eq 'c')          # war komprimiert
	    {
		if (not $overwrite and -e $targetFile)
		{
		    $prLog->print('-kind' => 'W',
				  '-str' =>
				  ["target $targetFile already exists:",
				   "\t$uncompr @uncomprPar " .
				   "< $backupRoot/$filename$postfix " .
				   "> $targetFile"]);
		}
		else
		{
		    ++$noFilesCompr;
		    ($old, $new) =
			$fork->add_block('-exec' => $uncompr,
				   '-param' => \@uncomprPar,
				   '-stdin' => "$backupRoot/$filename$postfix",
				   '-stdout' => "$targetFile",
				   '-delStdout' => 'no',
				   '-outRandom' => "$tmpdir/recover-",
				   '-info' => [$targetFile, $uid, $gid, $mode,
					       $atime, $mtime, $devInode]);
		    $prLog->print('-kind' => 'I',
				  '-str' => ["$uncompr @uncomprPar < " .
					     "$backupRoot/$filename$postfix > " .
					     "$targetFile"])
			if ($verbose);
		}
	    }
	    elsif ($compr eq 'b')       # blocked file
	    {
		++$noFilesBlocked;
		($old, $new) =
		    $fork->add_block('-function' => \&uncompressCatBlock,
				     '-funcPar' => ["$backupRoot/$filename",
				     $targetFile, '\A\d.*', $uncompr, \@uncomprPar,
				     $postfix, $prLog],
				     '-info' => [$targetFile, $uid, $gid, $mode,
						 $atime, $mtime, $devInode]);
		$prLog->print('-kind' => 'I',
			      '-str' => ["cp (blocked) " .
					     "$backupRoot/$filename$postfix " .
					     "$targetFile"])
			if ($verbose);
	    }
	    else
	    {
		$prLog->print('-kind' => 'E',
			      '-str' =>
			      ["unknow compr flag <$compr> in .md5CheckSums " .
			       "for file <$backupRoot/$filename>"]);
	    }
	    if ($old)
	    {
		my ($f, $oUid, $oGid, $oMode, $oAtime, $oMtime, $oDevInode) =
		    @{$old->get('-what' => 'info')};
		unless ($noHardLinks)
		{                                 # File in DBM vermerken
		    $DBMHardLink{$oDevInode} = $f;
		}
		chown $oUid, $oGid, $f;
		chmod $oMode, $f;
		utime $oAtime, $oMtime, $f;
	    }

	    goto finish if $isFile;    # aufhören, ist nur _eine_ Datei
	}
	else    # unknown type
	{
	    $prLog->print('-kind' => 'E',
			  '-str' =>
			  ["unknown entry <$md5sum> for file <$filename>:"]);
	}
    }

contLoop:;
# nachsehen, ob offene Links gesetzt werden können
    &setHardLinks(\%hasToBeLinked, \%DBMHardLink, $prLog, $verbose)
	unless $noHardLinks;

}

finish:;
close(FILE);

my $job;
while ($job = $fork->waitForAllJobs())
{
    my ($f, $oUid, $oGid, $oMode, $oAtime, $oMtime, $oDevInode) =
	@{$job->get('-what' => 'info')};
    unless ($noHardLinks)
    {                                 # File in DBM vermerken
	$DBMHardLink{$oDevInode} = $f;
    }
    chown $oUid, $oGid, $f;
    chmod $oMode, $f;
    utime $oAtime, $oMtime, $f
}

unless ($noHardLinks)
{
    &setHardLinks(\%hasToBeLinked, \%DBMHardLink, $prLog, $verbose);
    dbmclose(%DBMHardLink);
    unlink "$tmpdir/stbrecover.$$";
}

$prLog->print('-kind' => 'I',
	      '-str' =>
	      [join(', ',
		    ($noDirs ? "$noDirs dirs" : ()),
		    ($hardLinks ? "$hardLinks hardlinks" : ()),
		    ($noSymLinks ? "$noSymLinks symlinks" : ()),
		    ($noNamedPipes ? "$noNamedPipes named pipes" : ()),
		    ($noSockets ? "$noSockets sockets" : ()),
		    ($noBlockDevs ? "$noBlockDevs block devs" : ()),
		    ($noCharDevs ? "$noCharDevs char devs" : ()),
		    ($noFilesCopy ? "$noFilesCopy copied" : ()),
		    ($noFilesCompr ? "$noFilesCompr uncompressed" : ()),
		    ($noFilesBlocked ? "$noFilesBlocked cat blocked files" : ()))]
    )
    if ($noRestored);

exit 0;


############################################################
sub setHardLinks
{
    my ($hasToBeLinked, $DBMHardLink, $prLog, $verbose) = @_;

    my $f;
    foreach $f (keys %$hasToBeLinked)
    {
	my ($di, $uid, $gid, $mode, $atime, $mtime) = @{$$hasToBeLinked{$f}};
	if (exists($$DBMHardLink{$di}) and $$DBMHardLink{$di} ne '.')
	{
	    my $oldF = $$DBMHardLink{$di};
	    if (-e $f)
	    {
		$prLog->print('-kind' => 'W',
			      '-str' => ["cannot link <$f> to itself"]);
	    }
	    else
	    {		
		if (link $oldF, $f)
		{
		    $prLog->print('-kind' => 'I',
				  '-str' => ["link $oldF $f"])
			if ($verbose);
		    chown $uid, $gid, $f;
		    chmod $mode, $f;
		    utime $atime, $mtime, $f;
		}
		else
		{
		    $prLog->print('-kind' => 'E',
				  '-str' => ["failed: link $oldF $f"]);
		}
	    }
	    delete $$hasToBeLinked{$f};
	}
    }
}


########################################
sub uncompressCatBlock
{
    my $fromDir = shift;
    my $toFile = shift;
    my $mask = shift;
    my $umcompr = shift;
    my $uncomprPar = shift;
    my $postfix = shift;
    my $prLog = shift;

    local *DIR;
    unless (opendir(DIR, $fromDir))
    {
	$prLog->print('-kind' => 'E',
		      '-str' => ["cannot open <$fromDir>"]);
	return 1;
    }
    my ($entry, @entries);
    while ($entry = readdir DIR)
    {
	next unless $entry =~ /$mask/;

	push @entries, $entry;
    }
    close(DIR);

    local *TO;
    unless (sysopen(TO, $toFile, O_CREAT | O_WRONLY))
    {
	$prLog->print('-kind' => 'E',
		      '-str' => ["cannot write to <$toFile>"]);
    }

    foreach $entry (sort @entries)
    {
	local *FROM;
	my $fileIn = undef;
	if ($entry =~ /$postfix\Z/)    # compressed block
	{
	    if ($main::IOCompressDirect)
	    {
		my $input = "$fromDir/$entry";
		my $buffer;
		my $uc = new IO::Uncompress::Bunzip2 $input;
		$uc->read($buffer);
		syswrite(TO, $buffer);
		next;
	    }

	    $fileIn =
		pipeFromFork->new('-exec' => $uncompr,
				  '-param' => \@uncomprPar,
				  '-stdin' => "$fromDir/$entry",
				  '-outRandom' => '/tmp/stbuPipeFrom11-',
				  '-prLog' => $prLog);
	}
	else           # block not compressed
	{
	    unless (sysopen(FROM, "$fromDir/$entry", O_RDONLY))
	    {
		$prLog->print('-kind' => 'E',
			      '-str' => ["cannot read <$fromDir/$entry>"]);
		return 1;
	    }
	}
	my $buffer;
	while ($fileIn ? $fileIn->sysread(\$buffer, 10*1024**2) :
	       sysread(FROM, $buffer, 10*1024**2))
	{
	    syswrite(TO, $buffer);
	}
	if ($fileIn)
	{
	    $fileIn->close();
	    $fileIn = undef;
	}
	else
	{
	    close(FILE);
	}
    }
    close(TO);
    return 0;
}