diff options
author | Nicholas Clark <nick@ccl4.org> | 2013-07-03 11:11:06 +0200 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2013-07-05 20:26:26 +0200 |
commit | 6de85bb45a5ea25528026a26cac854ee4dcdcd45 (patch) | |
tree | 417070253c406257fa2f8fbe7b4166f1064f956f /lib/File | |
parent | e12eeff833d221009aa2e2a6d745f2c1812f2f77 (diff) | |
download | perl-6de85bb45a5ea25528026a26cac854ee4dcdcd45.tar.gz |
Move File::Find from lib/ to ext/
Diffstat (limited to 'lib/File')
-rw-r--r-- | lib/File/Find.pm | 1127 | ||||
-rw-r--r-- | lib/File/Find/t/find.t | 977 | ||||
-rw-r--r-- | lib/File/Find/t/taint.t | 371 |
3 files changed, 0 insertions, 2475 deletions
diff --git a/lib/File/Find.pm b/lib/File/Find.pm deleted file mode 100644 index 99b868ebda..0000000000 --- a/lib/File/Find.pm +++ /dev/null @@ -1,1127 +0,0 @@ -package File::Find; -use 5.006; -use strict; -use warnings; -use warnings::register; -our $VERSION = '1.24'; -require Exporter; -require Cwd; - -# -# Modified to ensure sub-directory traversal order is not inverted by stack -# push and pops. That is remains in the same order as in the directory file, -# or user pre-processing (EG:sorted). -# - -=head1 NAME - -File::Find - Traverse a directory tree. - -=head1 SYNOPSIS - - use File::Find; - find(\&wanted, @directories_to_search); - sub wanted { ... } - - use File::Find; - finddepth(\&wanted, @directories_to_search); - sub wanted { ... } - - use File::Find; - find({ wanted => \&process, follow => 1 }, '.'); - -=head1 DESCRIPTION - -These are functions for searching through directory trees doing work -on each file found similar to the Unix I<find> command. File::Find -exports two functions, C<find> and C<finddepth>. They work similarly -but have subtle differences. - -=over 4 - -=item B<find> - - find(\&wanted, @directories); - find(\%options, @directories); - -C<find()> does a depth-first search over the given C<@directories> in -the order they are given. For each file or directory found, it calls -the C<&wanted> subroutine. (See below for details on how to use the -C<&wanted> function). Additionally, for each directory found, it will -C<chdir()> into that directory and continue the search, invoking the -C<&wanted> function on each file or subdirectory in the directory. - -=item B<finddepth> - - finddepth(\&wanted, @directories); - finddepth(\%options, @directories); - -C<finddepth()> works just like C<find()> except that it invokes the -C<&wanted> function for a directory I<after> invoking it for the -directory's contents. It does a postorder traversal instead of a -preorder traversal, working from the bottom of the directory tree up -where C<find()> works from the top of the tree down. - -=back - -=head2 %options - -The first argument to C<find()> is either a code reference to your -C<&wanted> function, or a hash reference describing the operations -to be performed for each file. The -code reference is described in L<The wanted function> below. - -Here are the possible keys for the hash: - -=over 3 - -=item C<wanted> - -The value should be a code reference. This code reference is -described in L<The wanted function> below. The C<&wanted> subroutine is -mandatory. - -=item C<bydepth> - -Reports the name of a directory only AFTER all its entries -have been reported. Entry point C<finddepth()> is a shortcut for -specifying C<< { bydepth => 1 } >> in the first argument of C<find()>. - -=item C<preprocess> - -The value should be a code reference. This code reference is used to -preprocess the current directory. The name of the currently processed -directory is in C<$File::Find::dir>. Your preprocessing function is -called after C<readdir()>, but before the loop that calls the C<wanted()> -function. It is called with a list of strings (actually file/directory -names) and is expected to return a list of strings. The code can be -used to sort the file/directory names alphabetically, numerically, -or to filter out directory entries based on their name alone. When -I<follow> or I<follow_fast> are in effect, C<preprocess> is a no-op. - -=item C<postprocess> - -The value should be a code reference. It is invoked just before leaving -the currently processed directory. It is called in void context with no -arguments. The name of the current directory is in C<$File::Find::dir>. This -hook is handy for summarizing a directory, such as calculating its disk -usage. When I<follow> or I<follow_fast> are in effect, C<postprocess> is a -no-op. - -=item C<follow> - -Causes symbolic links to be followed. Since directory trees with symbolic -links (followed) may contain files more than once and may even have -cycles, a hash has to be built up with an entry for each file. -This might be expensive both in space and time for a large -directory tree. See L</follow_fast> and L</follow_skip> below. -If either I<follow> or I<follow_fast> is in effect: - -=over 6 - -=item * - -It is guaranteed that an I<lstat> has been called before the user's -C<wanted()> function is called. This enables fast file checks involving S<_>. -Note that this guarantee no longer holds if I<follow> or I<follow_fast> -are not set. - -=item * - -There is a variable C<$File::Find::fullname> which holds the absolute -pathname of the file with all symbolic links resolved. If the link is -a dangling symbolic link, then fullname will be set to C<undef>. - -=back - -This is a no-op on Win32. - -=item C<follow_fast> - -This is similar to I<follow> except that it may report some files more -than once. It does detect cycles, however. Since only symbolic links -have to be hashed, this is much cheaper both in space and time. If -processing a file more than once (by the user's C<wanted()> function) -is worse than just taking time, the option I<follow> should be used. - -This is also a no-op on Win32. - -=item C<follow_skip> - -C<follow_skip==1>, which is the default, causes all files which are -neither directories nor symbolic links to be ignored if they are about -to be processed a second time. If a directory or a symbolic link -are about to be processed a second time, File::Find dies. - -C<follow_skip==0> causes File::Find to die if any file is about to be -processed a second time. - -C<follow_skip==2> causes File::Find to ignore any duplicate files and -directories but to proceed normally otherwise. - -=item C<dangling_symlinks> - -If true and a code reference, will be called with the symbolic link -name and the directory it lives in as arguments. Otherwise, if true -and warnings are on, warning "symbolic_link_name is a dangling -symbolic link\n" will be issued. If false, the dangling symbolic link -will be silently ignored. - -=item C<no_chdir> - -Does not C<chdir()> to each directory as it recurses. The C<wanted()> -function will need to be aware of this, of course. In this case, -C<$_> will be the same as C<$File::Find::name>. - -=item C<untaint> - -If find is used in taint-mode (-T command line switch or if EUID != UID -or if EGID != GID) then internally directory names have to be untainted -before they can be chdir'ed to. Therefore they are checked against a regular -expression I<untaint_pattern>. Note that all names passed to the user's -I<wanted()> function are still tainted. If this option is used while -not in taint-mode, C<untaint> is a no-op. - -=item C<untaint_pattern> - -See above. This should be set using the C<qr> quoting operator. -The default is set to C<qr|^([-+@\w./]+)$|>. -Note that the parentheses are vital. - -=item C<untaint_skip> - -If set, a directory which fails the I<untaint_pattern> is skipped, -including all its sub-directories. The default is to 'die' in such a case. - -=back - -=head2 The wanted function - -The C<wanted()> function does whatever verifications you want on -each file and directory. Note that despite its name, the C<wanted()> -function is a generic callback function, and does B<not> tell -File::Find if a file is "wanted" or not. In fact, its return value -is ignored. - -The wanted function takes no arguments but rather does its work -through a collection of variables. - -=over 4 - -=item C<$File::Find::dir> is the current directory name, - -=item C<$_> is the current filename within that directory - -=item C<$File::Find::name> is the complete pathname to the file. - -=back - -The above variables have all been localized and may be changed without -affecting data outside of the wanted function. - -For example, when examining the file F</some/path/foo.ext> you will have: - - $File::Find::dir = /some/path/ - $_ = foo.ext - $File::Find::name = /some/path/foo.ext - -You are chdir()'d to C<$File::Find::dir> when the function is called, -unless C<no_chdir> was specified. Note that when changing to -directories is in effect the root directory (F</>) is a somewhat -special case inasmuch as the concatenation of C<$File::Find::dir>, -C<'/'> and C<$_> is not literally equal to C<$File::Find::name>. The -table below summarizes all variants: - - $File::Find::name $File::Find::dir $_ - default / / . - no_chdir=>0 /etc / etc - /etc/x /etc x - - no_chdir=>1 / / / - /etc / /etc - /etc/x /etc /etc/x - - -When C<follow> or C<follow_fast> are in effect, there is -also a C<$File::Find::fullname>. The function may set -C<$File::Find::prune> to prune the tree unless C<bydepth> was -specified. Unless C<follow> or C<follow_fast> is specified, for -compatibility reasons (find.pl, find2perl) there are in addition the -following globals available: C<$File::Find::topdir>, -C<$File::Find::topdev>, C<$File::Find::topino>, -C<$File::Find::topmode> and C<$File::Find::topnlink>. - -This library is useful for the C<find2perl> tool, which when fed, - - find2perl / -name .nfs\* -mtime +7 \ - -exec rm -f {} \; -o -fstype nfs -prune - -produces something like: - - sub wanted { - /^\.nfs.*\z/s && - (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_)) && - int(-M _) > 7 && - unlink($_) - || - ($nlink || (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_))) && - $dev < 0 && - ($File::Find::prune = 1); - } - -Notice the C<_> in the above C<int(-M _)>: the C<_> is a magical -filehandle that caches the information from the preceding -C<stat()>, C<lstat()>, or filetest. - -Here's another interesting wanted function. It will find all symbolic -links that don't resolve: - - sub wanted { - -l && !-e && print "bogus link: $File::Find::name\n"; - } - -Note that you may mix directories and (non-directory) files in the list of -directories to be searched by the C<wanted()> function. - - find(\&wanted, "./foo", "./bar", "./baz/epsilon"); - -In the example above, no file in F<./baz/> other than F<./baz/epsilon> will be -evaluated by C<wanted()>. - -See also the script C<pfind> on CPAN for a nice application of this -module. - -=head1 WARNINGS - -If you run your program with the C<-w> switch, or if you use the -C<warnings> pragma, File::Find will report warnings for several weird -situations. You can disable these warnings by putting the statement - - no warnings 'File::Find'; - -in the appropriate scope. See L<perllexwarn> for more info about lexical -warnings. - -=head1 CAVEAT - -=over 2 - -=item $dont_use_nlink - -You can set the variable C<$File::Find::dont_use_nlink> to 1, if you want to -force File::Find to always stat directories. This was used for file systems -that do not have an C<nlink> count matching the number of sub-directories. -Examples are ISO-9660 (CD-ROM), AFS, HPFS (OS/2 file system), FAT (DOS file -system) and a couple of others. - -You shouldn't need to set this variable, since File::Find should now detect -such file systems on-the-fly and switch itself to using stat. This works even -for parts of your file system, like a mounted CD-ROM. - -If you do set C<$File::Find::dont_use_nlink> to 1, you will notice slow-downs. - -=item symlinks - -Be aware that the option to follow symbolic links can be dangerous. -Depending on the structure of the directory tree (including symbolic -links to directories) you might traverse a given (physical) directory -more than once (only if C<follow_fast> is in effect). -Furthermore, deleting or changing files in a symbolically linked directory -might cause very unpleasant surprises, since you delete or change files -in an unknown directory. - -=back - -=head1 BUGS AND CAVEATS - -Despite the name of the C<finddepth()> function, both C<find()> and -C<finddepth()> perform a depth-first search of the directory -hierarchy. - -=head1 HISTORY - -File::Find used to produce incorrect results if called recursively. -During the development of perl 5.8 this bug was fixed. -The first fixed version of File::Find was 1.01. - -=head1 SEE ALSO - -find, find2perl. - -=cut - -our @ISA = qw(Exporter); -our @EXPORT = qw(find finddepth); - - -use strict; -my $Is_VMS; -my $Is_Win32; - -require File::Basename; -require File::Spec; - -# Should ideally be my() not our() but local() currently -# refuses to operate on lexicals - -our %SLnkSeen; -our ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow, - $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat, - $pre_process, $post_process, $dangling_symlinks); - -sub contract_name { - my ($cdir,$fn) = @_; - - return substr($cdir,0,rindex($cdir,'/')) if $fn eq $File::Find::current_dir; - - $cdir = substr($cdir,0,rindex($cdir,'/')+1); - - $fn =~ s|^\./||; - - my $abs_name= $cdir . $fn; - - if (substr($fn,0,3) eq '../') { - 1 while $abs_name =~ s!/[^/]*/\.\./+!/!; - } - - return $abs_name; -} - -sub PathCombine($$) { - my ($Base,$Name) = @_; - my $AbsName; - - if (substr($Name,0,1) eq '/') { - $AbsName= $Name; - } - else { - $AbsName= contract_name($Base,$Name); - } - - # (simple) check for recursion - my $newlen= length($AbsName); - if ($newlen <= length($Base)) { - if (($newlen == length($Base) || substr($Base,$newlen,1) eq '/') - && $AbsName eq substr($Base,0,$newlen)) - { - return undef; - } - } - return $AbsName; -} - -sub Follow_SymLink($) { - my ($AbsName) = @_; - - my ($NewName,$DEV, $INO); - ($DEV, $INO)= lstat $AbsName; - - while (-l _) { - if ($SLnkSeen{$DEV, $INO}++) { - if ($follow_skip < 2) { - die "$AbsName is encountered a second time"; - } - else { - return undef; - } - } - $NewName= PathCombine($AbsName, readlink($AbsName)); - unless(defined $NewName) { - if ($follow_skip < 2) { - die "$AbsName is a recursive symbolic link"; - } - else { - return undef; - } - } - else { - $AbsName= $NewName; - } - ($DEV, $INO) = lstat($AbsName); - return undef unless defined $DEV; # dangling symbolic link - } - - if ($full_check && defined $DEV && $SLnkSeen{$DEV, $INO}++) { - if ( ($follow_skip < 1) || ((-d _) && ($follow_skip < 2)) ) { - die "$AbsName encountered a second time"; - } - else { - return undef; - } - } - - return $AbsName; -} - -our($dir, $name, $fullname, $prune); -sub _find_dir_symlnk($$$); -sub _find_dir($$$); - -# check whether or not a scalar variable is tainted -# (code straight from the Camel, 3rd ed., page 561) -sub is_tainted_pp { - my $arg = shift; - my $nada = substr($arg, 0, 0); # zero-length - local $@; - eval { eval "# $nada" }; - return length($@) != 0; -} - -sub _find_opt { - my $wanted = shift; - die "invalid top directory" unless defined $_[0]; - - # This function must local()ize everything because callbacks may - # call find() or finddepth() - - local %SLnkSeen; - local ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow, - $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat, - $pre_process, $post_process, $dangling_symlinks); - local($dir, $name, $fullname, $prune); - local *_ = \my $a; - - my $cwd = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::getcwd(); - if ($Is_VMS) { - # VMS returns this by default in VMS format which just doesn't - # work for the rest of this module. - $cwd = VMS::Filespec::unixpath($cwd); - - # Apparently this is not expected to have a trailing space. - # To attempt to make VMS/UNIX conversions mostly reversible, - # a trailing slash is needed. The run-time functions ignore the - # resulting double slash, but it causes the perl tests to fail. - $cwd =~ s#/\z##; - - # This comes up in upper case now, but should be lower. - # In the future this could be exact case, no need to change. - } - my $cwd_untainted = $cwd; - my $check_t_cwd = 1; - $wanted_callback = $wanted->{wanted}; - $bydepth = $wanted->{bydepth}; - $pre_process = $wanted->{preprocess}; - $post_process = $wanted->{postprocess}; - $no_chdir = $wanted->{no_chdir}; - $full_check = $Is_Win32 ? 0 : $wanted->{follow}; - $follow = $Is_Win32 ? 0 : - $full_check || $wanted->{follow_fast}; - $follow_skip = $wanted->{follow_skip}; - $untaint = $wanted->{untaint}; - $untaint_pat = $wanted->{untaint_pattern}; - $untaint_skip = $wanted->{untaint_skip}; - $dangling_symlinks = $wanted->{dangling_symlinks}; - - # for compatibility reasons (find.pl, find2perl) - local our ($topdir, $topdev, $topino, $topmode, $topnlink); - - # a symbolic link to a directory doesn't increase the link count - $avoid_nlink = $follow || $File::Find::dont_use_nlink; - - my ($abs_dir, $Is_Dir); - - Proc_Top_Item: - foreach my $TOP (@_) { - my $top_item = $TOP; - $top_item = VMS::Filespec::unixify($top_item) if $Is_VMS; - - ($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 '/'; - } - - $Is_Dir= 0; - - if ($follow) { - - if (substr($top_item,0,1) eq '/') { - $abs_dir = $top_item; - } - elsif ($top_item eq $File::Find::current_dir) { - $abs_dir = $cwd; - } - else { # care about any ../ - $top_item =~ s/\.dir\z//i if $Is_VMS; - $abs_dir = contract_name("$cwd/",$top_item); - } - $abs_dir= Follow_SymLink($abs_dir); - unless (defined $abs_dir) { - if ($dangling_symlinks) { - if (ref $dangling_symlinks eq 'CODE') { - $dangling_symlinks->($top_item, $cwd); - } else { - warnings::warnif "$top_item is a dangling symbolic link\n"; - } - } - next Proc_Top_Item; - } - - if (-d _) { - $top_item =~ s/\.dir\z//i if $Is_VMS; - _find_dir_symlnk($wanted, $abs_dir, $top_item); - $Is_Dir= 1; - } - } - else { # no follow - $topdir = $top_item; - unless (defined $topnlink) { - warnings::warnif "Can't stat $top_item: $!\n"; - next Proc_Top_Item; - } - if (-d _) { - $top_item =~ s/\.dir\z//i if $Is_VMS; - _find_dir($wanted, $top_item, $topnlink); - $Is_Dir= 1; - } - else { - $abs_dir= $top_item; - } - } - - unless ($Is_Dir) { - unless (($_,$dir) = File::Basename::fileparse($abs_dir)) { - ($dir,$_) = ('./', $top_item); - } - - $abs_dir = $dir; - if (( $untaint ) && (is_tainted($dir) )) { - ( $abs_dir ) = $dir =~ m|$untaint_pat|; - unless (defined $abs_dir) { - if ($untaint_skip == 0) { - die "directory $dir is still tainted"; - } - else { - next Proc_Top_Item; - } - } - } - - unless ($no_chdir || chdir $abs_dir) { - warnings::warnif "Couldn't chdir $abs_dir: $!\n"; - next Proc_Top_Item; - } - - $name = $abs_dir . $_; # $File::Find::name - $_ = $name if $no_chdir; - - { $wanted_callback->() }; # protect against wild "next" - - } - - unless ( $no_chdir ) { - if ( ($check_t_cwd) && (($untaint) && (is_tainted($cwd) )) ) { - ( $cwd_untainted ) = $cwd =~ m|$untaint_pat|; - unless (defined $cwd_untainted) { - die "insecure cwd in find(depth)"; - } - $check_t_cwd = 0; - } - unless (chdir $cwd_untainted) { - die "Can't cd to $cwd: $!\n"; - } - } - } -} - -# API: -# $wanted -# $p_dir : "parent directory" -# $nlink : what came back from the stat -# preconditions: -# chdir (if not no_chdir) to dir - -sub _find_dir($$$) { - my ($wanted, $p_dir, $nlink) = @_; - my ($CdLvl,$Level) = (0,0); - my @Stack; - my @filenames; - my ($subcount,$sub_nlink); - my $SE= []; - my $dir_name= $p_dir; - my $dir_pref; - my $dir_rel = $File::Find::current_dir; - my $tainted = 0; - my $no_nlink; - - if ($Is_Win32) { - $dir_pref - = ($p_dir =~ m{^(?:\w:[/\\]?|[/\\])$} ? $p_dir : "$p_dir/" ); - } elsif ($Is_VMS) { - - # VMS is returning trailing .dir on directories - # and trailing . on files and symbolic links - # in UNIX syntax. - # - - $p_dir =~ s/\.(dir)?$//i unless $p_dir eq '.'; - - $dir_pref = ($p_dir =~ m/[\]>]+$/ ? $p_dir : "$p_dir/" ); - } - else { - $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" ); - } - - local ($dir, $name, $prune, *DIR); - - unless ( $no_chdir || ($p_dir eq $File::Find::current_dir)) { - my $udir = $p_dir; - if (( $untaint ) && (is_tainted($p_dir) )) { - ( $udir ) = $p_dir =~ m|$untaint_pat|; - unless (defined $udir) { - if ($untaint_skip == 0) { - die "directory $p_dir is still tainted"; - } - else { - return; - } - } - } - unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) { - warnings::warnif "Can't cd to $udir: $!\n"; - return; - } - } - - # push the starting directory - push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth; - - while (defined $SE) { - unless ($bydepth) { - $dir= $p_dir; # $File::Find::dir - $name= $dir_name; # $File::Find::name - $_= ($no_chdir ? $dir_name : $dir_rel ); # $_ - # prune may happen here - $prune= 0; - { $wanted_callback->() }; # protect against wild "next" - next if $prune; - } - - # change to that directory - unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) { - my $udir= $dir_rel; - if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_rel) )) ) { - ( $udir ) = $dir_rel =~ m|$untaint_pat|; - unless (defined $udir) { - if ($untaint_skip == 0) { - die "directory (" . ($p_dir ne '/' ? $p_dir : '') . "/) $dir_rel is still tainted"; - } else { # $untaint_skip == 1 - next; - } - } - } - unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) { - warnings::warnif "Can't cd to (" . - ($p_dir ne '/' ? $p_dir : '') . "/) $udir: $!\n"; - next; - } - $CdLvl++; - } - - $dir= $dir_name; # $File::Find::dir - - # Get the list of files in the current directory. - unless (opendir DIR, ($no_chdir ? $dir_name : $File::Find::current_dir)) { - warnings::warnif "Can't opendir($dir_name): $!\n"; - next; - } - @filenames = readdir DIR; - closedir(DIR); - @filenames = $pre_process->(@filenames) if $pre_process; - push @Stack,[$CdLvl,$dir_name,"",-2] if $post_process; - - # default: use whatever was specified - # (if $nlink >= 2, and $avoid_nlink == 0, this will switch back) - $no_nlink = $avoid_nlink; - # if dir has wrong nlink count, force switch to slower stat method - $no_nlink = 1 if ($nlink < 2); - - if ($nlink == 2 && !$no_nlink) { - # This dir has no subdirectories. - for my $FN (@filenames) { - if ($Is_VMS) { - # Big hammer here - Compensate for VMS trailing . and .dir - # No win situation until this is changed, but this - # will handle the majority of the cases with breaking the fewest - - $FN =~ s/\.dir\z//i; - $FN =~ s#\.$## if ($FN ne '.'); - } - next if $FN =~ $File::Find::skip_pattern; - - $name = $dir_pref . $FN; # $File::Find::name - $_ = ($no_chdir ? $name : $FN); # $_ - { $wanted_callback->() }; # protect against wild "next" - } - - } - else { - # This dir has subdirectories. - $subcount = $nlink - 2; - - # HACK: insert directories at this position. so as to preserve - # the user pre-processed ordering of files. - # EG: directory traversal is in user sorted order, not at random. - my $stack_top = @Stack; - - for my $FN (@filenames) { - next if $FN =~ $File::Find::skip_pattern; - if ($subcount > 0 || $no_nlink) { - # Seen all the subdirs? - # check for directoriness. - # stat is faster for a file in the current directory - $sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3]; - - if (-d _) { - --$subcount; - $FN =~ s/\.dir\z//i if $Is_VMS; - # HACK: replace push to preserve dir traversal order - #push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink]; - splice @Stack, $stack_top, 0, - [$CdLvl,$dir_name,$FN,$sub_nlink]; - } - else { - $name = $dir_pref . $FN; # $File::Find::name - $_= ($no_chdir ? $name : $FN); # $_ - { $wanted_callback->() }; # protect against wild "next" - } - } - else { - $name = $dir_pref . $FN; # $File::Find::name - $_= ($no_chdir ? $name : $FN); # $_ - { $wanted_callback->() }; # protect against wild "next" - } - } - } - } - continue { - while ( defined ($SE = pop @Stack) ) { - ($Level, $p_dir, $dir_rel, $nlink) = @$SE; - if ($CdLvl > $Level && !$no_chdir) { - my $tmp; - if ($Is_VMS) { - $tmp = '[' . ('-' x ($CdLvl-$Level)) . ']'; - } - else { - $tmp = join('/',('..') x ($CdLvl-$Level)); - } - die "Can't cd to $tmp from $dir_name" - unless chdir ($tmp); - $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 ($p_dir =~ m/[\]>]+$/) { - $dir_name = $p_dir; - $dir_name =~ s/([\]>]+)$/.$dir_rel$1/; - $dir_pref = $dir_name; - } - else { - $dir_name = "$p_dir/$dir_rel"; - $dir_pref = "$dir_name/"; - } - } - else { - $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel"); - $dir_pref = "$dir_name/"; - } - - if ( $nlink == -2 ) { - $name = $dir = $p_dir; # $File::Find::name / dir - $_ = $File::Find::current_dir; - $post_process->(); # End-of-directory processing - } - elsif ( $nlink < 0 ) { # must be finddepth, report dirname now - $name = $dir_name; - if ( substr($name,-2) eq '/.' ) { - substr($name, length($name) == 2 ? -1 : -2) = ''; - } - $dir = $p_dir; - $_ = ($no_chdir ? $dir_name : $dir_rel ); - if ( substr($_,-2) eq '/.' ) { - substr($_, length($_) == 2 ? -1 : -2) = ''; - } - { $wanted_callback->() }; # protect against wild "next" - } - else { - push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth; - last; - } - } - } -} - - -# API: -# $wanted -# $dir_loc : absolute location of a dir -# $p_dir : "parent directory" -# preconditions: -# chdir (if not no_chdir) to dir - -sub _find_dir_symlnk($$$) { - my ($wanted, $dir_loc, $p_dir) = @_; # $dir_loc is the absolute directory - my @Stack; - my @filenames; - my $new_loc; - my $updir_loc = $dir_loc; # untainted parent directory - my $SE = []; - my $dir_name = $p_dir; - my $dir_pref; - my $loc_pref; - my $dir_rel = $File::Find::current_dir; - my $byd_flag; # flag for pending stack entry if $bydepth - my $tainted = 0; - my $ok = 1; - - $dir_pref = ( $p_dir eq '/' ? '/' : "$p_dir/" ); - $loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" ); - - local ($dir, $name, $fullname, $prune, *DIR); - - unless ($no_chdir) { - # untaint the topdir - if (( $untaint ) && (is_tainted($dir_loc) )) { - ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|; # parent dir, now untainted - # once untainted, $updir_loc is pushed on the stack (as parent directory); - # hence, we don't need to untaint the parent directory every time we chdir - # to it later - unless (defined $updir_loc) { - if ($untaint_skip == 0) { - die "directory $dir_loc is still tainted"; - } - else { - return; - } - } - } - $ok = chdir($updir_loc) unless ($p_dir eq $File::Find::current_dir); - unless ($ok) { - warnings::warnif "Can't cd to $updir_loc: $!\n"; - return; - } - } - - push @Stack,[$dir_loc,$updir_loc,$p_dir,$dir_rel,-1] if $bydepth; - - while (defined $SE) { - - unless ($bydepth) { - # change (back) to parent directory (always untainted) - unless ($no_chdir) { - unless (chdir $updir_loc) { - warnings::warnif "Can't cd to $updir_loc: $!\n"; - next; - } - } - $dir= $p_dir; # $File::Find::dir - $name= $dir_name; # $File::Find::name - $_= ($no_chdir ? $dir_name : $dir_rel ); # $_ - $fullname= $dir_loc; # $File::Find::fullname - # prune may happen here - $prune= 0; - lstat($_); # make sure file tests with '_' work - { $wanted_callback->() }; # protect against wild "next" - next if $prune; - } - - # change to that directory - unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) { - $updir_loc = $dir_loc; - if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_loc) )) ) { - # untaint $dir_loc, what will be pushed on the stack as (untainted) parent dir - ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|; - unless (defined $updir_loc) { - if ($untaint_skip == 0) { - die "directory $dir_loc is still tainted"; - } - else { - next; - } - } - } - unless (chdir $updir_loc) { - warnings::warnif "Can't cd to $updir_loc: $!\n"; - next; - } - } - - $dir = $dir_name; # $File::Find::dir - - # Get the list of files in the current directory. - unless (opendir DIR, ($no_chdir ? $dir_loc : $File::Find::current_dir)) { - warnings::warnif "Can't opendir($dir_loc): $!\n"; - next; - } - @filenames = readdir DIR; - closedir(DIR); - - for my $FN (@filenames) { - if ($Is_VMS) { - # Big hammer here - Compensate for VMS trailing . and .dir - # No win situation until this is changed, but this - # will handle the majority of the cases with breaking the fewest. - - $FN =~ s/\.dir\z//i; - $FN =~ s#\.$## if ($FN ne '.'); - } - next if $FN =~ $File::Find::skip_pattern; - - # follow symbolic links / do an lstat - $new_loc = Follow_SymLink($loc_pref.$FN); - - # ignore if invalid symlink - unless (defined $new_loc) { - if (!defined -l _ && $dangling_symlinks) { - if (ref $dangling_symlinks eq 'CODE') { - $dangling_symlinks->($FN, $dir_pref); - } else { - warnings::warnif "$dir_pref$FN is a dangling symbolic link\n"; - } - } - - $fullname = undef; - $name = $dir_pref . $FN; - $_ = ($no_chdir ? $name : $FN); - { $wanted_callback->() }; - next; - } - - if (-d _) { - if ($Is_VMS) { - $FN =~ s/\.dir\z//i; - $FN =~ s#\.$## if ($FN ne '.'); - $new_loc =~ s/\.dir\z//i; - $new_loc =~ s#\.$## if ($new_loc ne '.'); - } - push @Stack,[$new_loc,$updir_loc,$dir_name,$FN,1]; - } - else { - $fullname = $new_loc; # $File::Find::fullname - $name = $dir_pref . $FN; # $File::Find::name - $_ = ($no_chdir ? $name : $FN); # $_ - { $wanted_callback->() }; # protect against wild "next" - } - } - - } - 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_pref = "$dir_name/"; - $loc_pref = "$dir_loc/"; - if ( $byd_flag < 0 ) { # must be finddepth, report dirname now - unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) { - unless (chdir $updir_loc) { # $updir_loc (parent dir) is always untainted - warnings::warnif "Can't cd to $updir_loc: $!\n"; - next; - } - } - $fullname = $dir_loc; # $File::Find::fullname - $name = $dir_name; # $File::Find::name - if ( substr($name,-2) eq '/.' ) { - substr($name, length($name) == 2 ? -1 : -2) = ''; # $File::Find::name - } - $dir = $p_dir; # $File::Find::dir - $_ = ($no_chdir ? $dir_name : $dir_rel); # $_ - if ( substr($_,-2) eq '/.' ) { - substr($_, length($_) == 2 ? -1 : -2) = ''; - } - - lstat($_); # make sure file tests with '_' work - { $wanted_callback->() }; # protect against wild "next" - } - else { - push @Stack,[$dir_loc, $updir_loc, $p_dir, $dir_rel,-1] if $bydepth; - last; - } - } - } -} - - -sub wrap_wanted { - my $wanted = shift; - if ( ref($wanted) eq 'HASH' ) { - unless( exists $wanted->{wanted} and ref( $wanted->{wanted} ) eq 'CODE' ) { - die 'no &wanted subroutine given'; - } - if ( $wanted->{follow} || $wanted->{follow_fast}) { - $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip}; - } - if ( $wanted->{untaint} ) { - $wanted->{untaint_pattern} = $File::Find::untaint_pattern - unless defined $wanted->{untaint_pattern}; - $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip}; - } - return $wanted; - } - elsif( ref( $wanted ) eq 'CODE' ) { - return { wanted => $wanted }; - } - else { - die 'no &wanted subroutine given'; - } -} - -sub find { - my $wanted = shift; - _find_opt(wrap_wanted($wanted), @_); -} - -sub finddepth { - my $wanted = wrap_wanted(shift); - $wanted->{bydepth} = 1; - _find_opt($wanted, @_); -} - -# default -$File::Find::skip_pattern = qr/^\.{1,2}\z/; -$File::Find::untaint_pattern = qr|^([-+@\w./]+)$|; - -# These are hard-coded for now, but may move to hint files. -if ($^O eq 'VMS') { - $Is_VMS = 1; - $File::Find::dont_use_nlink = 1; -} -elsif ($^O eq 'MSWin32') { - $Is_Win32 = 1; -} - -# this _should_ work properly on all platforms -# where File::Find can be expected to work -$File::Find::current_dir = File::Spec->curdir || '.'; - -$File::Find::dont_use_nlink = 1 - if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $Is_Win32 || - $^O eq 'interix' || $^O eq 'cygwin' || $^O eq 'qnx' || $^O eq 'nto'; - -# Set dont_use_nlink in your hint file if your system's stat doesn't -# report the number of links in a directory as an indication -# of the number of files. -# See, e.g. hints/machten.sh for MachTen 2.2. -unless ($File::Find::dont_use_nlink) { - require Config; - $File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'}); -} - -# We need a function that checks if a scalar is tainted. Either use the -# Scalar::Util module's tainted() function or our (slower) pure Perl -# fallback is_tainted_pp() -{ - local $@; - eval { require Scalar::Util }; - *is_tainted = $@ ? \&is_tainted_pp : \&Scalar::Util::tainted; -} - -1; diff --git a/lib/File/Find/t/find.t b/lib/File/Find/t/find.t deleted file mode 100644 index 62ec81e947..0000000000 --- a/lib/File/Find/t/find.t +++ /dev/null @@ -1,977 +0,0 @@ -#!./perl -use strict; -use Cwd; - -my %Expect_File = (); # what we expect for $_ -my %Expect_Name = (); # what we expect for $File::Find::name/fullname -my %Expect_Dir = (); # what we expect for $File::Find::dir -my $symlink_exists = eval { symlink("",""); 1 }; -my ($warn_msg, @files, $file); - - -BEGIN { - require File::Spec; - if ($ENV{PERL_CORE}) { - # May be doing dynamic loading while @INC is all relative - @INC = map { $_ = File::Spec->rel2abs($_); /(.*)/; $1 } @INC; - } - $SIG{'__WARN__'} = sub { $warn_msg = $_[0]; warn "# $_[0]"; }; - - if ($^O eq 'MSWin32' || $^O eq 'cygwin' || $^O eq 'VMS') { - # This is a hack - at present File::Find does not produce native names - # on Win32 or VMS, so force File::Spec to use Unix names. - # must be set *before* importing File::Find - require File::Spec::Unix; - @File::Spec::ISA = 'File::Spec::Unix'; - } - require File::Find; - import File::Find; -} - -my $test_count = 98; -$test_count += 119 if $symlink_exists; -$test_count += 26 if $^O eq 'MSWin32'; -$test_count += 2 if $^O eq 'MSWin32' and $symlink_exists; - -print "1..$test_count\n"; -#if ( $symlink_exists ) { print "1..199\n"; } -#else { print "1..85\n"; } - -my $orig_dir = cwd(); - -# Uncomment this to see where File::Find is chdir'ing to. Helpful for -# debugging its little jaunts around the filesystem. -# BEGIN { -# use Cwd; -# *CORE::GLOBAL::chdir = sub ($) { -# my($file, $line) = (caller)[1,2]; -# -# printf "# cwd: %s\n", cwd(); -# print "# chdir: @_ from $file at $line\n"; -# my($return) = CORE::chdir($_[0]); -# printf "# newcwd: %s\n", cwd(); -# -# return $return; -# }; -# } - -cleanup(); - -$::count_taint = 0; -find({wanted => sub { ++$::count_taint if $_ eq 'taint.t'; } }, - File::Spec->curdir); -if ($::count_taint == 1) { - print "ok 1\n"; -} else { - print "not ok 1 # found $::count_taint files named 'taint.t'\n"; -} - -$::count_taint = 0; -finddepth({wanted => sub { ++$::count_taint if $_ eq 'taint.t'; } }, - File::Spec->curdir); -if ($::count_taint == 1) { - print "ok 2\n"; -} else { - print "not ok 2 # found $::count_taint files named 'taint.t'\n"; -} - -my $case = 2; -my $FastFileTests_OK = 0; - -sub cleanup { - chdir($orig_dir); - my $need_updir = 0; - if (-d dir_path('for_find')) { - $need_updir = 1 if chdir(dir_path('for_find')); - } - if (-d dir_path('fa')) { - unlink file_path('fa', 'fa_ord'), - file_path('fa', 'fsl'), - file_path('fa', 'faa', 'faa_ord'), - file_path('fa', 'fab', 'fab_ord'), - file_path('fa', 'fab', 'faba', 'faba_ord'), - file_path('fa', 'fac', 'faca'), - file_path('fb', 'fb_ord'), - file_path('fb', 'fba', 'fba_ord'), - file_path('fb', 'fbc', 'fbca'); - rmdir dir_path('fa', 'faa'); - rmdir dir_path('fa', 'fab', 'faba'); - rmdir dir_path('fa', 'fab'); - rmdir dir_path('fa', 'fac'); - rmdir dir_path('fa'); - rmdir dir_path('fb', 'fba'); - rmdir dir_path('fb', 'fbc'); - rmdir dir_path('fb'); - } - if (-d dir_path('fc')) { - unlink ( - file_path('fc', 'fca', 'match_alpha'), - file_path('fc', 'fca', 'match_beta'), - file_path('fc', 'fcb', 'match_gamma'), - file_path('fc', 'fcb', 'delta'), - file_path('fc', 'fcc', 'match_epsilon'), - file_path('fc', 'fcc', 'match_zeta'), - file_path('fc', 'fcc', 'eta'), - ); - rmdir dir_path('fc', 'fca'); - rmdir dir_path('fc', 'fcb'); - rmdir dir_path('fc', 'fcc'); - rmdir dir_path('fc'); - } - if ($need_updir) { - my $updir = $^O eq 'VMS' ? File::Spec::VMS->updir() : File::Spec->updir; - chdir($updir); - } - if (-d dir_path('for_find')) { - rmdir dir_path('for_find') or print "# Can't rmdir for_find: $!\n"; - } -} - -END { - cleanup(); -} - -sub Check($) { - $case++; - if ($_[0]) { print "ok $case\n"; } - else { print "not ok $case\n"; } -} - -sub CheckDie($) { - $case++; - if ($_[0]) { print "ok $case\n"; } - else { print "not ok $case\n $!\n"; exit 0; } -} - -sub touch { - CheckDie( open(my $T,'>',$_[0]) ); -} - -sub MkDir($$) { - CheckDie( mkdir($_[0],$_[1]) ); -} - -sub wanted_File_Dir { - printf "# \$File::Find::dir => '$File::Find::dir'\t\$_ => '$_'\n"; - s#\.$## if ($^O eq 'VMS' && $_ ne '.'); - s/(.dir)?$//i if ($^O eq 'VMS' && -d _); - Check( $Expect_File{$_} ); - if ( $FastFileTests_OK ) { - delete $Expect_File{ $_} - unless ( $Expect_Dir{$_} && ! -d _ ); - } else { - delete $Expect_File{$_} - unless ( $Expect_Dir{$_} && ! -d $_ ); - } -} - -sub wanted_File_Dir_prune { - &wanted_File_Dir; - $File::Find::prune=1 if $_ eq 'faba'; -} - -sub wanted_Name { - my $n = $File::Find::name; - $n =~ s#\.$## if ($^O eq 'VMS' && $n ne '.'); - print "# \$File::Find::name => '$n'\n"; - my $i = rindex($n,'/'); - my $OK = exists($Expect_Name{$n}); - if ( $OK ) { - $OK= exists($Expect_Name{substr($n,0,$i)}) if $i >= 0; - } - Check($OK); - delete $Expect_Name{$n}; -} - -sub wanted_File { - print "# \$_ => '$_'\n"; - s#\.$## if ($^O eq 'VMS' && $_ ne '.'); - my $i = rindex($_,'/'); - my $OK = exists($Expect_File{ $_}); - if ( $OK ) { - $OK= exists($Expect_File{ substr($_,0,$i)}) if $i >= 0; - } - Check($OK); - delete $Expect_File{ $_}; -} - -sub simple_wanted { - print "# \$File::Find::dir => '$File::Find::dir'\n"; - print "# \$_ => '$_'\n"; -} - -sub noop_wanted {} - -sub my_preprocess { - @files = @_; - print "# --preprocess--\n"; - print "# \$File::Find::dir => '$File::Find::dir' \n"; - foreach $file (@files) { - $file =~ s/\.(dir)?$//i if $^O eq 'VMS'; - print "# $file \n"; - delete $Expect_Dir{ $File::Find::dir }->{$file}; - } - print "# --end preprocess--\n"; - Check(scalar(keys %{$Expect_Dir{ $File::Find::dir }}) == 0); - if (scalar(keys %{$Expect_Dir{ $File::Find::dir }}) == 0) { - delete $Expect_Dir{ $File::Find::dir } - } - return @files; -} - -sub my_postprocess { - print "# postprocess: \$File::Find::dir => '$File::Find::dir' \n"; - delete $Expect_Dir{ $File::Find::dir}; -} - - -# Use dir_path() to specify a directory path that's expected for -# $File::Find::dir (%Expect_Dir). Also use it in file operations like -# chdir, rmdir etc. -# -# dir_path() concatenates directory names to form a *relative* -# directory path, independent from the platform it's run on, although -# there are limitations. Don't try to create an absolute path, -# because that may fail on operating systems that have the concept of -# volume names (e.g. Mac OS). As a special case, you can pass it a "." -# as first argument, to create a directory path like "./fa/dir". If there's -# no second argument, this function will return "./" - -sub dir_path { - my $first_arg = shift @_; - - if ($first_arg eq '.') { - return './' unless @_; - my $path = File::Spec->catdir(@_); - # add leading "./" - $path = "./$path"; - return $path; - } else { # $first_arg ne '.' - return $first_arg unless @_; # return plain filename - return File::Spec->catdir($first_arg, @_); # relative path - } -} - - -# Use topdir() to specify a directory path that you want to pass to -# find/finddepth. Historically topdir() differed on Mac OS classic. - -*topdir = \&dir_path; - - -# Use file_path() to specify a file path that's expected for $_ -# (%Expect_File). Also suitable for file operations like unlink etc. -# -# file_path() concatenates directory names (if any) and a filename to -# form a *relative* file path (the last argument is assumed to be a -# file). It's independent from the platform it's run on, although -# there are limitations. As a special case, you can pass it a "." as -# first argument, to create a file path like "./fa/file" on operating -# systems. If there's no second argument, this function will return the -# string "./" - -sub file_path { - my $first_arg = shift @_; - - if ($first_arg eq '.') { - return './' unless @_; - my $path = File::Spec->catfile(@_); - # add leading "./" - $path = "./$path"; - return $path; - } else { # $first_arg ne '.' - return $first_arg unless @_; # return plain filename - return File::Spec->catfile($first_arg, @_); # relative path - } -} - - -# Use file_path_name() to specify a file path that's expected for -# $File::Find::Name (%Expect_Name). Note: When the no_chdir => 1 -# option is in effect, $_ is the same as $File::Find::Name. In that -# case, also use this function to specify a file path that's expected -# for $_. -# -# Historically file_path_name differed on Mac OS classic. - -*file_path_name = \&file_path; - - - -MkDir( dir_path('for_find'), 0770 ); -CheckDie(chdir( dir_path('for_find'))); -MkDir( dir_path('fa'), 0770 ); -MkDir( dir_path('fb'), 0770 ); -touch( file_path('fb', 'fb_ord') ); -MkDir( dir_path('fb', 'fba'), 0770 ); -touch( file_path('fb', 'fba', 'fba_ord') ); -CheckDie( symlink('../fb','fa/fsl') ) if $symlink_exists; -touch( file_path('fa', 'fa_ord') ); - -MkDir( dir_path('fa', 'faa'), 0770 ); -touch( file_path('fa', 'faa', 'faa_ord') ); -MkDir( dir_path('fa', 'fab'), 0770 ); -touch( file_path('fa', 'fab', 'fab_ord') ); -MkDir( dir_path('fa', 'fab', 'faba'), 0770 ); -touch( file_path('fa', 'fab', 'faba', 'faba_ord') ); - - -%Expect_File = (File::Spec->curdir => 1, file_path('fsl') => 1, - file_path('fa_ord') => 1, file_path('fab') => 1, - file_path('fab_ord') => 1, file_path('faba') => 1, - file_path('faa') => 1, file_path('faa_ord') => 1); - -delete $Expect_File{ file_path('fsl') } unless $symlink_exists; -%Expect_Name = (); - -%Expect_Dir = ( dir_path('fa') => 1, dir_path('faa') => 1, - dir_path('fab') => 1, dir_path('faba') => 1, - dir_path('fb') => 1, dir_path('fba') => 1); - -delete @Expect_Dir{ dir_path('fb'), dir_path('fba') } unless $symlink_exists; -File::Find::find( {wanted => \&wanted_File_Dir_prune}, topdir('fa') ); -Check( scalar(keys %Expect_File) == 0 ); - - -print "# check re-entrancy\n"; - -%Expect_File = (File::Spec->curdir => 1, file_path('fsl') => 1, - file_path('fa_ord') => 1, file_path('fab') => 1, - file_path('fab_ord') => 1, file_path('faba') => 1, - file_path('faa') => 1, file_path('faa_ord') => 1); - -delete $Expect_File{ file_path('fsl') } unless $symlink_exists; -%Expect_Name = (); - -%Expect_Dir = ( dir_path('fa') => 1, dir_path('faa') => 1, - dir_path('fab') => 1, dir_path('faba') => 1, - dir_path('fb') => 1, dir_path('fba') => 1); - -delete @Expect_Dir{ dir_path('fb'), dir_path('fba') } unless $symlink_exists; - -File::Find::find( {wanted => sub { wanted_File_Dir_prune(); - File::Find::find( {wanted => sub - {} }, File::Spec->curdir ); } }, - topdir('fa') ); - -Check( scalar(keys %Expect_File) == 0 ); - - -# no_chdir is in effect, hence we use file_path_name to specify the expected paths for %Expect_File - -%Expect_File = (file_path_name('fa') => 1, - file_path_name('fa', 'fsl') => 1, - file_path_name('fa', 'fa_ord') => 1, - file_path_name('fa', 'fab') => 1, - file_path_name('fa', 'fab', 'fab_ord') => 1, - file_path_name('fa', 'fab', 'faba') => 1, - file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1, - file_path_name('fa', 'faa') => 1, - file_path_name('fa', 'faa', 'faa_ord') => 1,); - -delete $Expect_File{ file_path_name('fa', 'fsl') } unless $symlink_exists; -%Expect_Name = (); - -%Expect_Dir = (dir_path('fa') => 1, - dir_path('fa', 'faa') => 1, - dir_path('fa', 'fab') => 1, - dir_path('fa', 'fab', 'faba') => 1, - dir_path('fb') => 1, - dir_path('fb', 'fba') => 1); - -delete @Expect_Dir{ dir_path('fb'), dir_path('fb', 'fba') } - unless $symlink_exists; - -File::Find::find( {wanted => \&wanted_File_Dir, no_chdir => 1}, - topdir('fa') ); Check( scalar(keys %Expect_File) == 0 ); - - -%Expect_File = (); - -%Expect_Name = (File::Spec->curdir => 1, - file_path_name('.', 'fa') => 1, - file_path_name('.', 'fa', 'fsl') => 1, - file_path_name('.', 'fa', 'fa_ord') => 1, - file_path_name('.', 'fa', 'fab') => 1, - file_path_name('.', 'fa', 'fab', 'fab_ord') => 1, - file_path_name('.', 'fa', 'fab', 'faba') => 1, - file_path_name('.', 'fa', 'fab', 'faba', 'faba_ord') => 1, - file_path_name('.', 'fa', 'faa') => 1, - file_path_name('.', 'fa', 'faa', 'faa_ord') => 1, - file_path_name('.', 'fb') => 1, - file_path_name('.', 'fb', 'fba') => 1, - file_path_name('.', 'fb', 'fba', 'fba_ord') => 1, - file_path_name('.', 'fb', 'fb_ord') => 1); - -delete $Expect_Name{ file_path('.', 'fa', 'fsl') } unless $symlink_exists; -%Expect_Dir = (); -File::Find::finddepth( {wanted => \&wanted_Name}, File::Spec->curdir ); -Check( scalar(keys %Expect_Name) == 0 ); - - -# no_chdir is in effect, hence we use file_path_name to specify the -# expected paths for %Expect_File - -%Expect_File = (File::Spec->curdir => 1, - file_path_name('.', 'fa') => 1, - file_path_name('.', 'fa', 'fsl') => 1, - file_path_name('.', 'fa', 'fa_ord') => 1, - file_path_name('.', 'fa', 'fab') => 1, - file_path_name('.', 'fa', 'fab', 'fab_ord') => 1, - file_path_name('.', 'fa', 'fab', 'faba') => 1, - file_path_name('.', 'fa', 'fab', 'faba', 'faba_ord') => 1, - file_path_name('.', 'fa', 'faa') => 1, - file_path_name('.', 'fa', 'faa', 'faa_ord') => 1, - file_path_name('.', 'fb') => 1, - file_path_name('.', 'fb', 'fba') => 1, - file_path_name('.', 'fb', 'fba', 'fba_ord') => 1, - file_path_name('.', 'fb', 'fb_ord') => 1); - -delete $Expect_File{ file_path_name('.', 'fa', 'fsl') } unless $symlink_exists; -%Expect_Name = (); -%Expect_Dir = (); - -File::Find::finddepth( {wanted => \&wanted_File, no_chdir => 1}, - File::Spec->curdir ); - -Check( scalar(keys %Expect_File) == 0 ); - - -print "# check preprocess\n"; -%Expect_File = (); -%Expect_Name = (); -%Expect_Dir = ( - File::Spec->curdir => {fa => 1, fb => 1}, - dir_path('.', 'fa') => {faa => 1, fab => 1, fa_ord => 1}, - dir_path('.', 'fa', 'faa') => {faa_ord => 1}, - dir_path('.', 'fa', 'fab') => {faba => 1, fab_ord => 1}, - dir_path('.', 'fa', 'fab', 'faba') => {faba_ord => 1}, - dir_path('.', 'fb') => {fba => 1, fb_ord => 1}, - dir_path('.', 'fb', 'fba') => {fba_ord => 1} - ); - -File::Find::find( {wanted => \&noop_wanted, - preprocess => \&my_preprocess}, File::Spec->curdir ); - -Check( scalar(keys %Expect_Dir) == 0 ); - - -print "# check postprocess\n"; -%Expect_File = (); -%Expect_Name = (); -%Expect_Dir = ( - File::Spec->curdir => 1, - dir_path('.', 'fa') => 1, - dir_path('.', 'fa', 'faa') => 1, - dir_path('.', 'fa', 'fab') => 1, - dir_path('.', 'fa', 'fab', 'faba') => 1, - dir_path('.', 'fb') => 1, - dir_path('.', 'fb', 'fba') => 1 - ); - -File::Find::find( {wanted => \&noop_wanted, - postprocess => \&my_postprocess}, File::Spec->curdir ); - -Check( scalar(keys %Expect_Dir) == 0 ); - -{ - print "# checking argument localization\n"; - - ### this checks the fix of perlbug [19977] ### - my @foo = qw( a b c d e f ); - my %pre = map { $_ => } @foo; - - File::Find::find( sub { } , 'fa' ) for @foo; - delete $pre{$_} for @foo; - - Check( scalar( keys %pre ) == 0 ); -} - -# see thread starting -# http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2004-02/msg00351.html -{ - print "# checking that &_ and %_ are still accessible and that\n", - "# tie magic on \$_ is not triggered\n"; - - my $true_count; - my $sub = 0; - sub _ { - ++$sub; - } - my $tie_called = 0; - - package Foo; - sub STORE { - ++$tie_called; - } - sub FETCH {return 'N'}; - sub TIESCALAR {bless []}; - package main; - - Check( scalar( keys %_ ) == 0 ); - my @foo = 'n'; - tie $foo[0], "Foo"; - - File::Find::find( sub { $true_count++; $_{$_}++; &_; } , 'fa' ) for @foo; - untie $_; - - Check( $tie_called == 0); - Check( scalar( keys %_ ) == $true_count ); - Check( $sub == $true_count ); - Check( scalar( @foo ) == 1); - Check( $foo[0] eq 'N' ); -} - -if ( $symlink_exists ) { - print "# --- symbolic link tests --- \n"; - $FastFileTests_OK= 1; - - - # Verify that File::Find::find will call wanted even if the topdir of - # is a symlink to a directory, and it shouldn't follow the link - # unless follow is set, which it isn't in this case - %Expect_File = ( file_path('fsl') => 1 ); - %Expect_Name = (); - %Expect_Dir = (); - File::Find::find( {wanted => \&wanted_File_Dir}, topdir('fa', 'fsl') ); - Check( scalar(keys %Expect_File) == 0 ); - - - %Expect_File = (File::Spec->curdir => 1, file_path('fa_ord') => 1, - file_path('fsl') => 1, file_path('fb_ord') => 1, - file_path('fba') => 1, file_path('fba_ord') => 1, - file_path('fab') => 1, file_path('fab_ord') => 1, - file_path('faba') => 1, file_path('faa') => 1, - file_path('faa_ord') => 1); - - %Expect_Name = (); - - %Expect_Dir = (File::Spec->curdir => 1, dir_path('fa') => 1, - dir_path('faa') => 1, dir_path('fab') => 1, - dir_path('faba') => 1, dir_path('fb') => 1, - dir_path('fba') => 1); - - File::Find::find( {wanted => \&wanted_File_Dir_prune, - follow_fast => 1}, topdir('fa') ); - - Check( scalar(keys %Expect_File) == 0 ); - - - # no_chdir is in effect, hence we use file_path_name to specify - # the expected paths for %Expect_File - - %Expect_File = (file_path_name('fa') => 1, - file_path_name('fa', 'fa_ord') => 1, - file_path_name('fa', 'fsl') => 1, - file_path_name('fa', 'fsl', 'fb_ord') => 1, - file_path_name('fa', 'fsl', 'fba') => 1, - file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1, - file_path_name('fa', 'fab') => 1, - file_path_name('fa', 'fab', 'fab_ord') => 1, - file_path_name('fa', 'fab', 'faba') => 1, - file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1, - file_path_name('fa', 'faa') => 1, - file_path_name('fa', 'faa', 'faa_ord') => 1); - - %Expect_Name = (); - - %Expect_Dir = (dir_path('fa') => 1, - dir_path('fa', 'faa') => 1, - dir_path('fa', 'fab') => 1, - dir_path('fa', 'fab', 'faba') => 1, - dir_path('fb') => 1, - dir_path('fb', 'fba') => 1); - - File::Find::find( {wanted => \&wanted_File_Dir, follow_fast => 1, - no_chdir => 1}, topdir('fa') ); - - Check( scalar(keys %Expect_File) == 0 ); - - %Expect_File = (); - - %Expect_Name = (file_path_name('fa') => 1, - file_path_name('fa', 'fa_ord') => 1, - file_path_name('fa', 'fsl') => 1, - file_path_name('fa', 'fsl', 'fb_ord') => 1, - file_path_name('fa', 'fsl', 'fba') => 1, - file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1, - file_path_name('fa', 'fab') => 1, - file_path_name('fa', 'fab', 'fab_ord') => 1, - file_path_name('fa', 'fab', 'faba') => 1, - file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1, - file_path_name('fa', 'faa') => 1, - file_path_name('fa', 'faa', 'faa_ord') => 1); - - %Expect_Dir = (); - - File::Find::finddepth( {wanted => \&wanted_Name, - follow_fast => 1}, topdir('fa') ); - - Check( scalar(keys %Expect_Name) == 0 ); - - # no_chdir is in effect, hence we use file_path_name to specify - # the expected paths for %Expect_File - - %Expect_File = (file_path_name('fa') => 1, - file_path_name('fa', 'fa_ord') => 1, - file_path_name('fa', 'fsl') => 1, - file_path_name('fa', 'fsl', 'fb_ord') => 1, - file_path_name('fa', 'fsl', 'fba') => 1, - file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1, - file_path_name('fa', 'fab') => 1, - file_path_name('fa', 'fab', 'fab_ord') => 1, - file_path_name('fa', 'fab', 'faba') => 1, - file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1, - file_path_name('fa', 'faa') => 1, - file_path_name('fa', 'faa', 'faa_ord') => 1); - - %Expect_Name = (); - %Expect_Dir = (); - - File::Find::finddepth( {wanted => \&wanted_File, follow_fast => 1, - no_chdir => 1}, topdir('fa') ); - - Check( scalar(keys %Expect_File) == 0 ); - - - print "# check dangling symbolic links\n"; - MkDir( dir_path('dangling_dir'), 0770 ); - CheckDie( symlink( dir_path('dangling_dir'), - file_path('dangling_dir_sl') ) ); - rmdir dir_path('dangling_dir'); - touch(file_path('dangling_file')); - CheckDie( symlink('../dangling_file','fa/dangling_file_sl') ); - unlink file_path('dangling_file'); - - { - # these tests should also emit a warning - use warnings; - - %Expect_File = (File::Spec->curdir => 1, - file_path('dangling_file_sl') => 1, - file_path('fa_ord') => 1, - file_path('fsl') => 1, - file_path('fb_ord') => 1, - file_path('fba') => 1, - file_path('fba_ord') => 1, - file_path('fab') => 1, - file_path('fab_ord') => 1, - file_path('faba') => 1, - file_path('faba_ord') => 1, - file_path('faa') => 1, - file_path('faa_ord') => 1); - - %Expect_Name = (); - %Expect_Dir = (); - undef $warn_msg; - - File::Find::find( {wanted => \&wanted_File, follow => 1, - dangling_symlinks => - sub { $warn_msg = "$_[0] is a dangling symbolic link" } - }, - topdir('dangling_dir_sl'), topdir('fa') ); - - Check( scalar(keys %Expect_File) == 0 ); - Check( $warn_msg =~ m|dangling_file_sl is a dangling symbolic link| ); - unlink file_path('fa', 'dangling_file_sl'), - file_path('dangling_dir_sl'); - - } - - - print "# check recursion\n"; - CheckDie( symlink('../faa','fa/faa/faa_sl') ); - undef $@; - eval {File::Find::find( {wanted => \&simple_wanted, follow => 1, - no_chdir => 1}, topdir('fa') ); }; - Check( $@ =~ m|for_find[:/]fa[:/]faa[:/]faa_sl is a recursive symbolic link|i ); - unlink file_path('fa', 'faa', 'faa_sl'); - - - print "# check follow_skip (file)\n"; - CheckDie( symlink('./fa_ord','fa/fa_ord_sl') ); # symlink to a file - undef $@; - - eval {File::Find::finddepth( {wanted => \&simple_wanted, - follow => 1, - follow_skip => 0, no_chdir => 1}, - topdir('fa') );}; - - Check( $@ =~ m|for_find[:/]fa[:/]fa_ord encountered a second time|i ); - - - # no_chdir is in effect, hence we use file_path_name to specify - # the expected paths for %Expect_File - - %Expect_File = (file_path_name('fa') => 1, - file_path_name('fa', 'fa_ord') => 2, - # We may encounter the symlink first - file_path_name('fa', 'fa_ord_sl') => 2, - file_path_name('fa', 'fsl') => 1, - file_path_name('fa', 'fsl', 'fb_ord') => 1, - file_path_name('fa', 'fsl', 'fba') => 1, - file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1, - file_path_name('fa', 'fab') => 1, - file_path_name('fa', 'fab', 'fab_ord') => 1, - file_path_name('fa', 'fab', 'faba') => 1, - file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1, - file_path_name('fa', 'faa') => 1, - file_path_name('fa', 'faa', 'faa_ord') => 1); - - %Expect_Name = (); - - %Expect_Dir = (dir_path('fa') => 1, - dir_path('fa', 'faa') => 1, - dir_path('fa', 'fab') => 1, - dir_path('fa', 'fab', 'faba') => 1, - dir_path('fb') => 1, - dir_path('fb','fba') => 1); - - File::Find::finddepth( {wanted => \&wanted_File_Dir, follow => 1, - follow_skip => 1, no_chdir => 1}, - topdir('fa') ); - Check( scalar(keys %Expect_File) == 0 ); - unlink file_path('fa', 'fa_ord_sl'); - - - print "# check follow_skip (directory)\n"; - CheckDie( symlink('./faa','fa/faa_sl') ); # symlink to a directory - undef $@; - - eval {File::Find::find( {wanted => \&simple_wanted, follow => 1, - follow_skip => 0, no_chdir => 1}, - topdir('fa') );}; - - Check( $@ =~ m|for_find[:/]fa[:/]faa[:/]? encountered a second time|i ); - - - undef $@; - - eval {File::Find::find( {wanted => \&simple_wanted, follow => 1, - follow_skip => 1, no_chdir => 1}, - topdir('fa') );}; - - Check( $@ =~ m|for_find[:/]fa[:/]faa[:/]? encountered a second time|i ); - - # no_chdir is in effect, hence we use file_path_name to specify - # the expected paths for %Expect_File - - %Expect_File = (file_path_name('fa') => 1, - file_path_name('fa', 'fa_ord') => 1, - file_path_name('fa', 'fsl') => 1, - file_path_name('fa', 'fsl', 'fb_ord') => 1, - file_path_name('fa', 'fsl', 'fba') => 1, - file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1, - file_path_name('fa', 'fab') => 1, - file_path_name('fa', 'fab', 'fab_ord') => 1, - file_path_name('fa', 'fab', 'faba') => 1, - file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1, - file_path_name('fa', 'faa') => 1, - file_path_name('fa', 'faa', 'faa_ord') => 1, - # We may actually encounter the symlink first. - file_path_name('fa', 'faa_sl') => 1, - file_path_name('fa', 'faa_sl', 'faa_ord') => 1); - - %Expect_Name = (); - - %Expect_Dir = (dir_path('fa') => 1, - dir_path('fa', 'faa') => 1, - dir_path('fa', 'fab') => 1, - dir_path('fa', 'fab', 'faba') => 1, - dir_path('fb') => 1, - dir_path('fb', 'fba') => 1); - - File::Find::find( {wanted => \&wanted_File_Dir, follow => 1, - follow_skip => 2, no_chdir => 1}, topdir('fa') ); - - # If we encountered the symlink first, then the entries corresponding to - # the real name remain, if the real name first then the symlink - my @names = sort keys %Expect_File; - Check( @names == 1 ); - # Normalise both to the original name - s/_sl// foreach @names; - Check ($names[0] eq file_path_name('fa', 'faa', 'faa_ord')); - unlink file_path('fa', 'faa_sl'); - -} - - -# Win32 checks - [perl #41555] -if ($^O eq 'MSWin32') { - require File::Spec::Win32; - my ($volume) = File::Spec::Win32->splitpath($orig_dir, 1); - print STDERR "VOLUME = $volume\n"; - - # with chdir - %Expect_File = (File::Spec->curdir => 1, - file_path('fsl') => 1, - file_path('fa_ord') => 1, - file_path('fab') => 1, - file_path('fab_ord') => 1, - file_path('faba') => 1, - file_path('faba_ord') => 1, - file_path('faa') => 1, - file_path('faa_ord') => 1); - - delete $Expect_File{ file_path('fsl') } unless $symlink_exists; - %Expect_Name = (); - - %Expect_Dir = (dir_path('fa') => 1, - dir_path('faa') => 1, - dir_path('fab') => 1, - dir_path('faba') => 1, - dir_path('fb') => 1, - dir_path('fba') => 1); - - - - File::Find::find( {wanted => \&wanted_File_Dir}, topdir('fa')); - Check( scalar(keys %Expect_File) == 0 ); - - # no_chdir - %Expect_File = ($volume . file_path_name('fa') => 1, - $volume . file_path_name('fa', 'fsl') => 1, - $volume . file_path_name('fa', 'fa_ord') => 1, - $volume . file_path_name('fa', 'fab') => 1, - $volume . file_path_name('fa', 'fab', 'fab_ord') => 1, - $volume . file_path_name('fa', 'fab', 'faba') => 1, - $volume . file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1, - $volume . file_path_name('fa', 'faa') => 1, - $volume . file_path_name('fa', 'faa', 'faa_ord') => 1); - - - delete $Expect_File{ $volume . file_path_name('fa', 'fsl') } unless $symlink_exists; - %Expect_Name = (); - - %Expect_Dir = ($volume . dir_path('fa') => 1, - $volume . dir_path('fa', 'faa') => 1, - $volume . dir_path('fa', 'fab') => 1, - $volume . dir_path('fa', 'fab', 'faba') => 1); - - File::Find::find( {wanted => \&wanted_File_Dir, no_chdir => 1}, $volume . topdir('fa')); - Check( scalar(keys %Expect_File) == 0 ); -} - - -if ($symlink_exists) { # Issue 68260 - print "# BUG 68260\n"; - MkDir (dir_path ('fa', 'fac'), 0770); - MkDir (dir_path ('fb', 'fbc'), 0770); - touch (file_path ('fa', 'fac', 'faca')); - CheckDie (symlink ('..////../fa/fac/faca', 'fb/fbc/fbca')); - - use warnings; - my $dangling_symlink; - local $SIG {__WARN__} = sub { - local $" = " "; - $dangling_symlink ++ if "@_" =~ /dangling symbolic link/; - }; - - File::Find::find ( - { - wanted => sub {1;}, - follow => 1, - follow_skip => 2, - dangling_symlinks => 1, - }, - File::Spec -> curdir - ); - - Check (!$dangling_symlink); -} - -print "# RT 59750\n"; -MkDir( dir_path('fc'), 0770 ); -MkDir( dir_path('fc', 'fca'), 0770 ); -MkDir( dir_path('fc', 'fcb'), 0770 ); -MkDir( dir_path('fc', 'fcc'), 0770 ); -touch( file_path('fc', 'fca', 'match_alpha') ); -touch( file_path('fc', 'fca', 'match_beta') ); -touch( file_path('fc', 'fcb', 'match_gamma') ); -touch( file_path('fc', 'fcb', 'delta') ); -touch( file_path('fc', 'fcc', 'match_epsilon') ); -touch( file_path('fc', 'fcc', 'match_zeta') ); -touch( file_path('fc', 'fcc', 'eta') ); - -my @files_from_mixed = (); -sub wantmatch { - if ( $File::Find::name =~ m/match/ ) { - push @files_from_mixed, $_; - print "# \$_ => '$_'\n"; - } -} -find( \&wantmatch, ( - dir_path('fc', 'fca'), - dir_path('fc', 'fcb'), - dir_path('fc', 'fcc'), -) ); -Check( scalar(@files_from_mixed) == 5 ); - -@files_from_mixed = (); -find( \&wantmatch, ( - dir_path('fc', 'fca'), - dir_path('fc', 'fcb'), - file_path('fc', 'fcc', 'match_epsilon'), - file_path('fc', 'fcc', 'eta'), -) ); -Check( scalar(@files_from_mixed) == 4 ); - -if ($^O eq 'MSWin32') { - # Check F:F:f correctly handles a root directory path. - # Rather than processing the entire drive (!), simply test that the - # first file passed to the wanted routine is correct and then bail out. - $orig_dir =~ /^(\w:)/ or die "expected a drive: $orig_dir"; - my $drive = $1; - - # Determine the file in the root directory which would be - # first if processed in sorted order. Create one if necessary. - my $expected_first_file; - opendir(ROOT_DIR, "/") or die "cannot opendir /: $!\n"; - foreach my $f (sort readdir ROOT_DIR) { - if (-f "/$f") { - $expected_first_file = $f; - last; - } - } - closedir ROOT_DIR; - my $created_file; - unless (defined $expected_first_file) { - $expected_first_file = '__perl_File_Find_test.tmp'; - open(F, ">", "/$expected_first_file") && close(F) - or die "cannot create file in root directory: $!\n"; - $created_file = 1; - } - - # Run F:F:f with/without no_chdir for each possible style of root path. - # NB. If HOME were "/", then an inadvertent chdir('') would fluke the - # expected result, so ensure it is something else: - local $ENV{HOME} = $orig_dir; - foreach my $no_chdir (0, 1) { - foreach my $root_dir ("/", "\\", "$drive/", "$drive\\") { - eval { - File::Find::find({ - 'no_chdir' => $no_chdir, - 'preprocess' => sub { return sort @_ }, - '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"; - print "# no_chdir=$no_chdir $root_dir '$got'\n"; - Check($got eq $exp); - die "done"; # don't process the entire drive! - }, - }, $root_dir); - }; - # If F:F:f did not die "done" then it did not Check() either. - unless ($@ and $@ =~ /done/) { - print "# no_chdir=$no_chdir $root_dir ", - ($@ ? "error: $@" : "no files found"), "\n"; - Check(0); - } - } - } - if ($created_file) { - unlink("/$expected_first_file") - or warn "can't unlink /$expected_first_file: $!\n"; - } -} diff --git a/lib/File/Find/t/taint.t b/lib/File/Find/t/taint.t deleted file mode 100644 index 9d78ae0632..0000000000 --- a/lib/File/Find/t/taint.t +++ /dev/null @@ -1,371 +0,0 @@ -#!./perl -T -use strict; -use Test::More; -BEGIN { - plan( - ${^TAINT} - ? (tests => 45) - : (skip_all => "A perl without taint support") - ); -} - -my %Expect_File = (); # what we expect for $_ -my %Expect_Name = (); # what we expect for $File::Find::name/fullname -my %Expect_Dir = (); # what we expect for $File::Find::dir -my ($cwd, $cwd_untainted); - -BEGIN { - require File::Spec; - if ($ENV{PERL_CORE}) { - # May be doing dynamic loading while @INC is all relative - @INC = map { $_ = File::Spec->rel2abs($_); /(.*)/; $1 } @INC; - } -} - -use Config; - -BEGIN { - if ($^O ne 'VMS') { - for (keys %ENV) { # untaint ENV - ($ENV{$_}) = $ENV{$_} =~ /(.*)/; - } - } - - # Remove insecure directories from PATH - my @path; - my $sep = $Config{path_sep}; - foreach my $dir (split(/\Q$sep/,$ENV{'PATH'})) - { - ## - ## Match the directory taint tests in mg.c::Perl_magic_setenv() - ## - push(@path,$dir) unless (length($dir) >= 256 - or - substr($dir,0,1) ne "/" - or - (stat $dir)[2] & 002); - } - $ENV{'PATH'} = join($sep,@path); -} - -my $symlink_exists = eval { symlink("",""); 1 }; - -use File::Find; -use File::Spec; -use Cwd; - -my $orig_dir = cwd(); -( my $orig_dir_untainted ) = $orig_dir =~ m|^(.+)$|; # untaint it - -cleanup(); - -my $found; -find({wanted => sub { ++$found if $_ eq 'taint.t' }, - untaint => 1, untaint_pattern => qr|^(.+)$|}, File::Spec->curdir); - -is($found, 1, 'taint.t found once'); -$found = 0; - -finddepth({wanted => sub { ++$found if $_ eq 'taint.t'; }, - untaint => 1, untaint_pattern => qr|^(.+)$|}, File::Spec->curdir); - -is($found, 1, 'taint.t found once again'); - -my $case = 2; -my $FastFileTests_OK = 0; - -sub cleanup { - chdir($orig_dir_untainted); - my $need_updir = 0; - if (-d dir_path('for_find')) { - $need_updir = 1 if chdir(dir_path('for_find')); - } - if (-d dir_path('fa')) { - unlink file_path('fa', 'fa_ord'), - file_path('fa', 'fsl'), - file_path('fa', 'faa', 'faa_ord'), - file_path('fa', 'fab', 'fab_ord'), - file_path('fa', 'fab', 'faba', 'faba_ord'), - file_path('fb', 'fb_ord'), - file_path('fb', 'fba', 'fba_ord'); - rmdir dir_path('fa', 'faa'); - rmdir dir_path('fa', 'fab', 'faba'); - rmdir dir_path('fa', 'fab'); - rmdir dir_path('fa'); - rmdir dir_path('fb', 'fba'); - rmdir dir_path('fb'); - } - if ($need_updir) { - my $updir = $^O eq 'VMS' ? File::Spec::VMS->updir() : File::Spec->updir; - chdir($updir); - } - if (-d dir_path('for_find')) { - rmdir dir_path('for_find') or print "# Can't rmdir for_find: $!\n"; - } -} - -END { - cleanup(); -} - -sub touch { - ok( open(my $T,'>',$_[0]), "Opened $_[0] successfully" ); -} - -sub MkDir($$) { - ok( mkdir($_[0],$_[1]), "Created directory $_[0] successfully" ); -} - -sub wanted_File_Dir { - print "# \$File::Find::dir => '$File::Find::dir'\n"; - print "# \$_ => '$_'\n"; - s#\.$## if ($^O eq 'VMS' && $_ ne '.'); - s/(.dir)?$//i if ($^O eq 'VMS' && -d _); - ok( $Expect_File{$_}, "Expected and found $File::Find::name" ); - if ( $FastFileTests_OK ) { - delete $Expect_File{ $_} - unless ( $Expect_Dir{$_} && ! -d _ ); - } else { - delete $Expect_File{$_} - unless ( $Expect_Dir{$_} && ! -d $_ ); - } -} - -sub wanted_File_Dir_prune { - &wanted_File_Dir; - $File::Find::prune=1 if $_ eq 'faba'; -} - -sub simple_wanted { - print "# \$File::Find::dir => '$File::Find::dir'\n"; - print "# \$_ => '$_'\n"; -} - - -# Use dir_path() to specify a directory path that's expected for -# $File::Find::dir (%Expect_Dir). Also use it in file operations like -# chdir, rmdir etc. -# -# dir_path() concatenates directory names to form a *relative* -# directory path, independent from the platform it's run on, although -# there are limitations. Don't try to create an absolute path, -# because that may fail on operating systems that have the concept of -# volume names (e.g. Mac OS). As a special case, you can pass it a "." -# as first argument, to create a directory path like "./fa/dir". If there's -# no second argument this function will return the string "./" - -sub dir_path { - my $first_arg = shift @_; - - if ($first_arg eq '.') { - return './' unless @_; - my $path = File::Spec->catdir(@_); - # add leading "./" - $path = "./$path"; - return $path; - } else { # $first_arg ne '.' - return $first_arg unless @_; # return plain filename - my $fname = File::Spec->catdir($first_arg, @_); # relative path - $fname = VMS::Filespec::unixpath($fname) if $^O eq 'VMS'; - return $fname; - } -} - - -# Use topdir() to specify a directory path that you want to pass to -# find/finddepth. Historically topdir() differed on Mac OS classic. - -*topdir = \&dir_path; - - -# Use file_path() to specify a file path that's expected for $_ -# (%Expect_File). Also suitable for file operations like unlink etc. -# -# file_path() concatenates directory names (if any) and a filename to -# form a *relative* file path (the last argument is assumed to be a -# file). It's independent from the platform it's run on, although -# there are limitations. As a special case, you can pass it a "." as -# first argument, to create a file path like "./fa/file". If there's no -# second argument, this function will return the string "./" otherwise. - -sub file_path { - my $first_arg = shift @_; - - if ($first_arg eq '.') { - return './' unless @_; - my $path = File::Spec->catfile(@_); - # add leading "./" - $path = "./$path"; - return $path; - } else { # $first_arg ne '.' - return $first_arg unless @_; # return plain filename - my $fname = File::Spec->catfile($first_arg, @_); # relative path - $fname = VMS::Filespec::unixify($fname) if $^O eq 'VMS'; - return $fname; - } -} - - -# Use file_path_name() to specify a file path that's expected for -# $File::Find::Name (%Expect_Name). Note: When the no_chdir => 1 -# option is in effect, $_ is the same as $File::Find::Name. In that -# case, also use this function to specify a file path that's expected -# for $_. -# -# Historically file_path_name differed on Mac OS classic. - -*file_path_name = \&file_path; - - -MkDir( dir_path('for_find'), 0770 ); -ok( chdir( dir_path('for_find')), 'successful chdir() to for_find' ); - -$cwd = cwd(); # save cwd -( $cwd_untainted ) = $cwd =~ m|^(.+)$|; # untaint it - -MkDir( dir_path('fa'), 0770 ); -MkDir( dir_path('fb'), 0770 ); -touch( file_path('fb', 'fb_ord') ); -MkDir( dir_path('fb', 'fba'), 0770 ); -touch( file_path('fb', 'fba', 'fba_ord') ); -SKIP: { - skip "Creating symlink", 1, unless $symlink_exists; - ok( symlink('../fb','fa/fsl'), 'Created symbolic link' ); -} -touch( file_path('fa', 'fa_ord') ); - -MkDir( dir_path('fa', 'faa'), 0770 ); -touch( file_path('fa', 'faa', 'faa_ord') ); -MkDir( dir_path('fa', 'fab'), 0770 ); -touch( file_path('fa', 'fab', 'fab_ord') ); -MkDir( dir_path('fa', 'fab', 'faba'), 0770 ); -touch( file_path('fa', 'fab', 'faba', 'faba_ord') ); - -print "# check untainting (no follow)\n"; - -# untainting here should work correctly - -%Expect_File = (File::Spec->curdir => 1, file_path('fsl') => - 1,file_path('fa_ord') => 1, file_path('fab') => 1, - file_path('fab_ord') => 1, file_path('faba') => 1, - file_path('faa') => 1, file_path('faa_ord') => 1); -delete $Expect_File{ file_path('fsl') } unless $symlink_exists; -%Expect_Name = (); - -%Expect_Dir = ( dir_path('fa') => 1, dir_path('faa') => 1, - dir_path('fab') => 1, dir_path('faba') => 1, - dir_path('fb') => 1, dir_path('fba') => 1); - -delete @Expect_Dir{ dir_path('fb'), dir_path('fba') } unless $symlink_exists; - -File::Find::find( {wanted => \&wanted_File_Dir_prune, untaint => 1, - untaint_pattern => qr|^(.+)$|}, topdir('fa') ); - -is(scalar keys %Expect_File, 0, 'Found all expected files'); - - -# don't untaint at all, should die -%Expect_File = (); -%Expect_Name = (); -%Expect_Dir = (); -undef $@; -eval {File::Find::find( {wanted => \&simple_wanted}, topdir('fa') );}; -like( $@, qr|Insecure dependency|, 'Tainted directory causes death (good)' ); -chdir($cwd_untainted); - - -# untaint pattern doesn't match, should die -undef $@; - -eval {File::Find::find( {wanted => \&simple_wanted, untaint => 1, - untaint_pattern => qr|^(NO_MATCH)$|}, - topdir('fa') );}; - -like( $@, qr|is still tainted|, 'Bad untaint pattern causes death (good)' ); -chdir($cwd_untainted); - - -# untaint pattern doesn't match, should die when we chdir to cwd -print "# check untaint_skip (No follow)\n"; -undef $@; - -eval {File::Find::find( {wanted => \&simple_wanted, untaint => 1, - untaint_skip => 1, untaint_pattern => - qr|^(NO_MATCH)$|}, topdir('fa') );}; - -print "# $@" if $@; -#$^D = 8; -like( $@, qr|insecure cwd|, 'Bad untaint pattern causes death in cwd (good)' ); - -chdir($cwd_untainted); - - -SKIP: { - skip "Symbolic link tests", 17, unless $symlink_exists; - print "# --- symbolic link tests --- \n"; - $FastFileTests_OK= 1; - - print "# check untainting (follow)\n"; - - # untainting here should work correctly - # no_chdir is in effect, hence we use file_path_name to specify the expected paths for %Expect_File - - %Expect_File = (file_path_name('fa') => 1, - file_path_name('fa','fa_ord') => 1, - file_path_name('fa', 'fsl') => 1, - file_path_name('fa', 'fsl', 'fb_ord') => 1, - file_path_name('fa', 'fsl', 'fba') => 1, - file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1, - file_path_name('fa', 'fab') => 1, - file_path_name('fa', 'fab', 'fab_ord') => 1, - file_path_name('fa', 'fab', 'faba') => 1, - file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1, - file_path_name('fa', 'faa') => 1, - file_path_name('fa', 'faa', 'faa_ord') => 1); - - %Expect_Name = (); - - %Expect_Dir = (dir_path('fa') => 1, - dir_path('fa', 'faa') => 1, - dir_path('fa', 'fab') => 1, - dir_path('fa', 'fab', 'faba') => 1, - dir_path('fb') => 1, - dir_path('fb', 'fba') => 1); - - File::Find::find( {wanted => \&wanted_File_Dir, follow_fast => 1, - no_chdir => 1, untaint => 1, untaint_pattern => - qr|^(.+)$| }, topdir('fa') ); - - is( scalar(keys %Expect_File), 0, 'Found all files in symlink test' ); - - - # don't untaint at all, should die - undef $@; - - eval {File::Find::find( {wanted => \&simple_wanted, follow => 1}, - topdir('fa') );}; - - like( $@, qr|Insecure dependency|, 'Not untainting causes death (good)' ); - chdir($cwd_untainted); - - # untaint pattern doesn't match, should die - undef $@; - - eval {File::Find::find( {wanted => \&simple_wanted, follow => 1, - untaint => 1, untaint_pattern => - qr|^(NO_MATCH)$|}, topdir('fa') );}; - - like( $@, qr|is still tainted|, 'Bat untaint pattern causes death (good)' ); - chdir($cwd_untainted); - - # untaint pattern doesn't match, should die when we chdir to cwd - print "# check untaint_skip (Follow)\n"; - undef $@; - - eval {File::Find::find( {wanted => \&simple_wanted, untaint => 1, - untaint_skip => 1, untaint_pattern => - qr|^(NO_MATCH)$|}, topdir('fa') );}; - like( $@, qr|insecure cwd|, 'Cwd not untainted with bad pattern (good)' ); - - chdir($cwd_untainted); -} |