lib/File/Find.pm

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