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