lib/File/Find.pm

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