This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
File::Find: diagnostics in case of a failed chdir
[perl5.git] / ext / File-Find / lib / File / Find.pm
1 package File::Find;
2 use 5.006;
3 use strict;
4 use warnings;
5 use warnings::register;
6 our $VERSION = '1.25';
7 require Exporter;
8 require Cwd;
9
10 #
11 # Modified to ensure sub-directory traversal order is not inverted by stack
12 # push and pops.  That is remains in the same order as in the directory file,
13 # or user pre-processing (EG:sorted).
14 #
15
16 =head1 NAME
17
18 File::Find - Traverse a directory tree.
19
20 =head1 SYNOPSIS
21
22     use File::Find;
23     find(\&wanted, @directories_to_search);
24     sub wanted { ... }
25
26     use File::Find;
27     finddepth(\&wanted, @directories_to_search);
28     sub wanted { ... }
29
30     use File::Find;
31     find({ wanted => \&process, follow => 1 }, '.');
32
33 =head1 DESCRIPTION
34
35 These are functions for searching through directory trees doing work
36 on each file found similar to the Unix I<find> command.  File::Find
37 exports two functions, C<find> and C<finddepth>.  They work similarly
38 but have subtle differences.
39
40 =over 4
41
42 =item B<find>
43
44   find(\&wanted,  @directories);
45   find(\%options, @directories);
46
47 C<find()> does a depth-first search over the given C<@directories> in
48 the order they are given.  For each file or directory found, it calls
49 the C<&wanted> subroutine.  (See below for details on how to use the
50 C<&wanted> function).  Additionally, for each directory found, it will
51 C<chdir()> into that directory and continue the search, invoking the
52 C<&wanted> function on each file or subdirectory in the directory.
53
54 =item B<finddepth>
55
56   finddepth(\&wanted,  @directories);
57   finddepth(\%options, @directories);
58
59 C<finddepth()> works just like C<find()> except that it invokes the
60 C<&wanted> function for a directory I<after> invoking it for the
61 directory's contents.  It does a postorder traversal instead of a
62 preorder traversal, working from the bottom of the directory tree up
63 where C<find()> works from the top of the tree down.
64
65 =back
66
67 =head2 %options
68
69 The first argument to C<find()> is either a code reference to your
70 C<&wanted> function, or a hash reference describing the operations
71 to be performed for each file.  The
72 code reference is described in L<The wanted function> below.
73
74 Here are the possible keys for the hash:
75
76 =over 3
77
78 =item C<wanted>
79
80 The value should be a code reference.  This code reference is
81 described in L<The wanted function> below. The C<&wanted> subroutine is
82 mandatory.
83
84 =item C<bydepth>
85
86 Reports the name of a directory only AFTER all its entries
87 have been reported.  Entry point C<finddepth()> is a shortcut for
88 specifying C<< { bydepth => 1 } >> in the first argument of C<find()>.
89
90 =item C<preprocess>
91
92 The value should be a code reference. This code reference is used to
93 preprocess the current directory. The name of the currently processed
94 directory is in C<$File::Find::dir>. Your preprocessing function is
95 called after C<readdir()>, but before the loop that calls the C<wanted()>
96 function. It is called with a list of strings (actually file/directory
97 names) and is expected to return a list of strings. The code can be
98 used to sort the file/directory names alphabetically, numerically,
99 or to filter out directory entries based on their name alone. When
100 I<follow> or I<follow_fast> are in effect, C<preprocess> is a no-op.
101
102 =item C<postprocess>
103
104 The value should be a code reference. It is invoked just before leaving
105 the currently processed directory. It is called in void context with no
106 arguments. The name of the current directory is in C<$File::Find::dir>. This
107 hook is handy for summarizing a directory, such as calculating its disk
108 usage. When I<follow> or I<follow_fast> are in effect, C<postprocess> is a
109 no-op.
110
111 =item C<follow>
112
113 Causes symbolic links to be followed. Since directory trees with symbolic
114 links (followed) may contain files more than once and may even have
115 cycles, a hash has to be built up with an entry for each file.
116 This might be expensive both in space and time for a large
117 directory tree. See L</follow_fast> and L</follow_skip> below.
118 If either I<follow> or I<follow_fast> is in effect:
119
120 =over 6
121
122 =item *
123
124 It is guaranteed that an I<lstat> has been called before the user's
125 C<wanted()> function is called. This enables fast file checks involving S<_>.
126 Note that this guarantee no longer holds if I<follow> or I<follow_fast>
127 are not set.
128
129 =item *
130
131 There is a variable C<$File::Find::fullname> which holds the absolute
132 pathname of the file with all symbolic links resolved.  If the link is
133 a dangling symbolic link, then fullname will be set to C<undef>.
134
135 =back
136
137 This is a no-op on Win32.
138
139 =item C<follow_fast>
140
141 This is similar to I<follow> except that it may report some files more
142 than once.  It does detect cycles, however.  Since only symbolic links
143 have to be hashed, this is much cheaper both in space and time.  If
144 processing a file more than once (by the user's C<wanted()> function)
145 is worse than just taking time, the option I<follow> should be used.
146
147 This is also a no-op on Win32.
148
149 =item C<follow_skip>
150
151 C<follow_skip==1>, which is the default, causes all files which are
152 neither directories nor symbolic links to be ignored if they are about
153 to be processed a second time. If a directory or a symbolic link
154 are about to be processed a second time, File::Find dies.
155
156 C<follow_skip==0> causes File::Find to die if any file is about to be
157 processed a second time.
158
159 C<follow_skip==2> causes File::Find to ignore any duplicate files and
160 directories but to proceed normally otherwise.
161
162 =item C<dangling_symlinks>
163
164 If true and a code reference, will be called with the symbolic link
165 name and the directory it lives in as arguments.  Otherwise, if true
166 and warnings are on, warning "symbolic_link_name is a dangling
167 symbolic link\n" will be issued.  If false, the dangling symbolic link
168 will be silently ignored.
169
170 =item C<no_chdir>
171
172 Does not C<chdir()> to each directory as it recurses. The C<wanted()>
173 function will need to be aware of this, of course. In this case,
174 C<$_> will be the same as C<$File::Find::name>.
175
176 =item C<untaint>
177
178 If find is used in taint-mode (-T command line switch or if EUID != UID
179 or if EGID != GID) then internally directory names have to be untainted
180 before they can be chdir'ed to. Therefore they are checked against a regular
181 expression I<untaint_pattern>.  Note that all names passed to the user's
182 I<wanted()> function are still tainted. If this option is used while
183 not in taint-mode, C<untaint> is a no-op.
184
185 =item C<untaint_pattern>
186
187 See above. This should be set using the C<qr> quoting operator.
188 The default is set to  C<qr|^([-+@\w./]+)$|>.
189 Note that the parentheses are vital.
190
191 =item C<untaint_skip>
192
193 If set, a directory which fails the I<untaint_pattern> is skipped,
194 including all its sub-directories. The default is to 'die' in such a case.
195
196 =back
197
198 =head2 The wanted function
199
200 The C<wanted()> function does whatever verifications you want on
201 each file and directory.  Note that despite its name, the C<wanted()>
202 function is a generic callback function, and does B<not> tell
203 File::Find if a file is "wanted" or not.  In fact, its return value
204 is ignored.
205
206 The wanted function takes no arguments but rather does its work
207 through a collection of variables.
208
209 =over 4
210
211 =item C<$File::Find::dir> is the current directory name,
212
213 =item C<$_> is the current filename within that directory
214
215 =item C<$File::Find::name> is the complete pathname to the file.
216
217 =back
218
219 The above variables have all been localized and may be changed without
220 affecting data outside of the wanted function.
221
222 For example, when examining the file F</some/path/foo.ext> you will have:
223
224     $File::Find::dir  = /some/path/
225     $_                = foo.ext
226     $File::Find::name = /some/path/foo.ext
227
228 You are chdir()'d to C<$File::Find::dir> when the function is called,
229 unless C<no_chdir> was specified. Note that when changing to
230 directories is in effect the root directory (F</>) is a somewhat
231 special case inasmuch as the concatenation of C<$File::Find::dir>,
232 C<'/'> and C<$_> is not literally equal to C<$File::Find::name>. The
233 table below summarizes all variants:
234
235               $File::Find::name  $File::Find::dir  $_
236  default      /                  /                 .
237  no_chdir=>0  /etc               /                 etc
238               /etc/x             /etc              x
239
240  no_chdir=>1  /                  /                 /
241               /etc               /                 /etc
242               /etc/x             /etc              /etc/x
243
244
245 When C<follow> or C<follow_fast> are in effect, there is
246 also a C<$File::Find::fullname>.  The function may set
247 C<$File::Find::prune> to prune the tree unless C<bydepth> was
248 specified.  Unless C<follow> or C<follow_fast> is specified, for
249 compatibility reasons (find.pl, find2perl) there are in addition the
250 following globals available: C<$File::Find::topdir>,
251 C<$File::Find::topdev>, C<$File::Find::topino>,
252 C<$File::Find::topmode> and C<$File::Find::topnlink>.
253
254 This library is useful for the C<find2perl> tool, which when fed,
255
256     find2perl / -name .nfs\* -mtime +7 \
257         -exec rm -f {} \; -o -fstype nfs -prune
258
259 produces something like:
260
261     sub wanted {
262         /^\.nfs.*\z/s &&
263         (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_)) &&
264         int(-M _) > 7 &&
265         unlink($_)
266         ||
267         ($nlink || (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_))) &&
268         $dev < 0 &&
269         ($File::Find::prune = 1);
270     }
271
272 Notice the C<_> in the above C<int(-M _)>: the C<_> is a magical
273 filehandle that caches the information from the preceding
274 C<stat()>, C<lstat()>, or filetest.
275
276 Here's another interesting wanted function.  It will find all symbolic
277 links that don't resolve:
278
279     sub wanted {
280          -l && !-e && print "bogus link: $File::Find::name\n";
281     }
282
283 Note that you may mix directories and (non-directory) files in the list of 
284 directories to be searched by the C<wanted()> function.
285
286     find(\&wanted, "./foo", "./bar", "./baz/epsilon");
287
288 In the example above, no file in F<./baz/> other than F<./baz/epsilon> will be
289 evaluated by C<wanted()>.
290
291 See also the script C<pfind> on CPAN for a nice application of this
292 module.
293
294 =head1 WARNINGS
295
296 If you run your program with the C<-w> switch, or if you use the
297 C<warnings> pragma, File::Find will report warnings for several weird
298 situations. You can disable these warnings by putting the statement
299
300     no warnings 'File::Find';
301
302 in the appropriate scope. See L<perllexwarn> for more info about lexical
303 warnings.
304
305 =head1 CAVEAT
306
307 =over 2
308
309 =item $dont_use_nlink
310
311 You can set the variable C<$File::Find::dont_use_nlink> to 1, if you want to
312 force File::Find to always stat directories. This was used for file systems
313 that do not have an C<nlink> count matching the number of sub-directories.
314 Examples are ISO-9660 (CD-ROM), AFS, HPFS (OS/2 file system), FAT (DOS file
315 system) and a couple of others.
316
317 You shouldn't need to set this variable, since File::Find should now detect
318 such file systems on-the-fly and switch itself to using stat. This works even
319 for parts of your file system, like a mounted CD-ROM.
320
321 If you do set C<$File::Find::dont_use_nlink> to 1, you will notice slow-downs.
322
323 =item symlinks
324
325 Be aware that the option to follow symbolic links can be dangerous.
326 Depending on the structure of the directory tree (including symbolic
327 links to directories) you might traverse a given (physical) directory
328 more than once (only if C<follow_fast> is in effect).
329 Furthermore, deleting or changing files in a symbolically linked directory
330 might cause very unpleasant surprises, since you delete or change files
331 in an unknown directory.
332
333 =back
334
335 =head1 BUGS AND CAVEATS
336
337 Despite the name of the C<finddepth()> function, both C<find()> and
338 C<finddepth()> perform a depth-first search of the directory
339 hierarchy.
340
341 =head1 HISTORY
342
343 File::Find used to produce incorrect results if called recursively.
344 During the development of perl 5.8 this bug was fixed.
345 The first fixed version of File::Find was 1.01.
346
347 =head1 SEE ALSO
348
349 find, find2perl.
350
351 =cut
352
353 our @ISA = qw(Exporter);
354 our @EXPORT = qw(find finddepth);
355
356
357 use strict;
358 my $Is_VMS;
359 my $Is_Win32;
360
361 require File::Basename;
362 require File::Spec;
363
364 # Should ideally be my() not our() but local() currently
365 # refuses to operate on lexicals
366
367 our %SLnkSeen;
368 our ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
369     $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
370     $pre_process, $post_process, $dangling_symlinks);
371
372 sub contract_name {
373     my ($cdir,$fn) = @_;
374
375     return substr($cdir,0,rindex($cdir,'/')) if $fn eq $File::Find::current_dir;
376
377     $cdir = substr($cdir,0,rindex($cdir,'/')+1);
378
379     $fn =~ s|^\./||;
380
381     my $abs_name= $cdir . $fn;
382
383     if (substr($fn,0,3) eq '../') {
384        1 while $abs_name =~ s!/[^/]*/\.\./+!/!;
385     }
386
387     return $abs_name;
388 }
389
390 sub PathCombine($$) {
391     my ($Base,$Name) = @_;
392     my $AbsName;
393
394     if (substr($Name,0,1) eq '/') {
395         $AbsName= $Name;
396     }
397     else {
398         $AbsName= contract_name($Base,$Name);
399     }
400
401     # (simple) check for recursion
402     my $newlen= length($AbsName);
403     if ($newlen <= length($Base)) {
404         if (($newlen == length($Base) || substr($Base,$newlen,1) eq '/')
405             && $AbsName eq substr($Base,0,$newlen))
406         {
407             return undef;
408         }
409     }
410     return $AbsName;
411 }
412
413 sub Follow_SymLink($) {
414     my ($AbsName) = @_;
415
416     my ($NewName,$DEV, $INO);
417     ($DEV, $INO)= lstat $AbsName;
418
419     while (-l _) {
420         if ($SLnkSeen{$DEV, $INO}++) {
421             if ($follow_skip < 2) {
422                 die "$AbsName is encountered a second time";
423             }
424             else {
425                 return undef;
426             }
427         }
428         $NewName= PathCombine($AbsName, readlink($AbsName));
429         unless(defined $NewName) {
430             if ($follow_skip < 2) {
431                 die "$AbsName is a recursive symbolic link";
432             }
433             else {
434                 return undef;
435             }
436         }
437         else {
438             $AbsName= $NewName;
439         }
440         ($DEV, $INO) = lstat($AbsName);
441         return undef unless defined $DEV;  #  dangling symbolic link
442     }
443
444     if ($full_check && defined $DEV && $SLnkSeen{$DEV, $INO}++) {
445         if ( ($follow_skip < 1) || ((-d _) && ($follow_skip < 2)) ) {
446             die "$AbsName encountered a second time";
447         }
448         else {
449             return undef;
450         }
451     }
452
453     return $AbsName;
454 }
455
456 our($dir, $name, $fullname, $prune);
457 sub _find_dir_symlnk($$$);
458 sub _find_dir($$$);
459
460 # check whether or not a scalar variable is tainted
461 # (code straight from the Camel, 3rd ed., page 561)
462 sub is_tainted_pp {
463     my $arg = shift;
464     my $nada = substr($arg, 0, 0); # zero-length
465     local $@;
466     eval { eval "# $nada" };
467     return length($@) != 0;
468 }
469
470 sub _find_opt {
471     my $wanted = shift;
472     die "invalid top directory" unless defined $_[0];
473
474     # This function must local()ize everything because callbacks may
475     # call find() or finddepth()
476
477     local %SLnkSeen;
478     local ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
479         $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
480         $pre_process, $post_process, $dangling_symlinks);
481     local($dir, $name, $fullname, $prune);
482     local *_ = \my $a;
483
484     my $cwd            = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::getcwd();
485     if ($Is_VMS) {
486         # VMS returns this by default in VMS format which just doesn't
487         # work for the rest of this module.
488         $cwd = VMS::Filespec::unixpath($cwd);
489
490         # Apparently this is not expected to have a trailing space.
491         # To attempt to make VMS/UNIX conversions mostly reversible,
492         # a trailing slash is needed.  The run-time functions ignore the
493         # resulting double slash, but it causes the perl tests to fail.
494         $cwd =~ s#/\z##;
495
496         # This comes up in upper case now, but should be lower.
497         # In the future this could be exact case, no need to change.
498     }
499     my $cwd_untainted  = $cwd;
500     my $check_t_cwd    = 1;
501     $wanted_callback   = $wanted->{wanted};
502     $bydepth           = $wanted->{bydepth};
503     $pre_process       = $wanted->{preprocess};
504     $post_process      = $wanted->{postprocess};
505     $no_chdir          = $wanted->{no_chdir};
506     $full_check        = $Is_Win32 ? 0 : $wanted->{follow};
507     $follow            = $Is_Win32 ? 0 :
508                              $full_check || $wanted->{follow_fast};
509     $follow_skip       = $wanted->{follow_skip};
510     $untaint           = $wanted->{untaint};
511     $untaint_pat       = $wanted->{untaint_pattern};
512     $untaint_skip      = $wanted->{untaint_skip};
513     $dangling_symlinks = $wanted->{dangling_symlinks};
514
515     # for compatibility reasons (find.pl, find2perl)
516     local our ($topdir, $topdev, $topino, $topmode, $topnlink);
517
518     # a symbolic link to a directory doesn't increase the link count
519     $avoid_nlink      = $follow || $File::Find::dont_use_nlink;
520
521     my ($abs_dir, $Is_Dir);
522
523     Proc_Top_Item:
524     foreach my $TOP (@_) {
525         my $top_item = $TOP;
526         $top_item = VMS::Filespec::unixify($top_item) if $Is_VMS;
527
528         ($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
529
530         if ($Is_Win32) {
531             $top_item =~ s|[/\\]\z||
532               unless $top_item =~ m{^(?:\w:)?[/\\]$};
533         }
534         else {
535             $top_item =~ s|/\z|| unless $top_item eq '/';
536         }
537
538         $Is_Dir= 0;
539
540         if ($follow) {
541
542             if (substr($top_item,0,1) eq '/') {
543                 $abs_dir = $top_item;
544             }
545             elsif ($top_item eq $File::Find::current_dir) {
546                 $abs_dir = $cwd;
547             }
548             else {  # care about any  ../
549                 $top_item =~ s/\.dir\z//i if $Is_VMS;
550                 $abs_dir = contract_name("$cwd/",$top_item);
551             }
552             $abs_dir= Follow_SymLink($abs_dir);
553             unless (defined $abs_dir) {
554                 if ($dangling_symlinks) {
555                     if (ref $dangling_symlinks eq 'CODE') {
556                         $dangling_symlinks->($top_item, $cwd);
557                     } else {
558                         warnings::warnif "$top_item is a dangling symbolic link\n";
559                     }
560                 }
561                 next Proc_Top_Item;
562             }
563
564             if (-d _) {
565                 $top_item =~ s/\.dir\z//i if $Is_VMS;
566                 _find_dir_symlnk($wanted, $abs_dir, $top_item);
567                 $Is_Dir= 1;
568             }
569         }
570         else { # no follow
571             $topdir = $top_item;
572             unless (defined $topnlink) {
573                 warnings::warnif "Can't stat $top_item: $!\n";
574                 next Proc_Top_Item;
575             }
576             if (-d _) {
577                 $top_item =~ s/\.dir\z//i if $Is_VMS;
578                 _find_dir($wanted, $top_item, $topnlink);
579                 $Is_Dir= 1;
580             }
581             else {
582                 $abs_dir= $top_item;
583             }
584         }
585
586         unless ($Is_Dir) {
587             unless (($_,$dir) = File::Basename::fileparse($abs_dir)) {
588                 ($dir,$_) = ('./', $top_item);
589             }
590
591             $abs_dir = $dir;
592             if (( $untaint ) && (is_tainted($dir) )) {
593                 ( $abs_dir ) = $dir =~ m|$untaint_pat|;
594                 unless (defined $abs_dir) {
595                     if ($untaint_skip == 0) {
596                         die "directory $dir is still tainted";
597                     }
598                     else {
599                         next Proc_Top_Item;
600                     }
601                 }
602             }
603
604             unless ($no_chdir || chdir $abs_dir) {
605                 warnings::warnif "Couldn't chdir $abs_dir: $!\n";
606                 next Proc_Top_Item;
607             }
608
609             $name = $abs_dir . $_; # $File::Find::name
610             $_ = $name if $no_chdir;
611
612             { $wanted_callback->() }; # protect against wild "next"
613
614         }
615
616         unless ( $no_chdir ) {
617             if ( ($check_t_cwd) && (($untaint) && (is_tainted($cwd) )) ) {
618                 ( $cwd_untainted ) = $cwd =~ m|$untaint_pat|;
619                 unless (defined $cwd_untainted) {
620                     die "insecure cwd in find(depth)";
621                 }
622                 $check_t_cwd = 0;
623             }
624             unless (chdir $cwd_untainted) {
625                 die "Can't cd to $cwd: $!\n";
626             }
627         }
628     }
629 }
630
631 # API:
632 #  $wanted
633 #  $p_dir :  "parent directory"
634 #  $nlink :  what came back from the stat
635 # preconditions:
636 #  chdir (if not no_chdir) to dir
637
638 sub _find_dir($$$) {
639     my ($wanted, $p_dir, $nlink) = @_;
640     my ($CdLvl,$Level) = (0,0);
641     my @Stack;
642     my @filenames;
643     my ($subcount,$sub_nlink);
644     my $SE= [];
645     my $dir_name= $p_dir;
646     my $dir_pref;
647     my $dir_rel = $File::Find::current_dir;
648     my $tainted = 0;
649     my $no_nlink;
650
651     if ($Is_Win32) {
652         $dir_pref
653           = ($p_dir =~ m{^(?:\w:[/\\]?|[/\\])$} ? $p_dir : "$p_dir/" );
654     } elsif ($Is_VMS) {
655
656         #       VMS is returning trailing .dir on directories
657         #       and trailing . on files and symbolic links
658         #       in UNIX syntax.
659         #
660
661         $p_dir =~ s/\.(dir)?$//i unless $p_dir eq '.';
662
663         $dir_pref = ($p_dir =~ m/[\]>]+$/ ? $p_dir : "$p_dir/" );
664     }
665     else {
666         $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
667     }
668
669     local ($dir, $name, $prune, *DIR);
670
671     unless ( $no_chdir || ($p_dir eq $File::Find::current_dir)) {
672         my $udir = $p_dir;
673         if (( $untaint ) && (is_tainted($p_dir) )) {
674             ( $udir ) = $p_dir =~ m|$untaint_pat|;
675             unless (defined $udir) {
676                 if ($untaint_skip == 0) {
677                     die "directory $p_dir is still tainted";
678                 }
679                 else {
680                     return;
681                 }
682             }
683         }
684         unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
685             warnings::warnif "Can't cd to $udir: $!\n";
686             return;
687         }
688     }
689
690     # push the starting directory
691     push @Stack,[$CdLvl,$p_dir,$dir_rel,-1]  if  $bydepth;
692
693     while (defined $SE) {
694         unless ($bydepth) {
695             $dir= $p_dir; # $File::Find::dir
696             $name= $dir_name; # $File::Find::name
697             $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
698             # prune may happen here
699             $prune= 0;
700             { $wanted_callback->() };   # protect against wild "next"
701             next if $prune;
702         }
703
704         # change to that directory
705         unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
706             my $udir= $dir_rel;
707             if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_rel) )) ) {
708                 ( $udir ) = $dir_rel =~ m|$untaint_pat|;
709                 unless (defined $udir) {
710                     if ($untaint_skip == 0) {
711                         die "directory (" . ($p_dir ne '/' ? $p_dir : '') . "/) $dir_rel is still tainted";
712                     } else { # $untaint_skip == 1
713                         next;
714                     }
715                 }
716             }
717             unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
718                 warnings::warnif "Can't cd to (" .
719                     ($p_dir ne '/' ? $p_dir : '') . "/) $udir: $!\n";
720                 next;
721             }
722             $CdLvl++;
723         }
724
725         $dir= $dir_name; # $File::Find::dir
726
727         # Get the list of files in the current directory.
728         unless (opendir DIR, ($no_chdir ? $dir_name : $File::Find::current_dir)) {
729             warnings::warnif "Can't opendir($dir_name): $!\n";
730             next;
731         }
732         @filenames = readdir DIR;
733         closedir(DIR);
734         @filenames = $pre_process->(@filenames) if $pre_process;
735         push @Stack,[$CdLvl,$dir_name,"",-2]   if $post_process;
736
737         # default: use whatever was specified
738         # (if $nlink >= 2, and $avoid_nlink == 0, this will switch back)
739         $no_nlink = $avoid_nlink;
740         # if dir has wrong nlink count, force switch to slower stat method
741         $no_nlink = 1 if ($nlink < 2);
742
743         if ($nlink == 2 && !$no_nlink) {
744             # This dir has no subdirectories.
745             for my $FN (@filenames) {
746                 if ($Is_VMS) {
747                 # Big hammer here - Compensate for VMS trailing . and .dir
748                 # No win situation until this is changed, but this
749                 # will handle the majority of the cases with breaking the fewest
750
751                     $FN =~ s/\.dir\z//i;
752                     $FN =~ s#\.$## if ($FN ne '.');
753                 }
754                 next if $FN =~ $File::Find::skip_pattern;
755                 
756                 $name = $dir_pref . $FN; # $File::Find::name
757                 $_ = ($no_chdir ? $name : $FN); # $_
758                 { $wanted_callback->() }; # protect against wild "next"
759             }
760
761         }
762         else {
763             # This dir has subdirectories.
764             $subcount = $nlink - 2;
765
766             # HACK: insert directories at this position. so as to preserve
767             # the user pre-processed ordering of files.
768             # EG: directory traversal is in user sorted order, not at random.
769             my $stack_top = @Stack;
770
771             for my $FN (@filenames) {
772                 next if $FN =~ $File::Find::skip_pattern;
773                 if ($subcount > 0 || $no_nlink) {
774                     # Seen all the subdirs?
775                     # check for directoriness.
776                     # stat is faster for a file in the current directory
777                     $sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3];
778
779                     if (-d _) {
780                         --$subcount;
781                         $FN =~ s/\.dir\z//i if $Is_VMS;
782                         # HACK: replace push to preserve dir traversal order
783                         #push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
784                         splice @Stack, $stack_top, 0,
785                                  [$CdLvl,$dir_name,$FN,$sub_nlink];
786                     }
787                     else {
788                         $name = $dir_pref . $FN; # $File::Find::name
789                         $_= ($no_chdir ? $name : $FN); # $_
790                         { $wanted_callback->() }; # protect against wild "next"
791                     }
792                 }
793                 else {
794                     $name = $dir_pref . $FN; # $File::Find::name
795                     $_= ($no_chdir ? $name : $FN); # $_
796                     { $wanted_callback->() }; # protect against wild "next"
797                 }
798             }
799         }
800     }
801     continue {
802         while ( defined ($SE = pop @Stack) ) {
803             ($Level, $p_dir, $dir_rel, $nlink) = @$SE;
804             if ($CdLvl > $Level && !$no_chdir) {
805                 my $tmp;
806                 if ($Is_VMS) {
807                     $tmp = '[' . ('-' x ($CdLvl-$Level)) . ']';
808                 }
809                 else {
810                     $tmp = join('/',('..') x ($CdLvl-$Level));
811                 }
812                 die "Can't cd to $tmp from $dir_name: $!"
813                     unless chdir ($tmp);
814                 $CdLvl = $Level;
815             }
816
817             if ($Is_Win32) {
818                 $dir_name = ($p_dir =~ m{^(?:\w:[/\\]?|[/\\])$}
819                     ? "$p_dir$dir_rel" : "$p_dir/$dir_rel");
820                 $dir_pref = "$dir_name/";
821             }
822             elsif ($^O eq 'VMS') {
823                 if ($p_dir =~ m/[\]>]+$/) {
824                     $dir_name = $p_dir;
825                     $dir_name =~ s/([\]>]+)$/.$dir_rel$1/;
826                     $dir_pref = $dir_name;
827                 }
828                 else {
829                     $dir_name = "$p_dir/$dir_rel";
830                     $dir_pref = "$dir_name/";
831                 }
832             }
833             else {
834                 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
835                 $dir_pref = "$dir_name/";
836             }
837
838             if ( $nlink == -2 ) {
839                 $name = $dir = $p_dir; # $File::Find::name / dir
840                 $_ = $File::Find::current_dir;
841                 $post_process->();              # End-of-directory processing
842             }
843             elsif ( $nlink < 0 ) {  # must be finddepth, report dirname now
844                 $name = $dir_name;
845                 if ( substr($name,-2) eq '/.' ) {
846                     substr($name, length($name) == 2 ? -1 : -2) = '';
847                 }
848                 $dir = $p_dir;
849                 $_ = ($no_chdir ? $dir_name : $dir_rel );
850                 if ( substr($_,-2) eq '/.' ) {
851                     substr($_, length($_) == 2 ? -1 : -2) = '';
852                 }
853                 { $wanted_callback->() }; # protect against wild "next"
854              }
855              else {
856                 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1]  if  $bydepth;
857                 last;
858             }
859         }
860     }
861 }
862
863
864 # API:
865 #  $wanted
866 #  $dir_loc : absolute location of a dir
867 #  $p_dir   : "parent directory"
868 # preconditions:
869 #  chdir (if not no_chdir) to dir
870
871 sub _find_dir_symlnk($$$) {
872     my ($wanted, $dir_loc, $p_dir) = @_; # $dir_loc is the absolute directory
873     my @Stack;
874     my @filenames;
875     my $new_loc;
876     my $updir_loc = $dir_loc; # untainted parent directory
877     my $SE = [];
878     my $dir_name = $p_dir;
879     my $dir_pref;
880     my $loc_pref;
881     my $dir_rel = $File::Find::current_dir;
882     my $byd_flag; # flag for pending stack entry if $bydepth
883     my $tainted = 0;
884     my $ok = 1;
885
886     $dir_pref = ( $p_dir   eq '/' ? '/' : "$p_dir/" );
887     $loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" );
888
889     local ($dir, $name, $fullname, $prune, *DIR);
890
891     unless ($no_chdir) {
892         # untaint the topdir
893         if (( $untaint ) && (is_tainted($dir_loc) )) {
894             ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|; # parent dir, now untainted
895              # once untainted, $updir_loc is pushed on the stack (as parent directory);
896             # hence, we don't need to untaint the parent directory every time we chdir
897             # to it later
898             unless (defined $updir_loc) {
899                 if ($untaint_skip == 0) {
900                     die "directory $dir_loc is still tainted";
901                 }
902                 else {
903                     return;
904                 }
905             }
906         }
907         $ok = chdir($updir_loc) unless ($p_dir eq $File::Find::current_dir);
908         unless ($ok) {
909             warnings::warnif "Can't cd to $updir_loc: $!\n";
910             return;
911         }
912     }
913
914     push @Stack,[$dir_loc,$updir_loc,$p_dir,$dir_rel,-1]  if  $bydepth;
915
916     while (defined $SE) {
917
918         unless ($bydepth) {
919             # change (back) to parent directory (always untainted)
920             unless ($no_chdir) {
921                 unless (chdir $updir_loc) {
922                     warnings::warnif "Can't cd to $updir_loc: $!\n";
923                     next;
924                 }
925             }
926             $dir= $p_dir; # $File::Find::dir
927             $name= $dir_name; # $File::Find::name
928             $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
929             $fullname= $dir_loc; # $File::Find::fullname
930             # prune may happen here
931             $prune= 0;
932             lstat($_); # make sure  file tests with '_' work
933             { $wanted_callback->() }; # protect against wild "next"
934             next if $prune;
935         }
936
937         # change to that directory
938         unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
939             $updir_loc = $dir_loc;
940             if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_loc) )) ) {
941                 # untaint $dir_loc, what will be pushed on the stack as (untainted) parent dir
942                 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|;
943                 unless (defined $updir_loc) {
944                     if ($untaint_skip == 0) {
945                         die "directory $dir_loc is still tainted";
946                     }
947                     else {
948                         next;
949                     }
950                 }
951             }
952             unless (chdir $updir_loc) {
953                 warnings::warnif "Can't cd to $updir_loc: $!\n";
954                 next;
955             }
956         }
957
958         $dir = $dir_name; # $File::Find::dir
959
960         # Get the list of files in the current directory.
961         unless (opendir DIR, ($no_chdir ? $dir_loc : $File::Find::current_dir)) {
962             warnings::warnif "Can't opendir($dir_loc): $!\n";
963             next;
964         }
965         @filenames = readdir DIR;
966         closedir(DIR);
967
968         for my $FN (@filenames) {
969             if ($Is_VMS) {
970             # Big hammer here - Compensate for VMS trailing . and .dir
971             # No win situation until this is changed, but this
972             # will handle the majority of the cases with breaking the fewest.
973
974                 $FN =~ s/\.dir\z//i;
975                 $FN =~ s#\.$## if ($FN ne '.');
976             }
977             next if $FN =~ $File::Find::skip_pattern;
978
979             # follow symbolic links / do an lstat
980             $new_loc = Follow_SymLink($loc_pref.$FN);
981
982             # ignore if invalid symlink
983             unless (defined $new_loc) {
984                 if (!defined -l _ && $dangling_symlinks) {
985                     if (ref $dangling_symlinks eq 'CODE') {
986                         $dangling_symlinks->($FN, $dir_pref);
987                     } else {
988                         warnings::warnif "$dir_pref$FN is a dangling symbolic link\n";
989                     }
990                 }
991
992                 $fullname = undef;
993                 $name = $dir_pref . $FN;
994                 $_ = ($no_chdir ? $name : $FN);
995                 { $wanted_callback->() };
996                 next;
997             }
998
999             if (-d _) {
1000                 if ($Is_VMS) {
1001                     $FN =~ s/\.dir\z//i;
1002                     $FN =~ s#\.$## if ($FN ne '.');
1003                     $new_loc =~ s/\.dir\z//i;
1004                     $new_loc =~ s#\.$## if ($new_loc ne '.');
1005                 }
1006                 push @Stack,[$new_loc,$updir_loc,$dir_name,$FN,1];
1007             }
1008             else {
1009                 $fullname = $new_loc; # $File::Find::fullname
1010                 $name = $dir_pref . $FN; # $File::Find::name
1011                 $_ = ($no_chdir ? $name : $FN); # $_
1012                 { $wanted_callback->() }; # protect against wild "next"
1013             }
1014         }
1015
1016     }
1017     continue {
1018         while (defined($SE = pop @Stack)) {
1019             ($dir_loc, $updir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE;
1020             $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
1021             $dir_pref = "$dir_name/";
1022             $loc_pref = "$dir_loc/";
1023             if ( $byd_flag < 0 ) {  # must be finddepth, report dirname now
1024                 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
1025                     unless (chdir $updir_loc) { # $updir_loc (parent dir) is always untainted
1026                         warnings::warnif "Can't cd to $updir_loc: $!\n";
1027                         next;
1028                     }
1029                 }
1030                 $fullname = $dir_loc; # $File::Find::fullname
1031                 $name = $dir_name; # $File::Find::name
1032                 if ( substr($name,-2) eq '/.' ) {
1033                     substr($name, length($name) == 2 ? -1 : -2) = ''; # $File::Find::name
1034                 }
1035                 $dir = $p_dir; # $File::Find::dir
1036                 $_ = ($no_chdir ? $dir_name : $dir_rel); # $_
1037                 if ( substr($_,-2) eq '/.' ) {
1038                     substr($_, length($_) == 2 ? -1 : -2) = '';
1039                 }
1040
1041                 lstat($_); # make sure file tests with '_' work
1042                 { $wanted_callback->() }; # protect against wild "next"
1043             }
1044             else {
1045                 push @Stack,[$dir_loc, $updir_loc, $p_dir, $dir_rel,-1]  if  $bydepth;
1046                 last;
1047             }
1048         }
1049     }
1050 }
1051
1052
1053 sub wrap_wanted {
1054     my $wanted = shift;
1055     if ( ref($wanted) eq 'HASH' ) {
1056         unless( exists $wanted->{wanted} and ref( $wanted->{wanted} ) eq 'CODE' ) {
1057             die 'no &wanted subroutine given';
1058         }
1059         if ( $wanted->{follow} || $wanted->{follow_fast}) {
1060             $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip};
1061         }
1062         if ( $wanted->{untaint} ) {
1063             $wanted->{untaint_pattern} = $File::Find::untaint_pattern
1064                 unless defined $wanted->{untaint_pattern};
1065             $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip};
1066         }
1067         return $wanted;
1068     }
1069     elsif( ref( $wanted ) eq 'CODE' ) {
1070         return { wanted => $wanted };
1071     }
1072     else {
1073        die 'no &wanted subroutine given';
1074     }
1075 }
1076
1077 sub find {
1078     my $wanted = shift;
1079     _find_opt(wrap_wanted($wanted), @_);
1080 }
1081
1082 sub finddepth {
1083     my $wanted = wrap_wanted(shift);
1084     $wanted->{bydepth} = 1;
1085     _find_opt($wanted, @_);
1086 }
1087
1088 # default
1089 $File::Find::skip_pattern    = qr/^\.{1,2}\z/;
1090 $File::Find::untaint_pattern = qr|^([-+@\w./]+)$|;
1091
1092 # These are hard-coded for now, but may move to hint files.
1093 if ($^O eq 'VMS') {
1094     $Is_VMS = 1;
1095     $File::Find::dont_use_nlink  = 1;
1096 }
1097 elsif ($^O eq 'MSWin32') {
1098     $Is_Win32 = 1;
1099 }
1100
1101 # this _should_ work properly on all platforms
1102 # where File::Find can be expected to work
1103 $File::Find::current_dir = File::Spec->curdir || '.';
1104
1105 $File::Find::dont_use_nlink = 1
1106     if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $Is_Win32 ||
1107        $^O eq 'interix' || $^O eq 'cygwin' || $^O eq 'qnx' || $^O eq 'nto';
1108
1109 # Set dont_use_nlink in your hint file if your system's stat doesn't
1110 # report the number of links in a directory as an indication
1111 # of the number of files.
1112 # See, e.g. hints/machten.sh for MachTen 2.2.
1113 unless ($File::Find::dont_use_nlink) {
1114     require Config;
1115     $File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
1116 }
1117
1118 # We need a function that checks if a scalar is tainted. Either use the
1119 # Scalar::Util module's tainted() function or our (slower) pure Perl
1120 # fallback is_tainted_pp()
1121 {
1122     local $@;
1123     eval { require Scalar::Util };
1124     *is_tainted = $@ ? \&is_tainted_pp : \&Scalar::Util::tainted;
1125 }
1126
1127 1;