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