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