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