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