This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #71710] fixes for File::Find
[perl5.git] / 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.18';
7 require Exporter;
8 require Cwd;
9
10 #
11 # Modified to ensure sub-directory traversal order is not inverded 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 I<follow_fast> and I<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 See also the script C<pfind> on CPAN for a nice application of this
284 module.
285
286 =head1 WARNINGS
287
288 If you run your program with the C<-w> switch, or if you use the
289 C<warnings> pragma, File::Find will report warnings for several weird
290 situations. You can disable these warnings by putting the statement
291
292     no warnings 'File::Find';
293
294 in the appropriate scope. See L<perllexwarn> for more info about lexical
295 warnings.
296
297 =head1 CAVEAT
298
299 =over 2
300
301 =item $dont_use_nlink
302
303 You can set the variable C<$File::Find::dont_use_nlink> to 1, if you want to
304 force File::Find to always stat directories. This was used for file systems
305 that do not have an C<nlink> count matching the number of sub-directories.
306 Examples are ISO-9660 (CD-ROM), AFS, HPFS (OS/2 file system), FAT (DOS file
307 system) and a couple of others.
308
309 You shouldn't need to set this variable, since File::Find should now detect
310 such file systems on-the-fly and switch itself to using stat. This works even
311 for parts of your file system, like a mounted CD-ROM.
312
313 If you do set C<$File::Find::dont_use_nlink> to 1, you will notice slow-downs.
314
315 =item symlinks
316
317 Be aware that the option to follow symbolic links can be dangerous.
318 Depending on the structure of the directory tree (including symbolic
319 links to directories) you might traverse a given (physical) directory
320 more than once (only if C<follow_fast> is in effect).
321 Furthermore, deleting or changing files in a symbolically linked directory
322 might cause very unpleasant surprises, since you delete or change files
323 in an unknown directory.
324
325 =back
326
327 =head1 NOTES
328
329 =over 4
330
331 =item *
332
333 Mac OS (Classic) users should note a few differences:
334
335 =over 4
336
337 =item *
338
339 The path separator is ':', not '/', and the current directory is denoted
340 as ':', not '.'. You should be careful about specifying relative pathnames.
341 While a full path always begins with a volume name, a relative pathname
342 should always begin with a ':'.  If specifying a volume name only, a
343 trailing ':' is required.
344
345 =item *
346
347 C<$File::Find::dir> is guaranteed to end with a ':'. If C<$_>
348 contains the name of a directory, that name may or may not end with a
349 ':'. Likewise, C<$File::Find::name>, which contains the complete
350 pathname to that directory, and C<$File::Find::fullname>, which holds
351 the absolute pathname of that directory with all symbolic links resolved,
352 may or may not end with a ':'.
353
354 =item *
355
356 The default C<untaint_pattern> (see above) on Mac OS is set to
357 C<qr|^(.+)$|>. Note that the parentheses are vital.
358
359 =item *
360
361 The invisible system file "Icon\015" is ignored. While this file may
362 appear in every directory, there are some more invisible system files
363 on every volume, which are all located at the volume root level (i.e.
364 "MacintoshHD:"). These system files are B<not> excluded automatically.
365 Your filter may use the following code to recognize invisible files or
366 directories (requires Mac::Files):
367
368  use Mac::Files;
369
370  # invisible() --  returns 1 if file/directory is invisible,
371  # 0 if it's visible or undef if an error occurred
372
373  sub invisible($) {
374    my $file = shift;
375    my ($fileCat, $fileInfo);
376    my $invisible_flag =  1 << 14;
377
378    if ( $fileCat = FSpGetCatInfo($file) ) {
379      if ($fileInfo = $fileCat->ioFlFndrInfo() ) {
380        return (($fileInfo->fdFlags & $invisible_flag) && 1);
381      }
382    }
383    return undef;
384  }
385
386 Generally, invisible files are system files, unless an odd application
387 decides to use invisible files for its own purposes. To distinguish
388 such files from system files, you have to look at the B<type> and B<creator>
389 file attributes. The MacPerl built-in functions C<GetFileInfo(FILE)> and
390 C<SetFileInfo(CREATOR, TYPE, FILES)> offer access to these attributes
391 (see MacPerl.pm for details).
392
393 Files that appear on the desktop actually reside in an (hidden) directory
394 named "Desktop Folder" on the particular disk volume. Note that, although
395 all desktop files appear to be on the same "virtual" desktop, each disk
396 volume actually maintains its own "Desktop Folder" directory.
397
398 =back
399
400 =back
401
402 =head1 BUGS AND CAVEATS
403
404 Despite the name of the C<finddepth()> function, both C<find()> and
405 C<finddepth()> perform a depth-first search of the directory
406 hierarchy.
407
408 =head1 HISTORY
409
410 File::Find used to produce incorrect results if called recursively.
411 During the development of perl 5.8 this bug was fixed.
412 The first fixed version of File::Find was 1.01.
413
414 =head1 SEE ALSO
415
416 find, find2perl.
417
418 =cut
419
420 our @ISA = qw(Exporter);
421 our @EXPORT = qw(find finddepth);
422
423
424 use strict;
425 my $Is_VMS;
426 my $Is_Win32;
427
428 require File::Basename;
429 require File::Spec;
430
431 # Should ideally be my() not our() but local() currently
432 # refuses to operate on lexicals
433
434 our %SLnkSeen;
435 our ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
436     $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
437     $pre_process, $post_process, $dangling_symlinks);
438
439 sub contract_name {
440     my ($cdir,$fn) = @_;
441
442     return substr($cdir,0,rindex($cdir,'/')) if $fn eq $File::Find::current_dir;
443
444     $cdir = substr($cdir,0,rindex($cdir,'/')+1);
445
446     $fn =~ s|^\./||;
447
448     my $abs_name= $cdir . $fn;
449
450     if (substr($fn,0,3) eq '../') {
451        1 while $abs_name =~ s!/[^/]*/\.\./+!/!;
452     }
453
454     return $abs_name;
455 }
456
457 # return the absolute name of a directory or file
458 sub contract_name_Mac {
459     my ($cdir,$fn) = @_;
460     my $abs_name;
461
462     if ($fn =~ /^(:+)(.*)$/) { # valid pathname starting with a ':'
463
464         my $colon_count = length ($1);
465         if ($colon_count == 1) {
466             $abs_name = $cdir . $2;
467             return $abs_name;
468         }
469         else {
470             # need to move up the tree, but
471             # only if it's not a volume name
472             for (my $i=1; $i<$colon_count; $i++) {
473                 unless ($cdir =~ /^[^:]+:$/) { # volume name
474                     $cdir =~ s/[^:]+:$//;
475                 }
476                 else {
477                     return undef;
478                 }
479             }
480             $abs_name = $cdir . $2;
481             return $abs_name;
482         }
483
484     }
485     else {
486
487         # $fn may be a valid path to a directory or file or (dangling)
488         # symlink, without a leading ':'
489         if ( (-e $fn) || (-l $fn) ) {
490             if ($fn =~ /^[^:]+:/) { # a volume name like DataHD:*
491                 return $fn; # $fn is already an absolute path
492             }
493             else {
494                 $abs_name = $cdir . $fn;
495                 return $abs_name;
496             }
497         }
498         else { # argh!, $fn is not a valid directory/file
499              return undef;
500         }
501     }
502 }
503
504 sub PathCombine($$) {
505     my ($Base,$Name) = @_;
506     my $AbsName;
507
508     if (substr($Name,0,1) eq '/') {
509         $AbsName= $Name;
510     }
511     else {
512         $AbsName= contract_name($Base,$Name);
513     }
514
515     # (simple) check for recursion
516     my $newlen= length($AbsName);
517     if ($newlen <= length($Base)) {
518         if (($newlen == length($Base) || substr($Base,$newlen,1) eq '/')
519             && $AbsName eq substr($Base,0,$newlen))
520         {
521             return undef;
522         }
523     }
524     return $AbsName;
525 }
526
527 sub Follow_SymLink($) {
528     my ($AbsName) = @_;
529
530     my ($NewName,$DEV, $INO);
531     ($DEV, $INO)= lstat $AbsName;
532
533     while (-l _) {
534         if ($SLnkSeen{$DEV, $INO}++) {
535             if ($follow_skip < 2) {
536                 die "$AbsName is encountered a second time";
537             }
538             else {
539                 return undef;
540             }
541         }
542         $NewName= PathCombine($AbsName, readlink($AbsName));
543         unless(defined $NewName) {
544             if ($follow_skip < 2) {
545                 die "$AbsName is a recursive symbolic link";
546             }
547             else {
548                 return undef;
549             }
550         }
551         else {
552             $AbsName= $NewName;
553         }
554         ($DEV, $INO) = lstat($AbsName);
555         return undef unless defined $DEV;  #  dangling symbolic link
556     }
557
558     if ($full_check && defined $DEV && $SLnkSeen{$DEV, $INO}++) {
559         if ( ($follow_skip < 1) || ((-d _) && ($follow_skip < 2)) ) {
560             die "$AbsName encountered a second time";
561         }
562         else {
563             return undef;
564         }
565     }
566
567     return $AbsName;
568 }
569
570 our($dir, $name, $fullname, $prune);
571 sub _find_dir_symlnk($$$);
572 sub _find_dir($$$);
573
574 # check whether or not a scalar variable is tainted
575 # (code straight from the Camel, 3rd ed., page 561)
576 sub is_tainted_pp {
577     my $arg = shift;
578     my $nada = substr($arg, 0, 0); # zero-length
579     local $@;
580     eval { eval "# $nada" };
581     return length($@) != 0;
582 }
583
584 sub _find_opt {
585     my $wanted = shift;
586     die "invalid top directory" unless defined $_[0];
587
588     # This function must local()ize everything because callbacks may
589     # call find() or finddepth()
590
591     local %SLnkSeen;
592     local ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
593         $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
594         $pre_process, $post_process, $dangling_symlinks);
595     local($dir, $name, $fullname, $prune);
596     local *_ = \my $a;
597
598     my $cwd            = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::getcwd();
599     if ($Is_VMS) {
600         # VMS returns this by default in VMS format which just doesn't
601         # work for the rest of this module.
602         $cwd = VMS::Filespec::unixpath($cwd);
603
604         # Apparently this is not expected to have a trailing space.
605         # To attempt to make VMS/UNIX conversions mostly reversable,
606         # a trailing slash is needed.  The run-time functions ignore the
607         # resulting double slash, but it causes the perl tests to fail.
608         $cwd =~ s#/\z##;
609
610         # This comes up in upper case now, but should be lower.
611         # In the future this could be exact case, no need to change.
612     }
613     my $cwd_untainted  = $cwd;
614     my $check_t_cwd    = 1;
615     $wanted_callback   = $wanted->{wanted};
616     $bydepth           = $wanted->{bydepth};
617     $pre_process       = $wanted->{preprocess};
618     $post_process      = $wanted->{postprocess};
619     $no_chdir          = $wanted->{no_chdir};
620     $full_check        = $Is_Win32 ? 0 : $wanted->{follow};
621     $follow            = $Is_Win32 ? 0 :
622                              $full_check || $wanted->{follow_fast};
623     $follow_skip       = $wanted->{follow_skip};
624     $untaint           = $wanted->{untaint};
625     $untaint_pat       = $wanted->{untaint_pattern};
626     $untaint_skip      = $wanted->{untaint_skip};
627     $dangling_symlinks = $wanted->{dangling_symlinks};
628
629     # for compatibility reasons (find.pl, find2perl)
630     local our ($topdir, $topdev, $topino, $topmode, $topnlink);
631
632     # a symbolic link to a directory doesn't increase the link count
633     $avoid_nlink      = $follow || $File::Find::dont_use_nlink;
634
635     my ($abs_dir, $Is_Dir);
636
637     Proc_Top_Item:
638     foreach my $TOP (@_) {
639         my $top_item = $TOP;
640
641         ($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
642
643         if ($Is_Win32) {
644             $top_item =~ s|[/\\]\z||
645               unless $top_item =~ m{^(?:\w:)?[/\\]$};
646         }
647         else {
648             $top_item =~ s|/\z|| unless $top_item eq '/';
649         }
650
651         $Is_Dir= 0;
652
653         if ($follow) {
654
655             if (substr($top_item,0,1) eq '/') {
656                 $abs_dir = $top_item;
657             }
658             elsif ($top_item eq $File::Find::current_dir) {
659                 $abs_dir = $cwd;
660             }
661             else {  # care about any  ../
662                 $top_item =~ s/\.dir\z//i if $Is_VMS;
663                 $abs_dir = contract_name("$cwd/",$top_item);
664             }
665             $abs_dir= Follow_SymLink($abs_dir);
666             unless (defined $abs_dir) {
667                 if ($dangling_symlinks) {
668                     if (ref $dangling_symlinks eq 'CODE') {
669                         $dangling_symlinks->($top_item, $cwd);
670                     } else {
671                         warnings::warnif "$top_item is a dangling symbolic link\n";
672                     }
673                 }
674                 next Proc_Top_Item;
675             }
676
677             if (-d _) {
678                 $top_item =~ s/\.dir\z//i if $Is_VMS;
679                 _find_dir_symlnk($wanted, $abs_dir, $top_item);
680                 $Is_Dir= 1;
681             }
682         }
683         else { # no follow
684             $topdir = $top_item;
685             unless (defined $topnlink) {
686                 warnings::warnif "Can't stat $top_item: $!\n";
687                 next Proc_Top_Item;
688             }
689             if (-d _) {
690                 $top_item =~ s/\.dir\z//i if $Is_VMS;
691                 _find_dir($wanted, $top_item, $topnlink);
692                 $Is_Dir= 1;
693             }
694             else {
695                 $abs_dir= $top_item;
696             }
697         }
698
699         unless ($Is_Dir) {
700             unless (($_,$dir) = File::Basename::fileparse($abs_dir)) {
701                 ($dir,$_) = ('./', $top_item);
702             }
703
704             $abs_dir = $dir;
705             if (( $untaint ) && (is_tainted($dir) )) {
706                 ( $abs_dir ) = $dir =~ m|$untaint_pat|;
707                 unless (defined $abs_dir) {
708                     if ($untaint_skip == 0) {
709                         die "directory $dir is still tainted";
710                     }
711                     else {
712                         next Proc_Top_Item;
713                     }
714                 }
715             }
716
717             unless ($no_chdir || chdir $abs_dir) {
718                 warnings::warnif "Couldn't chdir $abs_dir: $!\n";
719                 next Proc_Top_Item;
720             }
721
722             $name = $abs_dir . $_; # $File::Find::name
723             $_ = $name if $no_chdir;
724
725             { $wanted_callback->() }; # protect against wild "next"
726
727         }
728
729         unless ( $no_chdir ) {
730             if ( ($check_t_cwd) && (($untaint) && (is_tainted($cwd) )) ) {
731                 ( $cwd_untainted ) = $cwd =~ m|$untaint_pat|;
732                 unless (defined $cwd_untainted) {
733                     die "insecure cwd in find(depth)";
734                 }
735                 $check_t_cwd = 0;
736             }
737             unless (chdir $cwd_untainted) {
738                 die "Can't cd to $cwd: $!\n";
739             }
740         }
741     }
742 }
743
744 # API:
745 #  $wanted
746 #  $p_dir :  "parent directory"
747 #  $nlink :  what came back from the stat
748 # preconditions:
749 #  chdir (if not no_chdir) to dir
750
751 sub _find_dir($$$) {
752     my ($wanted, $p_dir, $nlink) = @_;
753     my ($CdLvl,$Level) = (0,0);
754     my @Stack;
755     my @filenames;
756     my ($subcount,$sub_nlink);
757     my $SE= [];
758     my $dir_name= $p_dir;
759     my $dir_pref;
760     my $dir_rel = $File::Find::current_dir;
761     my $tainted = 0;
762     my $no_nlink;
763
764     if ($Is_Win32) {
765         $dir_pref
766           = ($p_dir =~ m{^(?:\w:[/\\]?|[/\\])$} ? $p_dir : "$p_dir/" );
767     } elsif ($Is_VMS) {
768
769         #       VMS is returning trailing .dir on directories
770         #       and trailing . on files and symbolic links
771         #       in UNIX syntax.
772         #
773
774         $p_dir =~ s/\.(dir)?$//i unless $p_dir eq '.';
775
776         $dir_pref = ($p_dir =~ m/[\]>]+$/ ? $p_dir : "$p_dir/" );
777     }
778     else {
779         $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
780     }
781
782     local ($dir, $name, $prune, *DIR);
783
784     unless ( $no_chdir || ($p_dir eq $File::Find::current_dir)) {
785         my $udir = $p_dir;
786         if (( $untaint ) && (is_tainted($p_dir) )) {
787             ( $udir ) = $p_dir =~ m|$untaint_pat|;
788             unless (defined $udir) {
789                 if ($untaint_skip == 0) {
790                     die "directory $p_dir is still tainted";
791                 }
792                 else {
793                     return;
794                 }
795             }
796         }
797         unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
798             warnings::warnif "Can't cd to $udir: $!\n";
799             return;
800         }
801     }
802
803     # push the starting directory
804     push @Stack,[$CdLvl,$p_dir,$dir_rel,-1]  if  $bydepth;
805
806     while (defined $SE) {
807         unless ($bydepth) {
808             $dir= $p_dir; # $File::Find::dir
809             $name= $dir_name; # $File::Find::name
810             $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
811             # prune may happen here
812             $prune= 0;
813             { $wanted_callback->() };   # protect against wild "next"
814             next if $prune;
815         }
816
817         # change to that directory
818         unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
819             my $udir= $dir_rel;
820             if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_rel) )) ) {
821                 ( $udir ) = $dir_rel =~ m|$untaint_pat|;
822                 unless (defined $udir) {
823                     if ($untaint_skip == 0) {
824                         die "directory (" . ($p_dir ne '/' ? $p_dir : '') . "/) $dir_rel is still tainted";
825                     } else { # $untaint_skip == 1
826                         next;
827                     }
828                 }
829             }
830             unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
831                 warnings::warnif "Can't cd to (" .
832                     ($p_dir ne '/' ? $p_dir : '') . "/) $udir: $!\n";
833                 next;
834             }
835             $CdLvl++;
836         }
837
838         $dir= $dir_name; # $File::Find::dir
839
840         # Get the list of files in the current directory.
841         unless (opendir DIR, ($no_chdir ? $dir_name : $File::Find::current_dir)) {
842             warnings::warnif "Can't opendir($dir_name): $!\n";
843             next;
844         }
845         @filenames = readdir DIR;
846         closedir(DIR);
847         @filenames = $pre_process->(@filenames) if $pre_process;
848         push @Stack,[$CdLvl,$dir_name,"",-2]   if $post_process;
849
850         # default: use whatever was specifid
851         # (if $nlink >= 2, and $avoid_nlink == 0, this will switch back)
852         $no_nlink = $avoid_nlink;
853         # if dir has wrong nlink count, force switch to slower stat method
854         $no_nlink = 1 if ($nlink < 2);
855
856         if ($nlink == 2 && !$no_nlink) {
857             # This dir has no subdirectories.
858             for my $FN (@filenames) {
859                 if ($Is_VMS) {
860                 # Big hammer here - Compensate for VMS trailing . and .dir
861                 # No win situation until this is changed, but this
862                 # will handle the majority of the cases with breaking the fewest
863
864                     $FN =~ s/\.dir\z//i;
865                     $FN =~ s#\.$## if ($FN ne '.');
866                 }
867                 next if $FN =~ $File::Find::skip_pattern;
868                 
869                 $name = $dir_pref . $FN; # $File::Find::name
870                 $_ = ($no_chdir ? $name : $FN); # $_
871                 { $wanted_callback->() }; # protect against wild "next"
872             }
873
874         }
875         else {
876             # This dir has subdirectories.
877             $subcount = $nlink - 2;
878
879             # HACK: insert directories at this position. so as to preserve
880             # the user pre-processed ordering of files.
881             # EG: directory traversal is in user sorted order, not at random.
882             my $stack_top = @Stack;
883
884             for my $FN (@filenames) {
885                 next if $FN =~ $File::Find::skip_pattern;
886                 if ($subcount > 0 || $no_nlink) {
887                     # Seen all the subdirs?
888                     # check for directoriness.
889                     # stat is faster for a file in the current directory
890                     $sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3];
891
892                     if (-d _) {
893                         --$subcount;
894                         $FN =~ s/\.dir\z//i if $Is_VMS;
895                         # HACK: replace push to preserve dir traversal order
896                         #push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
897                         splice @Stack, $stack_top, 0,
898                                  [$CdLvl,$dir_name,$FN,$sub_nlink];
899                     }
900                     else {
901                         $name = $dir_pref . $FN; # $File::Find::name
902                         $_= ($no_chdir ? $name : $FN); # $_
903                         { $wanted_callback->() }; # protect against wild "next"
904                     }
905                 }
906                 else {
907                     $name = $dir_pref . $FN; # $File::Find::name
908                     $_= ($no_chdir ? $name : $FN); # $_
909                     { $wanted_callback->() }; # protect against wild "next"
910                 }
911             }
912         }
913     }
914     continue {
915         while ( defined ($SE = pop @Stack) ) {
916             ($Level, $p_dir, $dir_rel, $nlink) = @$SE;
917             if ($CdLvl > $Level && !$no_chdir) {
918                 my $tmp;
919                 if ($Is_VMS) {
920                     $tmp = '[' . ('-' x ($CdLvl-$Level)) . ']';
921                 }
922                 else {
923                     $tmp = join('/',('..') x ($CdLvl-$Level));
924                 }
925                 die "Can't cd to $tmp from $dir_name"
926                     unless chdir ($tmp);
927                 $CdLvl = $Level;
928             }
929
930             if ($^O eq 'MSWin32') {
931                 $dir_name = ($p_dir =~ m|\w:/?$| ? "$p_dir$dir_rel" : "$p_dir/$dir_rel");
932                 $dir_pref = "$dir_name/";
933             }
934             elsif ($^O eq 'VMS') {
935                 if ($p_dir =~ m/[\]>]+$/) {
936                     $dir_name = $p_dir;
937                     $dir_name =~ s/([\]>]+)$/.$dir_rel$1/;
938                     $dir_pref = $dir_name;
939                 }
940                 else {
941                     $dir_name = "$p_dir/$dir_rel";
942                     $dir_pref = "$dir_name/";
943                 }
944             }
945             else {
946                 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
947                 $dir_pref = "$dir_name/";
948             }
949
950             if ( $nlink == -2 ) {
951                 $name = $dir = $p_dir; # $File::Find::name / dir
952                 $_ = $File::Find::current_dir;
953                 $post_process->();              # End-of-directory processing
954             }
955             elsif ( $nlink < 0 ) {  # must be finddepth, report dirname now
956                 $name = $dir_name;
957                 if ( substr($name,-2) eq '/.' ) {
958                     substr($name, length($name) == 2 ? -1 : -2) = '';
959                 }
960                 $dir = $p_dir;
961                 $_ = ($no_chdir ? $dir_name : $dir_rel );
962                 if ( substr($_,-2) eq '/.' ) {
963                     substr($_, length($_) == 2 ? -1 : -2) = '';
964                 }
965                 { $wanted_callback->() }; # protect against wild "next"
966              }
967              else {
968                 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1]  if  $bydepth;
969                 last;
970             }
971         }
972     }
973 }
974
975
976 # API:
977 #  $wanted
978 #  $dir_loc : absolute location of a dir
979 #  $p_dir   : "parent directory"
980 # preconditions:
981 #  chdir (if not no_chdir) to dir
982
983 sub _find_dir_symlnk($$$) {
984     my ($wanted, $dir_loc, $p_dir) = @_; # $dir_loc is the absolute directory
985     my @Stack;
986     my @filenames;
987     my $new_loc;
988     my $updir_loc = $dir_loc; # untainted parent directory
989     my $SE = [];
990     my $dir_name = $p_dir;
991     my $dir_pref;
992     my $loc_pref;
993     my $dir_rel = $File::Find::current_dir;
994     my $byd_flag; # flag for pending stack entry if $bydepth
995     my $tainted = 0;
996     my $ok = 1;
997
998     $dir_pref = ( $p_dir   eq '/' ? '/' : "$p_dir/" );
999     $loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" );
1000
1001     local ($dir, $name, $fullname, $prune, *DIR);
1002
1003     unless ($no_chdir) {
1004         # untaint the topdir
1005         if (( $untaint ) && (is_tainted($dir_loc) )) {
1006             ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|; # parent dir, now untainted
1007              # once untainted, $updir_loc is pushed on the stack (as parent directory);
1008             # hence, we don't need to untaint the parent directory every time we chdir
1009             # to it later
1010             unless (defined $updir_loc) {
1011                 if ($untaint_skip == 0) {
1012                     die "directory $dir_loc is still tainted";
1013                 }
1014                 else {
1015                     return;
1016                 }
1017             }
1018         }
1019         $ok = chdir($updir_loc) unless ($p_dir eq $File::Find::current_dir);
1020         unless ($ok) {
1021             warnings::warnif "Can't cd to $updir_loc: $!\n";
1022             return;
1023         }
1024     }
1025
1026     push @Stack,[$dir_loc,$updir_loc,$p_dir,$dir_rel,-1]  if  $bydepth;
1027
1028     while (defined $SE) {
1029
1030         unless ($bydepth) {
1031             # change (back) to parent directory (always untainted)
1032             unless ($no_chdir) {
1033                 unless (chdir $updir_loc) {
1034                     warnings::warnif "Can't cd to $updir_loc: $!\n";
1035                     next;
1036                 }
1037             }
1038             $dir= $p_dir; # $File::Find::dir
1039             $name= $dir_name; # $File::Find::name
1040             $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
1041             $fullname= $dir_loc; # $File::Find::fullname
1042             # prune may happen here
1043             $prune= 0;
1044             lstat($_); # make sure  file tests with '_' work
1045             { $wanted_callback->() }; # protect against wild "next"
1046             next if $prune;
1047         }
1048
1049         # change to that directory
1050         unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
1051             $updir_loc = $dir_loc;
1052             if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_loc) )) ) {
1053                 # untaint $dir_loc, what will be pushed on the stack as (untainted) parent dir
1054                 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|;
1055                 unless (defined $updir_loc) {
1056                     if ($untaint_skip == 0) {
1057                         die "directory $dir_loc is still tainted";
1058                     }
1059                     else {
1060                         next;
1061                     }
1062                 }
1063             }
1064             unless (chdir $updir_loc) {
1065                 warnings::warnif "Can't cd to $updir_loc: $!\n";
1066                 next;
1067             }
1068         }
1069
1070         $dir = $dir_name; # $File::Find::dir
1071
1072         # Get the list of files in the current directory.
1073         unless (opendir DIR, ($no_chdir ? $dir_loc : $File::Find::current_dir)) {
1074             warnings::warnif "Can't opendir($dir_loc): $!\n";
1075             next;
1076         }
1077         @filenames = readdir DIR;
1078         closedir(DIR);
1079
1080         for my $FN (@filenames) {
1081             if ($Is_VMS) {
1082             # Big hammer here - Compensate for VMS trailing . and .dir
1083             # No win situation until this is changed, but this
1084             # will handle the majority of the cases with breaking the fewest.
1085
1086                 $FN =~ s/\.dir\z//i;
1087                 $FN =~ s#\.$## if ($FN ne '.');
1088             }
1089             next if $FN =~ $File::Find::skip_pattern;
1090
1091             # follow symbolic links / do an lstat
1092             $new_loc = Follow_SymLink($loc_pref.$FN);
1093
1094             # ignore if invalid symlink
1095             unless (defined $new_loc) {
1096                 if (!defined -l _ && $dangling_symlinks) {
1097                     if (ref $dangling_symlinks eq 'CODE') {
1098                         $dangling_symlinks->($FN, $dir_pref);
1099                     } else {
1100                         warnings::warnif "$dir_pref$FN is a dangling symbolic link\n";
1101                     }
1102                 }
1103
1104                 $fullname = undef;
1105                 $name = $dir_pref . $FN;
1106                 $_ = ($no_chdir ? $name : $FN);
1107                 { $wanted_callback->() };
1108                 next;
1109             }
1110
1111             if (-d _) {
1112                 if ($Is_VMS) {
1113                     $FN =~ s/\.dir\z//i;
1114                     $FN =~ s#\.$## if ($FN ne '.');
1115                     $new_loc =~ s/\.dir\z//i;
1116                     $new_loc =~ s#\.$## if ($new_loc ne '.');
1117                 }
1118                 push @Stack,[$new_loc,$updir_loc,$dir_name,$FN,1];
1119             }
1120             else {
1121                 $fullname = $new_loc; # $File::Find::fullname
1122                 $name = $dir_pref . $FN; # $File::Find::name
1123                 $_ = ($no_chdir ? $name : $FN); # $_
1124                 { $wanted_callback->() }; # protect against wild "next"
1125             }
1126         }
1127
1128     }
1129     continue {
1130         while (defined($SE = pop @Stack)) {
1131             ($dir_loc, $updir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE;
1132             $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
1133             $dir_pref = "$dir_name/";
1134             $loc_pref = "$dir_loc/";
1135             if ( $byd_flag < 0 ) {  # must be finddepth, report dirname now
1136                 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
1137                     unless (chdir $updir_loc) { # $updir_loc (parent dir) is always untainted
1138                         warnings::warnif "Can't cd to $updir_loc: $!\n";
1139                         next;
1140                     }
1141                 }
1142                 $fullname = $dir_loc; # $File::Find::fullname
1143                 $name = $dir_name; # $File::Find::name
1144                 if ( substr($name,-2) eq '/.' ) {
1145                     substr($name, length($name) == 2 ? -1 : -2) = ''; # $File::Find::name
1146                 }
1147                 $dir = $p_dir; # $File::Find::dir
1148                 $_ = ($no_chdir ? $dir_name : $dir_rel); # $_
1149                 if ( substr($_,-2) eq '/.' ) {
1150                     substr($_, length($_) == 2 ? -1 : -2) = '';
1151                 }
1152
1153                 lstat($_); # make sure file tests with '_' work
1154                 { $wanted_callback->() }; # protect against wild "next"
1155             }
1156             else {
1157                 push @Stack,[$dir_loc, $updir_loc, $p_dir, $dir_rel,-1]  if  $bydepth;
1158                 last;
1159             }
1160         }
1161     }
1162 }
1163
1164
1165 sub wrap_wanted {
1166     my $wanted = shift;
1167     if ( ref($wanted) eq 'HASH' ) {
1168         unless( exists $wanted->{wanted} and ref( $wanted->{wanted} ) eq 'CODE' ) {
1169             die 'no &wanted subroutine given';
1170         }
1171         if ( $wanted->{follow} || $wanted->{follow_fast}) {
1172             $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip};
1173         }
1174         if ( $wanted->{untaint} ) {
1175             $wanted->{untaint_pattern} = $File::Find::untaint_pattern
1176                 unless defined $wanted->{untaint_pattern};
1177             $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip};
1178         }
1179         return $wanted;
1180     }
1181     elsif( ref( $wanted ) eq 'CODE' ) {
1182         return { wanted => $wanted };
1183     }
1184     else {
1185        die 'no &wanted subroutine given';
1186     }
1187 }
1188
1189 sub find {
1190     my $wanted = shift;
1191     _find_opt(wrap_wanted($wanted), @_);
1192 }
1193
1194 sub finddepth {
1195     my $wanted = wrap_wanted(shift);
1196     $wanted->{bydepth} = 1;
1197     _find_opt($wanted, @_);
1198 }
1199
1200 # default
1201 $File::Find::skip_pattern    = qr/^\.{1,2}\z/;
1202 $File::Find::untaint_pattern = qr|^([-+@\w./]+)$|;
1203
1204 # These are hard-coded for now, but may move to hint files.
1205 if ($^O eq 'VMS') {
1206     $Is_VMS = 1;
1207     $File::Find::dont_use_nlink  = 1;
1208 }
1209
1210 # this _should_ work properly on all platforms
1211 # where File::Find can be expected to work
1212 $File::Find::current_dir = File::Spec->curdir || '.';
1213
1214 $File::Find::dont_use_nlink = 1
1215     if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32' ||
1216        $^O eq 'interix' || $^O eq 'cygwin' || $^O eq 'epoc' || $^O eq 'qnx' ||
1217            $^O eq 'nto';
1218
1219 # Set dont_use_nlink in your hint file if your system's stat doesn't
1220 # report the number of links in a directory as an indication
1221 # of the number of files.
1222 # See, e.g. hints/machten.sh for MachTen 2.2.
1223 unless ($File::Find::dont_use_nlink) {
1224     require Config;
1225     $File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
1226 }
1227
1228 # We need a function that checks if a scalar is tainted. Either use the
1229 # Scalar::Util module's tainted() function or our (slower) pure Perl
1230 # fallback is_tainted_pp()
1231 {
1232     local $@;
1233     eval { require Scalar::Util };
1234     *is_tainted = $@ ? \&is_tainted_pp : \&Scalar::Util::tainted;
1235 }
1236
1237 1;