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