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