| Subject: | critical bug in 'samecheck' |
Hi,
I have had the misfortune of encountering a rather serious bug in the
samecheck sub routine of File::Copy::Recursive.
The join statements that combine device with inode value do not work.
Only the inode value is returned. This causes a fatal "Caught Deep
Recursion Condition" if you have two paths with the same inode value on
different devices.
The guilty code is:
$one = join '-', ( stat $_[0] )[0,1] || '';
and
$two = join '-', ( stat $_[1] )[0,1] || '';
For reasons unknown to me, the || causes the last element of the list to
be returned on its own.
Wrapping the join's parameters in parenthesis appears to resolve the issue.
This behaviour can be replecated in the perl debugger:
- store results of stat on my home directory:
DB<1> @foo = stat( '/home/andy' )
- Display the contents of the stat list:
DB<2> x @foo
0 16
1 20870
2 16877
3 52
4 512
5 513
6 0
7 5712
8 1147340161
9 1147336570
10 1147336570
11 32768
12 11
- Now display items 0 and 1 of the stat list:
DB<3> x @foo[0,1]
0 16
1 20870
- Adding the || returns the last item only:
DB<4> x @foo[0,1] || ''
0 20870
- Adding more items verifies that we always get the last item:
DB<5> x @foo[0,1,2] || ''
0 16877
DB<6>
As I am sure you can imagine, this could be a serious problem for people
that are using File::Copy::Recursive across multiple devices. (As it
was for me)
I have attached a diff of the changes I made. However, it is worth
reviewing the code for more of this sort of thing. The module strikes
me as quite difficult to read - something that I find often leads to
unexpected behaviour.
Regards,
Andy
PS. I am using perl 5.8.8 on Debian 3.1
PPS. I have highlighted this as a bug in versions 0.16 to 0.21.
However, it may be present in earlier versions. I haven't checked.
| Subject: | recursive.diff |
*** Recursive.pm 2006-05-11 09:21:57.751718115 +0100
--- ModifiedRecursive.pm 2006-05-11 10:29:41.896985458 +0100
***************
*** 28,45 ****
my $samecheck = sub {
my $one = '';
if($PFSCheck) {
! $one = join '-', ( stat $_[0] )[0,1] || '';
! my $two = join '-', ( stat $_[1] )[0,1] || '';
croak "$_[0] and $_[1] are identical" if $one eq $two && $one;
}
if(-d $_[0] && !$CopyLoop) {
! $one = join '-', ( stat $_[0] )[0,1] if !$one;
my $abs = File::Spec->rel2abs($_[1]);
my @pth = File::Spec->splitdir( $abs );
while(@pth) {
my $cur = File::Spec->catdir(@pth);
last if !$cur; # probably not necessary, but nice to have just in case :)
! my $two = join '-', ( stat $cur )[0,1] || '';
croak "Caught Deep Recursion Condition: $_[0] contains $_[1]" if $one eq $two && $one;
pop @pth;
}
--- 28,45 ----
my $samecheck = sub {
my $one = '';
if($PFSCheck) {
! $one = join( '-', ( stat $_[0] )[0,1] ) || '';
! my $two = join( '-', ( stat $_[1] )[0,1] ) || '';
croak "$_[0] and $_[1] are identical" if $one eq $two && $one;
}
if(-d $_[0] && !$CopyLoop) {
! $one = join( '-', ( stat $_[0] )[0,1] ) if !$one;
my $abs = File::Spec->rel2abs($_[1]);
my @pth = File::Spec->splitdir( $abs );
while(@pth) {
my $cur = File::Spec->catdir(@pth);
last if !$cur; # probably not necessary, but nice to have just in case :)
! my $two = join( '-', ( stat $cur )[0,1] ) || '';
croak "Caught Deep Recursion Condition: $_[0] contains $_[1]" if $one eq $two && $one;
pop @pth;
}