lib/File/Find.pm

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