lib/File/Find.pm

   1 package File::Find;
   2 require 5.000;
   3 require Exporter;
   4 require Cwd;
   5
   6 =head1 NAME
   7
   8 find - traverse a file tree
   9
  10 finddepth - traverse a directory structure depth-first
  11
  12 =head1 SYNOPSIS
  13
  14     use File::Find;
  15     find(\&wanted, '/foo', '/bar');
  16     sub wanted { ... }
  17
  18     use File::Find;
  19     finddepth(\&wanted, '/foo', '/bar');
  20     sub wanted { ... }
  21
  22     use File::Find;
  23     find({ wanted => \&process, follow => 1 }, '.');
  24
  25 =head1 DESCRIPTION
  26
  27 The first argument to find() is either a hash reference describing the
  28 operations to be performed for each file, or a code reference.
  29
  30 Here are the possible keys for the hash:
  31
  32 =over 3
  33
  34 =item C<wanted>
  35
  36 The value should be a code reference.  This code reference is called
  37 I<the wanted() function> below.
  38
  39 =item C<bydepth>
  40
  41 Reports the name of a directory only AFTER all its entries
  42 have been reported.  Entry point finddepth() is a shortcut for
  43 specifying C<{ bydepth => 1 }> in the first argument of find().
  44
  45 =item C<follow>
  46
  47 Causes symbolic links to be followed. Since directory trees with symbolic
  48 links (followed) may contain files more than once and may even have
  49 cycles, a hash has to be built up with an entry for each file.
  50 This might be expensive both in space and time for a large
  51 directory tree. See I<follow_fast> and I<follow_skip> below.
  52 If either I<follow> or I<follow_fast> is in effect:
  53
  54 =over 6
  55
  56 =item
  57
  58 It is guarantueed that an I<lstat> has been called before the user's
  59 I<wanted()> function is called. This enables fast file checks involving S< _>.
  60
  61 =item
  62
  63 There is a variable C<$File::Find::fullname> which holds the absolute
  64 pathname of the file with all symbolic links resolved
  65
  66 =back
  67
  68 =item C<follow_fast>
  69
  70 This is similar to I<follow> except that it may report some files
  71 more than once. It does detect cycles however.
  72 Since only symbolic links have to be hashed, this is
  73 much cheaper both in space and time.
  74 If processing a file more than once (by the user's I<wanted()> function)
  75 is worse than just taking time, the option I<follow> should be used.
  76
  77 =item C<follow_skip>
  78
  79 C<follow_skip==1>, which is the default, causes all files which are
  80 neither directories nor symbolic links to be ignored if they are about
  81 to be processed a second time. If a directory or a symbolic link
  82 are about to be processed a second time, File::Find dies.
  83 C<follow_skip==0> causes File::Find to die if any file is about to be
  84 processed a second time.
  85 C<follow_skip==2> causes File::Find to ignore any duplicate files and
  86 dirctories but to proceed normally otherwise.
  87
  88
  89 =item C<no_chdir>
  90
  91 Does not C<chdir()> to each directory as it recurses. The wanted()
  92 function will need to be aware of this, of course. In this case,
  93 C<$_> will be the same as C<$File::Find::name>.
  94
  95 =item C<untaint>
  96
  97 If find is used in taint-mode (-T command line switch or if EUID != UID
  98 or if EGID != GID) then internally directory names have to be untainted
  99 before they can be cd'ed to. Therefore they are checked against a regular
 100 expression I<untaint_pattern>. Note, that all names passed to the
 101 user's I<wanted()> function are still tainted.
 102
 103 =item C<untaint_pattern>
 104
 105 See above. This should be set using the C<qr> quoting operator.
 106 The default is set to  C<qr|^([-+@\w./]+)$|>.
 107 Note that the paranthesis which are vital.
 108
 109 =item C<untaint_skip>
 110
 111 If set, directories (subtrees) which fail the I<untaint_pattern>
 112 are skipped. The default is to 'die' in such a case.
 113
 114 =back
 115
 116 The wanted() function does whatever verifications you want.
 117 C<$File::Find::dir> contains the current directory name, and C<$_> the
 118 current filename within that directory.  C<$File::Find::name> contains
 119 the complete pathname to the file. You are chdir()'d to C<$File::Find::dir> when
 120 the function is called, unless C<no_chdir> was specified.
 121 When <follow> or <follow_fast> are in effect there is also a
 122 C<$File::Find::fullname>.
 123 The function may set C<$File::Find::prune> to prune the tree
 124 unless C<bydepth> was specified.
 125
 126 This library is useful for the C<find2perl> tool, which when fed,
 127
 128     find2perl / -name .nfs\* -mtime +7 \
 129         -exec rm -f {} \; -o -fstype nfs -prune
 130
 131 produces something like:
 132
 133     sub wanted {
 134         /^\.nfs.*$/ &&
 135         (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_)) &&
 136         int(-M _) > 7 &&
 137         unlink($_)
 138         ||
 139         ($nlink || (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_))) &&
 140         $dev < 0 &&
 141         ($File::Find::prune = 1);
 142     }
 143
 144 Set the variable C<$File::Find::dont_use_nlink> if you're using AFS,
 145 since AFS cheats.
 146
 147
 148 Here's another interesting wanted function.  It will find all symlinks
 149 that don't resolve:
 150
 151     sub wanted {
 152          -l && !-e && print "bogus link: $File::Find::name\n";
 153     }
 154
 155 See also the script C<pfind> on CPAN for a nice application of this
 156 module.
 157
 158 =head1 CAVEAT
 159
 160 Be aware that the option to follow symblic links can be dangerous.
 161 Depending on the structure of the directory tree (including symbolic
 162 links to directories) you might traverse a given (physical) directory
 163 more than once (only if C<follow_fast> is in effect).
 164 Furthermore, deleting or changing files in a symbolically linked directory
 165 might cause very unpleasant surprises, since you delete or change files
 166 in an unknown directory.
 167
 168
 169 =cut
 170
 171 @ISA = qw(Exporter);
 172 @EXPORT = qw(find finddepth);
 173
 174
 175 use strict;
 176 my $Is_VMS;
 177
 178 require File::Basename;
 179
 180 my %SLnkSeen;
 181 my ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
 182     $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat);
 183
 184 sub contract_name {
 185     my ($cdir,$fn) = @_;
 186
 187     return substr($cdir,0,rindex($cdir,'/')) if $fn eq '.';
 188
 189     $cdir = substr($cdir,0,rindex($cdir,'/')+1);
 190
 191     $fn =~ s|^\./||;
 192
 193     my $abs_name= $cdir . $fn;
 194
 195     if (substr($fn,0,3) eq '../') {
 196         do 1 while ($abs_name=~ s|/(?>[^/]+)/\.\./|/|);
 197     }
 198
 199     return $abs_name;
 200 }
 201
 202
 203 sub PathCombine($$) {
 204     my ($Base,$Name) = @_;
 205     my $AbsName;
 206
 207     if (substr($Name,0,1) eq '/') {
 208         $AbsName= $Name;
 209     }
 210     else {
 211         $AbsName= contract_name($Base,$Name);
 212     }
 213
 214     # (simple) check for recursion
 215     my $newlen= length($AbsName);
 216     if ($newlen <= length($Base)) {
 217         if (($newlen == length($Base) || substr($Base,$newlen,1) eq '/')
 218             && $AbsName eq substr($Base,0,$newlen))
 219         {
 220             return undef;
 221         }
 222     }
 223     return $AbsName;
 224 }
 225
 226 sub Follow_SymLink($) {
 227     my ($AbsName) = @_;
 228
 229     my ($NewName,$DEV, $INO);
 230     ($DEV, $INO)= lstat $AbsName;
 231
 232     while (-l _) {
 233         if ($SLnkSeen{$DEV, $INO}++) {
 234             if ($follow_skip < 2) {
 235                 die "$AbsName is encountered a second time";
 236             }
 237             else {
 238                 return undef;
 239             }
 240         }
 241         $NewName= PathCombine($AbsName, readlink($AbsName));
 242         unless(defined $NewName) {
 243             if ($follow_skip < 2) {
 244                 die "$AbsName is a recursive symbolic link";
 245             }
 246             else {
 247                 return undef;
 248             }
 249         }
 250         else {
 251             $AbsName= $NewName;
 252         }
 253         ($DEV, $INO) = lstat($AbsName);
 254         return undef unless defined $DEV;  #  dangling symbolic link
 255     }
 256
 257     if ($full_check && $SLnkSeen{$DEV, $INO}++) {
 258         if ($follow_skip < 1) {
 259             die "$AbsName encountered a second time";
 260         }
 261         else {
 262             return undef;
 263         }
 264     }
 265
 266     return $AbsName;
 267 }
 268
 269 use vars qw/ $dir $name $fullname $prune /;
 270 sub _find_dir_symlnk($$$);
 271 sub _find_dir($$$);
 272
 273 sub _find_opt {
 274     my $wanted = shift;
 275     die "invalid top directory" unless defined $_[0];
 276
 277     my $cwd           = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::cwd();
 278     my $cwd_untainted = $cwd;
 279     $wanted_callback  = $wanted->{wanted};
 280     $bydepth          = $wanted->{bydepth};
 281     $no_chdir         = $wanted->{no_chdir};
 282     $full_check       = $wanted->{follow};
 283     $follow           = $full_check || $wanted->{follow_fast};
 284     $follow_skip      = $wanted->{follow_skip};
 285     $untaint          = $wanted->{untaint};
 286     $untaint_pat      = $wanted->{untaint_pattern};
 287     $untaint_skip     = $wanted->{untaint_skip};
 288
 289
 290     # a symbolic link to a directory doesn't increase the link count
 291     $avoid_nlink      = $follow || $File::Find::dont_use_nlink;
 292
 293     if ( $untaint ) {
 294         $cwd_untainted= $1 if $cwd_untainted =~ m|$untaint_pat|;
 295         die "insecure cwd in find(depth)"  unless defined($cwd_untainted);
 296     }
 297
 298     my ($abs_dir, $nlink, $Is_Dir);
 299
 300     Proc_Top_Item:
 301     foreach my $TOP (@_) {
 302         my $top_item = $TOP;
 303         $top_item =~ s|/$||;
 304         $Is_Dir= 0;
 305
 306         if ($follow) {
 307             if (substr($top_item,0,1) eq '/') {
 308                 $abs_dir = $top_item;
 309             }
 310             elsif ($top_item eq '.') {
 311                 $abs_dir = $cwd;
 312             }
 313             else {  # care about any  ../
 314                 $abs_dir = contract_name("$cwd/",$top_item);
 315             }
 316             $abs_dir= Follow_SymLink($abs_dir);
 317             unless (defined $abs_dir) {
 318                 warn "$top_item is a dangling symbolic link\n";
 319                 next Proc_Top_Item;
 320             }
 321             if (-d _) {
 322                 _find_dir_symlnk($wanted, $abs_dir, $top_item);
 323                 $Is_Dir= 1;
 324             }
 325         }
 326         else { # no follow
 327             $nlink = (lstat $top_item)[3];
 328             unless (defined $nlink) {
 329                 warn "Can't stat $top_item: $!\n";
 330                 next Proc_Top_Item;
 331             }
 332             if (-d _) {
 333                 $top_item =~ s/\.dir$// if $Is_VMS;
 334                 _find_dir($wanted, $top_item, $nlink);
 335                 $Is_Dir= 1;
 336             }
 337             else {
 338                 $abs_dir= $top_item;
 339             }
 340         }
 341
 342         unless ($Is_Dir) {
 343             unless (($_,$dir) = File::Basename::fileparse($abs_dir)) {
 344                 ($dir,$_) = ('.', $top_item);
 345             }
 346
 347             $abs_dir = $dir;
 348             if ($untaint) {
 349                 my $abs_dir_save = $abs_dir;
 350                 $abs_dir = $1 if $abs_dir =~ m|$untaint_pat|;
 351                 unless (defined $abs_dir) {
 352                     if ($untaint_skip == 0) {
 353                         die "directory $abs_dir_save is still tainted";
 354                     }
 355                     else {
 356                         next Proc_Top_Item;
 357                     }
 358                 }
 359             }
 360
 361             unless ($no_chdir or chdir $abs_dir) {
 362                 warn "Couldn't chdir $abs_dir: $!\n";
 363                 next Proc_Top_Item;
 364             }
 365
 366             $name = $abs_dir;
 367
 368             &$wanted_callback;
 369
 370         }
 371
 372         $no_chdir or chdir $cwd_untainted;
 373     }
 374 }
 375
 376 # API:
 377 #  $wanted
 378 #  $p_dir :  "parent directory"
 379 #  $nlink :  what came back from the stat
 380 # preconditions:
 381 #  chdir (if not no_chdir) to dir
 382
 383 sub _find_dir($$$) {
 384     my ($wanted, $p_dir, $nlink) = @_;
 385     my ($CdLvl,$Level) = (0,0);
 386     my @Stack;
 387     my @filenames;
 388     my ($subcount,$sub_nlink);
 389     my $SE= [];
 390     my $dir_name= $p_dir;
 391     my $dir_rel= '.';      # directory name relative to current directory
 392
 393     local ($dir, $name, $prune, *DIR);
 394
 395     unless ($no_chdir or $p_dir eq '.') {
 396         my $udir = $p_dir;
 397         if ($untaint) {
 398             $udir = $1 if $p_dir =~ m|$untaint_pat|;
 399             unless (defined $udir) {
 400                 if ($untaint_skip == 0) {
 401                     die "directory $p_dir is still tainted";
 402                 }
 403                 else {
 404                     return;
 405                 }
 406             }
 407         }
 408         unless (chdir $udir) {
 409             warn "Can't cd to $udir: $!\n";
 410             return;
 411         }
 412     }
 413
 414     while (defined $SE) {
 415         unless ($bydepth) {
 416             $dir= $p_dir;
 417             $name= $dir_name;
 418             $_= ($no_chdir ? $dir_name : $dir_rel );
 419             # prune may happen here
 420             $prune= 0;
 421             &$wanted_callback;
 422             next if $prune;
 423         }
 424
 425         # change to that directory
 426         unless ($no_chdir or $dir_rel eq '.') {
 427             my $udir= $dir_rel;
 428             if ($untaint) {
 429                 $udir = $1 if $dir_rel =~ m|$untaint_pat|;
 430                 unless (defined $udir) {
 431                     if ($untaint_skip == 0) {
 432                         die "directory ($p_dir/) $dir_rel is still tainted";
 433                     }
 434                 }
 435             }
 436             unless (chdir $udir) {
 437                 warn "Can't cd to ($p_dir/) $udir : $!\n";
 438                 next;
 439             }
 440             $CdLvl++;
 441         }
 442
 443         $dir= $dir_name;
 444
 445         # Get the list of files in the current directory.
 446         unless (opendir DIR, ($no_chdir ? $dir_name : '.')) {
 447             warn "Can't opendir($dir_name): $!\n";
 448             next;
 449         }
 450         @filenames = readdir DIR;
 451         closedir(DIR);
 452
 453         if ($nlink == 2 && !$avoid_nlink) {
 454             # This dir has no subdirectories.
 455             for my $FN (@filenames) {
 456                 next if $FN =~ /^\.{1,2}$/;
 457
 458                 $name = "$dir_name/$FN";
 459                 $_ = ($no_chdir ? $name : $FN);
 460                 &$wanted_callback;
 461             }
 462
 463         }
 464         else {
 465             # This dir has subdirectories.
 466             $subcount = $nlink - 2;
 467
 468             for my $FN (@filenames) {
 469                 next if $FN =~ /^\.{1,2}$/;
 470                 if ($subcount > 0 || $avoid_nlink) {
 471                     # Seen all the subdirs?
 472                     # check for directoriness.
 473                     # stat is faster for a file in the current directory
 474                     $sub_nlink = (lstat ($no_chdir ? "$dir_name/$FN" : $FN))[3];
 475
 476                     if (-d _) {
 477                         --$subcount;
 478                         $FN =~ s/\.dir$// if $Is_VMS;
 479                         push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
 480                     }
 481                     else {
 482                         $name = "$dir_name/$FN";
 483                         $_= ($no_chdir ? $name : $FN);
 484                         &$wanted_callback;
 485                     }
 486                 }
 487                 else { $name = "$dir_name/$FN";
 488                     $_= ($no_chdir ? $name : $FN);
 489                     &$wanted_callback;
 490                 }
 491             }
 492         }
 493         if ($bydepth) {
 494             $name = $dir_name;
 495             $dir = $p_dir;
 496             $_ = ($no_chdir ? $dir_name : $dir_rel );
 497             &$wanted_callback;
 498         }
 499     }
 500     continue {
 501         if ( defined ($SE = pop @Stack) ) {
 502             ($Level, $p_dir, $dir_rel, $nlink) = @$SE;
 503             if ($CdLvl > $Level && !$no_chdir) {
 504                 die "Can't cd to $dir_name" . '../' x ($CdLvl-$Level)
 505                     unless  chdir '../' x ($CdLvl-$Level);
 506                 $CdLvl = $Level;
 507             }
 508             $dir_name = "$p_dir/$dir_rel";
 509         }
 510     }
 511 }
 512
 513
 514 # API:
 515 #  $wanted
 516 #  $dir_loc : absolute location of a dir
 517 #  $p_dir   : "parent directory"
 518 # preconditions:
 519 #  chdir (if not no_chdir) to dir
 520
 521 sub _find_dir_symlnk($$$) {
 522     my ($wanted, $dir_loc, $p_dir) = @_;
 523     my @Stack;
 524     my @filenames;
 525     my $new_loc;
 526     my $SE = [];
 527     my $dir_name = $p_dir;
 528     my $dir_rel = '.';          # directory name relative to current directory
 529
 530     local ($dir, $name, $fullname, $prune, *DIR);
 531
 532     unless ($no_chdir or $p_dir eq '.') {
 533         my $udir = $dir_loc;
 534         if ($untaint) {
 535             $udir = $1 if $dir_loc =~ m|$untaint_pat|;
 536             unless (defined $udir) {
 537                 if ($untaint_skip == 0) {
 538                     die "directory $dir_loc is still tainted";
 539                 }
 540                 else {
 541                     return;
 542                 }
 543             }
 544         }
 545         unless (chdir $udir) {
 546             warn "Can't cd to $udir: $!\n";
 547             return;
 548         }
 549     }
 550
 551     while (defined $SE) {
 552
 553         unless ($bydepth) {
 554             $dir= $p_dir;
 555             $name= $dir_name;
 556             $_= ($no_chdir ? $dir_name : $dir_rel );
 557             $fullname= $dir_loc;
 558             # prune may happen here
 559             $prune= 0;
 560             &$wanted_callback;
 561             next if  $prune;
 562         }
 563
 564         # change to that directory
 565         unless ($no_chdir or $dir_rel eq '.') {
 566             my $udir = $dir_loc;
 567             if ($untaint) {
 568                 $udir = $1 if $dir_loc =~ m|$untaint_pat|;
 569                 unless (defined $udir ) {
 570                     if ($untaint_skip == 0) {
 571                         die "directory $dir_loc is still tainted";
 572                     }
 573                     else {
 574                         next;
 575                     }
 576                 }
 577             }
 578             unless (chdir $udir) {
 579                 warn "Can't cd to $udir: $!\n";
 580                 next;
 581             }
 582         }
 583
 584         $dir = $dir_name;
 585
 586         # Get the list of files in the current directory.
 587         unless (opendir DIR, ($no_chdir ? $dir_loc : '.')) {
 588             warn "Can't opendir($dir_loc): $!\n";
 589             next;
 590         }
 591         @filenames = readdir DIR;
 592         closedir(DIR);
 593
 594         for my $FN (@filenames) {
 595             next if $FN =~ /^\.{1,2}$/;
 596
 597             # follow symbolic links / do an lstat
 598             $new_loc= Follow_SymLink("$dir_loc/$FN");
 599
 600             # ignore if invalid symlink
 601             next unless defined $new_loc;
 602
 603             if (-d _) {
 604                 push @Stack,[$new_loc,$dir_name,$FN];
 605             }
 606             else {
 607                 $fullname = $new_loc;
 608                 $name = "$dir_name/$FN";
 609                 $_ = ($no_chdir ? $name : $FN);
 610                 &$wanted_callback;
 611             }
 612         }
 613
 614         if ($bydepth) {
 615             $fullname = $dir_loc;
 616             $name = $dir_name;
 617             $_ = ($no_chdir ? $dir_name : $dir_rel);
 618             &$wanted_callback;
 619         }
 620     }
 621     continue {
 622         if (defined($SE = pop @Stack)) {
 623             ($dir_loc, $p_dir, $dir_rel) = @$SE;
 624             $dir_name = "$p_dir/$dir_rel";
 625         }
 626     }
 627 }
 628
 629
 630 sub wrap_wanted {
 631     my $wanted = shift;
 632     if ( ref($wanted) eq 'HASH' ) {
 633         if ( $wanted->{follow} || $wanted->{follow_fast}) {
 634             $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip};
 635         }
 636         if ( $wanted->{untaint} ) {
 637             $wanted->{untaint_pattern} = qr|^([-+@\w./]+)$|
 638                 unless defined $wanted->{untaint_pattern};
 639             $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip};
 640         }
 641         return $wanted;
 642     }
 643     else {
 644         return { wanted => $wanted };
 645     }
 646 }
 647
 648 sub find {
 649     my $wanted = shift;
 650     _find_opt(wrap_wanted($wanted), @_);
 651     %SLnkSeen= ();  # free memory
 652 }
 653
 654 sub finddepth {
 655     my $wanted = wrap_wanted(shift);
 656     $wanted->{bydepth} = 1;
 657     _find_opt($wanted, @_);
 658     %SLnkSeen= ();  # free memory
 659 }
 660
 661 # These are hard-coded for now, but may move to hint files.
 662 if ($^O eq 'VMS') {
 663     $Is_VMS = 1;
 664     $File::Find::dont_use_nlink = 1;
 665 }
 666
 667 $File::Find::dont_use_nlink = 1
 668     if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32';
 669
 670 # Set dont_use_nlink in your hint file if your system's stat doesn't
 671 # report the number of links in a directory as an indication
 672 # of the number of files.
 673 # See, e.g. hints/machten.sh for MachTen 2.2.
 674 unless ($File::Find::dont_use_nlink) {
 675     require Config;
 676     $File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
 677 }
 678
 679 1;