"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "lib/BackupPC/DirOps.pm" between
BackupPC-4.3.2.tar.gz and BackupPC-4.4.0.tar.gz

About: BackupPC is a high-performance, enterprise-grade system for backing up Linux and WinXX PCs and laptops to a server’s disk (http/cgi user interface).

DirOps.pm  (BackupPC-4.3.2)	:	DirOps.pm  (BackupPC-4.4.0)
skipping to change at line 31		skipping to change at line 31
# This program is distributed in the hope that it will be useful,		# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of		# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the		# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.		# GNU General Public License for more details.
#		#
# You should have received a copy of the GNU General Public License		# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.		# along with this program. If not, see <http://www.gnu.org/licenses/>.
#		#
#========================================================================		#========================================================================
#		#
# Version 4.3.2, released 17 Feb 2020.		# Version 4.4.0, released 20 Jun 2020.
#		#
# See http://backuppc.sourceforge.net.		# See http://backuppc.sourceforge.net.
#		#
#========================================================================		#========================================================================
package BackupPC::DirOps;		package BackupPC::DirOps;
use strict;		use strict;
use Fcntl ':mode';		use Fcntl ':mode';
skipping to change at line 56		skipping to change at line 56
use BackupPC::XS;		use BackupPC::XS;
use BackupPC::Storage;		use BackupPC::Storage;
use vars qw( $IODirentOk $IODirentLoaded );		use vars qw( $IODirentOk $IODirentLoaded );
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);		use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
require Exporter;		require Exporter;
require DynaLoader;		require DynaLoader;
@ISA = qw(Exporter DynaLoader);		@ISA = qw(Exporter DynaLoader);
@EXPORT_OK = qw( BPC_DT_UNKNOWN		@EXPORT_OK = qw( BPC_DT_UNKNOWN
BPC_DT_FIFO		BPC_DT_FIFO
BPC_DT_CHR		BPC_DT_CHR
BPC_DT_DIR		BPC_DT_DIR
BPC_DT_BLK		BPC_DT_BLK
BPC_DT_REG		BPC_DT_REG
BPC_DT_LNK		BPC_DT_LNK
BPC_DT_SOCK		BPC_DT_SOCK
);		);
@EXPORT = qw( );		@EXPORT = qw( );
%EXPORT_TAGS = ('BPC_DT_ALL' => [@EXPORT, @EXPORT_OK]);		%EXPORT_TAGS = ('BPC_DT_ALL' => [@EXPORT, @EXPORT_OK]);
BEGIN {		BEGIN {
eval "use IO::Dirent qw( readdirent );";		eval "use IO::Dirent qw( readdirent );";
$IODirentLoaded = 1 if ( !$@ );		$IODirentLoaded = 1 if ( !$@ );
};		}
#		#
# The need to match the constants in IO::Dirent		# The need to match the constants in IO::Dirent
#		#
use constant BPC_DT_UNKNOWN => 0;		use constant BPC_DT_UNKNOWN => 0;
use constant BPC_DT_FIFO => 1; ## named pipe (fifo)		use constant BPC_DT_FIFO => 1; ## named pipe (fifo)
use constant BPC_DT_CHR => 2; ## character special		use constant BPC_DT_CHR => 2; ## character special
use constant BPC_DT_DIR => 4; ## directory		use constant BPC_DT_DIR => 4; ## directory
use constant BPC_DT_BLK => 6; ## block special		use constant BPC_DT_BLK => 6; ## block special
use constant BPC_DT_REG => 8; ## regular		use constant BPC_DT_REG => 8; ## regular
use constant BPC_DT_LNK => 10; ## symbolic link		use constant BPC_DT_LNK => 10; ## symbolic link
use constant BPC_DT_SOCK => 12; ## socket		use constant BPC_DT_SOCK => 12; ## socket
#		#
# Read a directory and return the entries in sorted inode order.		# Read a directory and return the entries in sorted inode order.
# This relies on the IO::Dirent module being installed. If not,		# This relies on the IO::Dirent module being installed. If not,
# the inode data is empty and the default directory order is		# the inode data is empty and the default directory order is
# returned.		# returned.
#		#
# The returned data is a list of hashes with entries {name, type, inode, nlink}.		# The returned data is a list of hashes with entries {name, type, inode, nlink}.
# The returned data includes "." and "..".		# The returned data includes "." and "..".
#		#
skipping to change at line 111		skipping to change at line 111
#		#
# If IO::Dirent is successful if will get type and inode for free.		# If IO::Dirent is successful if will get type and inode for free.
# Otherwise, a stat is done on each file, which is more expensive.		# Otherwise, a stat is done on each file, which is more expensive.
#		#
sub dirRead		sub dirRead
{		{
my($bpc, $path, $need) = @_;		my($bpc, $path, $need) = @_;
my(@entries, $addInode);		my(@entries, $addInode);
from_to($path, "utf8", $need->{charsetLegacy})		from_to($path, "utf8", $need->{charsetLegacy})
if ( $need->{charsetLegacy} ne "" );		if ( $need->{charsetLegacy} ne "" );
return [] if ( !opendir(my $fh, $path) );		return [] if ( !opendir(my $fh, $path) );
if ( $IODirentLoaded && !$IODirentOk ) {		if ( $IODirentLoaded && !$IODirentOk ) {
#		#
# Make sure the IO::Dirent really works - some installs		# Make sure the IO::Dirent really works - some installs
# on certain file systems (eg: XFS) don't return a valid type.		# on certain file systems (eg: XFS) don't return a valid type.
# and some fail to return valid inode numbers.		# and some fail to return valid inode numbers.
#		#
# Also create a temporary file to make sure the inode matches.		# Also create a temporary file to make sure the inode matches.
#		#
my $tempTestFile = ".TestFileDirent.$$";		my $tempTestFile = ".TestFileDirent.$$";
my $fullTempTestFile = $bpc->{TopDir} . "/$tempTestFile";		my $fullTempTestFile = $bpc->{TopDir} . "/$tempTestFile";
if ( open(my $fh, ">", $fullTempTestFile) ) {		if ( open(my $fh, ">", $fullTempTestFile) ) {
close($fh);		close($fh);
}		}
if ( opendir(my $fh, $bpc->{TopDir}) ) {		if ( opendir(my $fh, $bpc->{TopDir}) ) {
foreach my $e ( readdirent($fh) ) {		foreach my $e ( readdirent($fh) ) {
if ( $e->{name} eq "."		if ( $e->{name} eq "." && $e->{type} == BPC_DT_DIR && $e->{inode
&& $e->{type} == BPC_DT_DIR		} == (stat($bpc->{TopDir}))[1] ) {
&& $e->{inode} == (stat($bpc->{TopDir}))[1] ) {
$IODirentOk |= 0x1;		$IODirentOk |= 0x1;
}		}
if ( $e->{name} eq $tempTestFile		if ( $e->{name} eq $tempTestFile
&& $e->{type} == BPC_DT_REG		&& $e->{type} == BPC_DT_REG
&& $e->{inode} == (stat($fullTempTestFile))[1] ) {		&& $e->{inode} == (stat($fullTempTestFile))[1] ) {
$IODirentOk |= 0x2;		$IODirentOk |= 0x2;
}		}
}		}
closedir($fh);		closedir($fh);
}		}
unlink($fullTempTestFile) if ( -f $fullTempTestFile );		unlink($fullTempTestFile) if ( -f $fullTempTestFile );
#		#
# if it isn't ok then don't check again.		# if it isn't ok then don't check again.
#		#
if ( $IODirentOk != 0x3 ) {		if ( $IODirentOk != 0x3 ) {
$IODirentLoaded = 0;		$IODirentLoaded = 0;
$IODirentOk = 0;		$IODirentOk = 0;
}		}
}		}
if ( $IODirentOk ) {		if ( $IODirentOk ) {
@entries = sort({ $a->{inode} <=> $b->{inode} } readdirent($fh));		@entries = sort({ $a->{inode} <=> $b->{inode} } readdirent($fh));
map { $_->{type} = 0 + $_->{type} } @entries; # make type numeric		map { $_->{type} = 0 + $_->{type} } @entries; # make type numeric
} else {		} else {
@entries = map { { name => $_} } readdir($fh);		@entries = map { {name => $_} } readdir($fh);
}		}
closedir($fh);		closedir($fh);
if ( defined($need) && %$need > 0 ) {		if ( defined($need) && %$need > 0 ) {
for ( my $i = 0 ; $i < @entries ; $i++ ) {		for ( my $i = 0 ; $i < @entries ; $i++ ) {
next if ( (!$need->{inode} || defined($entries[$i]{inode}))		next
&& (!$need->{type} || defined($entries[$i]{type}))		if ( (!$need->{inode} || defined($entries[$i]{inode}))
&& (!$need->{nlink} || defined($entries[$i]{nlink})) );		&& (!$need->{type} || defined($entries[$i]{type}))
		&& (!$need->{nlink} || defined($entries[$i]{nlink})) );
my @s = stat("$path/$entries[$i]{name}");		my @s = stat("$path/$entries[$i]{name}");
$entries[$i]{nlink} = $s[3] if ( $need->{nlink} );		$entries[$i]{nlink} = $s[3] if ( $need->{nlink} );
if ( $need->{inode} && !defined($entries[$i]{inode}) ) {		if ( $need->{inode} && !defined($entries[$i]{inode}) ) {
$addInode = 1;		$addInode = 1;
$entries[$i]{inode} = $s[1];		$entries[$i]{inode} = $s[1];
}		}
if ( $need->{type} && !defined($entries[$i]{type}) ) {		if ( $need->{type} && !defined($entries[$i]{type}) ) {
my $mode = S_IFMT($s[2]);		my $mode = S_IFMT($s[2]);
$entries[$i]{type} = BPC_DT_FIFO if ( S_ISFIFO($mode) );		$entries[$i]{type} = BPC_DT_FIFO if ( S_ISFIFO($mode) );
$entries[$i]{type} = BPC_DT_CHR if ( S_ISCHR($mode) );		$entries[$i]{type} = BPC_DT_CHR if ( S_ISCHR($mode) );
skipping to change at line 286		skipping to change at line 285
my(@files, $root);		my(@files, $root);
if ( defined($roots) && length($roots) ) {		if ( defined($roots) && length($roots) ) {
$roots = [$roots] unless ref $roots;		$roots = [$roots] unless ref $roots;
} else {		} else {
print(STDERR "RmTreeQuietInner: No root path(s) specified\n");		print(STDERR "RmTreeQuietInner: No root path(s) specified\n");
return 1;		return 1;
}		}
foreach $root ( @$roots ) {		foreach $root ( @$roots ) {
my($path, $name);		my($path, $name);
$root =~ s{/+$}{};		$root =~ s{/+$}{};
if ( $root =~ m{(.*)/(.*)} ) {		if ( $root =~ m{(.*)/(.*)} ) {
$path = $1;		$path = $1;
$name = $2;		$name = $2;
if ( !-d $path ) {		if ( !-d $path ) {
print(STDERR "RmTreeQuietInner: $cwd/$path isn't a directory (wh ile removing $root)\n");		print(STDERR "RmTreeQuietInner: $cwd/$path isn't a directory (wh ile removing $root)\n");
return 1;		return 1;
}		}
if ( !chdir($path) ) {		if ( !chdir($path) ) {
print(STDERR "RmTreeQuietInner: can't chdir to $cwd/$path (while removing $root)\n");		print(STDERR "RmTreeQuietInner: can't chdir to $cwd/$path (while removing $root)\n");
return 1;		return 1;
skipping to change at line 313		skipping to change at line 312
#		#
# If this is an attrib file then we need to open it to		# If this is an attrib file then we need to open it to
# update the reference counts if the caller wants us to		# update the reference counts if the caller wants us to
#		#
if ( $compress >= -1 && $name =~ /^attrib/ && -f $name ) {		if ( $compress >= -1 && $name =~ /^attrib/ && -f $name ) {
if ( $deltaInfo ) {		if ( $deltaInfo ) {
my $attr = BackupPC::XS::Attrib::new($compress);		my $attr = BackupPC::XS::Attrib::new($compress);
if ( !$attr->read(".", $name) ) {		if ( !$attr->read(".", $name) ) {
print(STDERR "Can't read attribute file in $cwd/$path/$name\ n");		print(STDERR "Can't read attribute file in $cwd/$path/$name\ n");
}		}
my $attrAll = $attr->get();		my $fileCnt = 0;
my $d = $attr->digest();		my $d = $attr->digest();
$deltaInfo->update($compress, $d, -1) if ( $deltaInfo && length( $d) );		$deltaInfo->update($compress, $d, -1) if ( $deltaInfo && length( $d) );
if ( $compress >= 0 ) {		if ( $compress >= 0 ) {
foreach my $fileUM ( keys(%$attrAll) ) {		my $idx = 0;
my $a = $attrAll->{$fileUM};		my $a;
		while ( 1 ) {
		($a, $idx) = $attr->iterate($idx);
		last if ( !defined($a) );
		$fileCnt++;
$deltaInfo->update($compress, $a->{digest}, -1)		$deltaInfo->update($compress, $a->{digest}, -1)
if ( $deltaInfo && lengt		if ( $deltaInfo && length($a->{digest}) );
h($a->{digest}) );		next if ( $a->{nlinks} == 0 || !$deltaInfo || !$attrCach
next if ( $a->{nlinks} == 0 || !$deltaInfo || !$attrCache		e );
);
#		#
# If caller supplied deltaInfo and attrCache then update d the inodes too		# If caller supplied deltaInfo and attrCache then update d the inodes too
#		#
my $aInode = $attrCache->getInode($a->{inode});		my $aInode = $attrCache->getInode($a->{inode});
$aInode->{nlinks}--;		$aInode->{nlinks}--;
if ( $aInode->{nlinks} <= 0 ) {		if ( $aInode->{nlinks} <= 0 ) {
$deltaInfo->update($compress, $aInode->{digest}, -1);		$deltaInfo->update($compress, $aInode->{digest}, -1)
$attrCache->deleteInode($a->{inode});		;
} else {		$attrCache->deleteInode($a->{inode});
$attrCache->setInode($a->{inode}, $aInode);		} else {
}		$attrCache->setInode($a->{inode}, $aInode);
		}
}		}
}		}
&$progressCB(scalar(keys(%$attrAll))) if ( ref($progressCB) eq ' CODE' );		&$progressCB($fileCnt) if ( ref($progressCB) eq 'CODE' );
} else {		} else {
#		#
# the callback should know it's directories, not files in the no n-ref		# the callback should know it's directories, not files in the no n-ref
# counting case		# counting case
#		#
&$progressCB(1) if ( ref($progressCB) eq 'CODE' );		&$progressCB(1) if ( ref($progressCB) eq 'CODE' );
}		}
}		}
if ( $compress < -1 && ref($progressCB) eq 'CODE' ) {		if ( $compress < -1 && ref($progressCB) eq 'CODE' ) {
#		#
# Do progress counting in the non-ref count case		# Do progress counting in the non-ref count case
# (the callback should know it's directories, not files)		# (the callback should know it's directories, not files)
#		#
&$progressCB(1) if ( ref($progressCB) eq 'CODE' );		&$progressCB(1) if ( ref($progressCB) eq 'CODE' );
}		}
#		#
# Try first to simply unlink the file: this avoids an		# Try first to simply unlink the file: this avoids an
# extra stat for every file. If it fails (which it		# extra stat for every file. If it fails (which it
# will for directories), check if it is a directory and		# will for directories), check if it is a directory and
# then recurse.		# then recurse.
#		#
if ( !unlink($name) ) {		if ( !unlink($name) ) {
if ( -d $name ) {		if ( -d $name ) {
if ( !chdir($name) ) {		if ( !chdir($name) ) {
print(STDERR "RmTreeQuietInner: can't chdir to $name (while removing $root)\n");		print(STDERR "RmTreeQuietInner: can't chdir to $name (while removing $root)\n");
return 1;		return 1;
}		}
my $d = BackupPC::DirOps::dirReadNames($bpc, ".");		my $d = BackupPC::DirOps::dirReadNames($bpc, ".");
if ( !defined($d) ) {		if ( !defined($d) ) {
print(STDERR "Can't read $cwd/$path/$name: $!\n");		print(STDERR "Can't read $cwd/$path/$name: $!\n");
} else {		} else {
@files = grep $_ !~ /^\.{1,2}$/, @$d;		@files = grep $_ !~ /^\.{1,2}$/, @$d;
BackupPC::DirOps::RmTreeQuietInner($bpc, "$cwd/$name", \@file		BackupPC::DirOps::RmTreeQuietInner($bpc, "$cwd/$name", \@fil
s, $compress, $deltaInfo, $attrCache, $progressCB);		es, $compress, $deltaInfo, $attrCache,
if ( !chdir("..") ) {		$progressCB);
		if ( !chdir("..") ) {
print(STDERR "RmTreeQuietInner: can't chdir .. (while re moving $root)\n");		print(STDERR "RmTreeQuietInner: can't chdir .. (while re moving $root)\n");
return 1;		return 1;
}		}
rmdir($name) || rmdir($name);		rmdir($name) || rmdir($name);
}		}
} else {		} else {
#		#
# just try again		# just try again
#		#
unlink($name) || unlink($name);		unlink($name) || unlink($name);
}		}
}		}
}		}
return 0;		return 0;
}		}
End of changes. 21 change blocks.
67 lines changed or deleted		72 lines changed or added

---