Skip to content

Commit

Permalink
File::Find: fix "follow => 1" on Windows
Browse files Browse the repository at this point in the history 
File::Find's code expects unix-style paths and it manipulates them using
basic string operations. That code is very fragile, and ideally we
should make it use File::Spec, but that would involve rewriting almost
the whole module.

Instead, we made it convert backslashes to slashes and handle drive
letters.

Note from xenu: this commit was adapted from the PR linked in this
blogpost[1]. I have squashed it, written the commit message and slightly
modified the code.

[1] - https://www.nu42.com/2021/09/canonical-paths-file-find-way-forward.html

Fixes #19995
  • Loading branch information
@nanis @xenu
nanis authored and xenu committed Aug 2, 2022
1 parent 2fcaad3 commit 414f14d
Show file tree
Hide file tree
Showing 7 changed files with 97 additions and 27 deletions.
1 change: 1 addition & 0 deletions MANIFEST
View file
Expand Up @@ -4265,6 +4265,7 @@ ext/File-DosGlob/DosGlob.xs Win32 DOS-globbing module
ext/File-DosGlob/lib/File/DosGlob.pm Win32 DOS-globbing module
ext/File-DosGlob/t/DosGlob.t See if File::DosGlob works
ext/File-Find/lib/File/Find.pm Routines to do a find
ext/File-Find/t/correct-absolute-path-with-follow.t
ext/File-Find/t/find.t See if File::Find works
ext/File-Find/t/lib/Testing.pm Functions used in testing File-find
ext/File-Find/t/taint.t See if File::Find works with taint
Expand Down
1 change: 1 addition & 0 deletions Porting/Maintainers.pl
View file
Expand Up @@ -172,6 +172,7 @@ package Maintainers;
'DISTRIBUTION' => 'SMUELLER/AutoLoader-5.74.tar.gz',
'FILES' => q[cpan/AutoLoader],
'EXCLUDED' => ['t/00pod.t'],
'CUSTOMIZED' => ['t/02AutoSplit.t'],
},

'autouse' => {
Expand Down
6 changes: 5 additions & 1 deletion cpan/AutoLoader/t/02AutoSplit.t
View file
Expand Up @@ -149,8 +149,12 @@ foreach (@tests) {

if ($args{Files}) {
$args{Files} =~ s!/!:!gs if $^O eq 'MacOS';
$args{Files} =~ s!\\!/!g if $^O eq 'MSWin32';
my (%missing, %got);
find (sub {$got{$File::Find::name}++ unless -d $_}, $dir);
find(
sub { (my $f = $File::Find::name) =~ s!\\!/!g; $got{$f}++ unless -d $_ },
$dir
);
foreach (split /\n/, $args{Files}) {
next if /^#/;
$_ = lc($_) if $Is_VMS_lc;
Expand Down
50 changes: 25 additions & 25 deletions ext/File-Find/lib/File/Find.pm
View file
Expand Up @@ -43,11 +43,21 @@ sub contract_name {
return $abs_name;
}

sub _is_absolute {
return $_[0] =~ m|^(?:[A-Za-z]:)?/| if $Is_Win32;
return substr($_[0], 0, 1) eq '/';
}

sub _is_root {
return $_[0] =~ m|^(?:[A-Za-z]:)?/\z| if $Is_Win32;
return $_[0] eq '/';
}

sub PathCombine($$) {
my ($Base,$Name) = @_;
my $AbsName;

if (substr($Name,0,1) eq '/') {
if (_is_absolute($Name)) {
$AbsName= $Name;
}
else {
Expand Down Expand Up @@ -123,6 +133,7 @@ sub is_tainted_pp {
return length($@) != 0;
}


sub _find_opt {
my $wanted = shift;
return unless @_;
Expand Down Expand Up @@ -183,19 +194,17 @@ sub _find_opt {

($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;

if ($Is_Win32) {
$top_item =~ s|[/\\]\z||
unless $top_item =~ m{^(?:\w:)?[/\\]$};
}
else {
$top_item =~ s|/\z|| unless $top_item eq '/';
}
# canonicalize directory separators
$top_item =~ s|[/\\]|/|g if $Is_Win32;

# no trailing / unless path is root
$top_item =~ s|/\z|| unless _is_root($top_item);

$Is_Dir= 0;

if ($follow) {

if (substr($top_item,0,1) eq '/') {
if (_is_absolute($top_item)) {
$abs_dir = $top_item;
}
elsif ($top_item eq $File::Find::current_dir) {
Expand Down Expand Up @@ -304,11 +313,7 @@ sub _find_dir($$$) {
my $tainted = 0;
my $no_nlink;

if ($Is_Win32) {
$dir_pref
= ($p_dir =~ m{^(?:\w:[/\\]?|[/\\])$} ? $p_dir : "$p_dir/" );
} elsif ($Is_VMS) {

if ($Is_VMS) {
# VMS is returning trailing .dir on directories
# and trailing . on files and symbolic links
# in UNIX syntax.
Expand All @@ -319,7 +324,7 @@ sub _find_dir($$$) {
$dir_pref = ($p_dir =~ m/[\]>]+$/ ? $p_dir : "$p_dir/" );
}
else {
$dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
$dir_pref = _is_root($p_dir) ? $p_dir : "$p_dir/";
}

local ($dir, $name, $prune);
Expand Down Expand Up @@ -471,12 +476,7 @@ sub _find_dir($$$) {
$CdLvl = $Level;
}

if ($Is_Win32) {
$dir_name = ($p_dir =~ m{^(?:\w:[/\\]?|[/\\])$}
? "$p_dir$dir_rel" : "$p_dir/$dir_rel");
$dir_pref = "$dir_name/";
}
elsif ($^O eq 'VMS') {
if ($^O eq 'VMS') {
if ($p_dir =~ m/[\]>]+$/) {
$dir_name = $p_dir;
$dir_name =~ s/([\]>]+)$/.$dir_rel$1/;
Expand All @@ -488,7 +488,7 @@ sub _find_dir($$$) {
}
}
else {
$dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
$dir_name = _is_root($p_dir) ? "$p_dir$dir_rel" : "$p_dir/$dir_rel";
$dir_pref = "$dir_name/";
}

Expand Down Expand Up @@ -540,8 +540,8 @@ sub _find_dir_symlnk($$$) {
my $tainted = 0;
my $ok = 1;

$dir_pref = ( $p_dir eq '/' ? '/' : "$p_dir/" );
$loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" );
$dir_pref = _is_root($p_dir) ? $p_dir : "$p_dir/";
$loc_pref = _is_root($dir_loc) ? $dir_loc : "$dir_loc/";

local ($dir, $name, $fullname, $prune);

Expand Down Expand Up @@ -677,7 +677,7 @@ sub _find_dir_symlnk($$$) {
continue {
while (defined($SE = pop @Stack)) {
($dir_loc, $updir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE;
$dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
$dir_name = _is_root($p_dir) ? "$p_dir$dir_rel" : "$p_dir/$dir_rel";
$dir_pref = "$dir_name/";
$loc_pref = "$dir_loc/";
if ( $byd_flag < 0 ) { # must be finddepth, report dirname now
Expand Down
63 changes: 63 additions & 0 deletions ext/File-Find/t/correct-absolute-path-with-follow.t
View file
@@ -0,0 +1,63 @@
#!./perl

use strict;
use warnings;

use File::Find qw( find finddepth );
use File::Temp qw();
use Test::More;

my $warn_msg;

BEGIN {
$SIG{'__WARN__'} = sub {
$warn_msg = $_[0];
warn "# $_[0]";
return;
}
}

sub test_find_correct_paths_with_follow {
$warn_msg = '';
my $dir = File::Temp->newdir('file-find-XXXXXX', TMPDIR => 1, CLEANUP => 1);

find(
{
follow => 1,
wanted => sub { return },
},
$dir,
);

unlike(
$warn_msg,
qr/Couldn't chdir/,
'find: Derive absolute path correctly with follow => 1',
);
}

sub test_finddepth_correct_paths_with_follow {
$warn_msg = '';
my $dir = File::Temp->newdir('file-find-XXXXXX', TMPDIR => 1, CLEANUP => 1);

finddepth(
{
follow => 1,
wanted => sub { return },
},
$dir,
);

unlike(
$warn_msg,
qr/Couldn't chdir/,
'finddepth: Derive absolute path correctly with follow => 1',
);
}
sub run {
test_find_correct_paths_with_follow;
test_finddepth_correct_paths_with_follow;
done_testing;
}

run();
2 changes: 1 addition & 1 deletion ext/File-Find/t/find.t
View file
Expand Up @@ -1060,7 +1060,7 @@ if ($^O eq 'MSWin32') {
'wanted' => sub {
-f or return; # the first call is for $root_dir itself.
my $got = $File::Find::name;
my $exp = "$root_dir$expected_first_file";
(my $exp = "$root_dir$expected_first_file") =~ s|\\|/|g;
print "# no_chdir=$no_chdir $root_dir '$got'\n";
is($got, $exp,
"Win32: Run 'find' with 'no_chdir' set to $no_chdir" );
Expand Down
1 change: 1 addition & 0 deletions t/porting/customized.dat
View file
@@ -1,6 +1,7 @@
# Regenerate this file using:
# cd t
# ./perl -I../lib porting/customized.t --regen
AutoLoader cpan/AutoLoader/t/02AutoSplit.t bb90cda13b88599ad45de4b45799d5218afcb6d8
ExtUtils::Constant cpan/ExtUtils-Constant/lib/ExtUtils/Constant/Base.pm 7560e1018f806db5689dee78728ccb8374aea741
ExtUtils::Constant cpan/ExtUtils-Constant/t/Constant.t 165e9c7132b003fd192d32a737b0f51f9ba4999e
Filter::Util::Call pod/perlfilter.pod 545265af2f45741a0e59eecdd0cfc0c9e490c1e8
Expand Down

0 comments on commit 414f14d

Please sign in to comment.