| [ Index ] |
PHP Cross Reference of Unnamed Project |
[Summary view] [Print] [Text view]
1 package File::Find; 2 use 5.006; 3 use strict; 4 use warnings; 5 use warnings::register; 6 our $VERSION = '1.12'; 7 require Exporter; 8 require Cwd; 9 10 # 11 # Modified to ensure sub-directory traversal order is not inverded by stack 12 # push and pops. That is remains in the same order as in the directory file, 13 # or user pre-processing (EG:sorted). 14 # 15 16 =head1 NAME 17 18 File::Find - Traverse a directory tree. 19 20 =head1 SYNOPSIS 21 22 use File::Find; 23 find(\&wanted, @directories_to_search); 24 sub wanted { ... } 25 26 use File::Find; 27 finddepth(\&wanted, @directories_to_search); 28 sub wanted { ... } 29 30 use File::Find; 31 find({ wanted => \&process, follow => 1 }, '.'); 32 33 =head1 DESCRIPTION 34 35 These are functions for searching through directory trees doing work 36 on each file found similar to the Unix I<find> command. File::Find 37 exports two functions, C<find> and C<finddepth>. They work similarly 38 but have subtle differences. 39 40 =over 4 41 42 =item B<find> 43 44 find(\&wanted, @directories); 45 find(\%options, @directories); 46 47 C<find()> does a depth-first search over the given C<@directories> in 48 the order they are given. For each file or directory found, it calls 49 the C<&wanted> subroutine. (See below for details on how to use the 50 C<&wanted> function). Additionally, for each directory found, it will 51 C<chdir()> into that directory and continue the search, invoking the 52 C<&wanted> function on each file or subdirectory in the directory. 53 54 =item B<finddepth> 55 56 finddepth(\&wanted, @directories); 57 finddepth(\%options, @directories); 58 59 C<finddepth()> works just like C<find()> except that it invokes the 60 C<&wanted> function for a directory I<after> invoking it for the 61 directory's contents. It does a postorder traversal instead of a 62 preorder traversal, working from the bottom of the directory tree up 63 where C<find()> works from the top of the tree down. 64 65 =back 66 67 =head2 %options 68 69 The first argument to C<find()> is either a code reference to your 70 C<&wanted> function, or a hash reference describing the operations 71 to be performed for each file. The 72 code reference is described in L<The wanted function> below. 73 74 Here are the possible keys for the hash: 75 76 =over 3 77 78 =item C<wanted> 79 80 The value should be a code reference. This code reference is 81 described in L<The wanted function> below. 82 83 =item C<bydepth> 84 85 Reports the name of a directory only AFTER all its entries 86 have been reported. Entry point C<finddepth()> is a shortcut for 87 specifying C<<{ bydepth => 1 }>> in the first argument of C<find()>. 88 89 =item C<preprocess> 90 91 The value should be a code reference. This code reference is used to 92 preprocess the current directory. The name of the currently processed 93 directory is in C<$File::Find::dir>. Your preprocessing function is 94 called after C<readdir()>, but before the loop that calls the C<wanted()> 95 function. It is called with a list of strings (actually file/directory 96 names) and is expected to return a list of strings. The code can be 97 used to sort the file/directory names alphabetically, numerically, 98 or to filter out directory entries based on their name alone. When 99 I<follow> or I<follow_fast> are in effect, C<preprocess> is a no-op. 100 101 =item C<postprocess> 102 103 The value should be a code reference. It is invoked just before leaving 104 the currently processed directory. It is called in void context with no 105 arguments. The name of the current directory is in C<$File::Find::dir>. This 106 hook is handy for summarizing a directory, such as calculating its disk 107 usage. When I<follow> or I<follow_fast> are in effect, C<postprocess> is a 108 no-op. 109 110 =item C<follow> 111 112 Causes symbolic links to be followed. Since directory trees with symbolic 113 links (followed) may contain files more than once and may even have 114 cycles, a hash has to be built up with an entry for each file. 115 This might be expensive both in space and time for a large 116 directory tree. See I<follow_fast> and I<follow_skip> below. 117 If either I<follow> or I<follow_fast> is in effect: 118 119 =over 6 120 121 =item * 122 123 It is guaranteed that an I<lstat> has been called before the user's 124 C<wanted()> function is called. This enables fast file checks involving S<_>. 125 Note that this guarantee no longer holds if I<follow> or I<follow_fast> 126 are not set. 127 128 =item * 129 130 There is a variable C<$File::Find::fullname> which holds the absolute 131 pathname of the file with all symbolic links resolved. If the link is 132 a dangling symbolic link, then fullname will be set to C<undef>. 133 134 =back 135 136 This is a no-op on Win32. 137 138 =item C<follow_fast> 139 140 This is similar to I<follow> except that it may report some files more 141 than once. It does detect cycles, however. Since only symbolic links 142 have to be hashed, this is much cheaper both in space and time. If 143 processing a file more than once (by the user's C<wanted()> function) 144 is worse than just taking time, the option I<follow> should be used. 145 146 This is also a no-op on Win32. 147 148 =item C<follow_skip> 149 150 C<follow_skip==1>, which is the default, causes all files which are 151 neither directories nor symbolic links to be ignored if they are about 152 to be processed a second time. If a directory or a symbolic link 153 are about to be processed a second time, File::Find dies. 154 155 C<follow_skip==0> causes File::Find to die if any file is about to be 156 processed a second time. 157 158 C<follow_skip==2> causes File::Find to ignore any duplicate files and 159 directories but to proceed normally otherwise. 160 161 =item C<dangling_symlinks> 162 163 If true and a code reference, will be called with the symbolic link 164 name and the directory it lives in as arguments. Otherwise, if true 165 and warnings are on, warning "symbolic_link_name is a dangling 166 symbolic link\n" will be issued. If false, the dangling symbolic link 167 will be silently ignored. 168 169 =item C<no_chdir> 170 171 Does not C<chdir()> to each directory as it recurses. The C<wanted()> 172 function will need to be aware of this, of course. In this case, 173 C<$_> will be the same as C<$File::Find::name>. 174 175 =item C<untaint> 176 177 If find is used in taint-mode (-T command line switch or if EUID != UID 178 or if EGID != GID) then internally directory names have to be untainted 179 before they can be chdir'ed to. Therefore they are checked against a regular 180 expression I<untaint_pattern>. Note that all names passed to the user's 181 I<wanted()> function are still tainted. If this option is used while 182 not in taint-mode, C<untaint> is a no-op. 183 184 =item C<untaint_pattern> 185 186 See above. This should be set using the C<qr> quoting operator. 187 The default is set to C<qr|^([-+@\w./]+)$|>. 188 Note that the parentheses are vital. 189 190 =item C<untaint_skip> 191 192 If set, a directory which fails the I<untaint_pattern> is skipped, 193 including all its sub-directories. The default is to 'die' in such a case. 194 195 =back 196 197 =head2 The wanted function 198 199 The C<wanted()> function does whatever verifications you want on 200 each file and directory. Note that despite its name, the C<wanted()> 201 function is a generic callback function, and does B<not> tell 202 File::Find if a file is "wanted" or not. In fact, its return value 203 is ignored. 204 205 The wanted function takes no arguments but rather does its work 206 through a collection of variables. 207 208 =over 4 209 210 =item C<$File::Find::dir> is the current directory name, 211 212 =item C<$_> is the current filename within that directory 213 214 =item C<$File::Find::name> is the complete pathname to the file. 215 216 =back 217 218 The above variables have all been localized and may be changed without 219 effecting data outside of the wanted function. 220 221 For example, when examining the file F</some/path/foo.ext> you will have: 222 223 $File::Find::dir = /some/path/ 224 $_ = foo.ext 225 $File::Find::name = /some/path/foo.ext 226 227 You are chdir()'d to C<$File::Find::dir> when the function is called, 228 unless C<no_chdir> was specified. Note that when changing to 229 directories is in effect the root directory (F</>) is a somewhat 230 special case inasmuch as the concatenation of C<$File::Find::dir>, 231 C<'/'> and C<$_> is not literally equal to C<$File::Find::name>. The 232 table below summarizes all variants: 233 234 $File::Find::name $File::Find::dir $_ 235 default / / . 236 no_chdir=>0 /etc / etc 237 /etc/x /etc x 238 239 no_chdir=>1 / / / 240 /etc / /etc 241 /etc/x /etc /etc/x 242 243 244 When <follow> or <follow_fast> are in effect, there is 245 also a C<$File::Find::fullname>. The function may set 246 C<$File::Find::prune> to prune the tree unless C<bydepth> was 247 specified. Unless C<follow> or C<follow_fast> is specified, for 248 compatibility reasons (find.pl, find2perl) there are in addition the 249 following globals available: C<$File::Find::topdir>, 250 C<$File::Find::topdev>, C<$File::Find::topino>, 251 C<$File::Find::topmode> and C<$File::Find::topnlink>. 252 253 This library is useful for the C<find2perl> tool, which when fed, 254 255 find2perl / -name .nfs\* -mtime +7 \ 256 -exec rm -f {} \; -o -fstype nfs -prune 257 258 produces something like: 259 260 sub wanted { 261 /^\.nfs.*\z/s && 262 (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_)) && 263 int(-M _) > 7 && 264 unlink($_) 265 || 266 ($nlink || (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_))) && 267 $dev < 0 && 268 ($File::Find::prune = 1); 269 } 270 271 Notice the C<_> in the above C<int(-M _)>: the C<_> is a magical 272 filehandle that caches the information from the preceding 273 C<stat()>, C<lstat()>, or filetest. 274 275 Here's another interesting wanted function. It will find all symbolic 276 links that don't resolve: 277 278 sub wanted { 279 -l && !-e && print "bogus link: $File::Find::name\n"; 280 } 281 282 See also the script C<pfind> on CPAN for a nice application of this 283 module. 284 285 =head1 WARNINGS 286 287 If you run your program with the C<-w> switch, or if you use the 288 C<warnings> pragma, File::Find will report warnings for several weird 289 situations. You can disable these warnings by putting the statement 290 291 no warnings 'File::Find'; 292 293 in the appropriate scope. See L<perllexwarn> for more info about lexical 294 warnings. 295 296 =head1 CAVEAT 297 298 =over 2 299 300 =item $dont_use_nlink 301 302 You can set the variable C<$File::Find::dont_use_nlink> to 1, if you want to 303 force File::Find to always stat directories. This was used for file systems 304 that do not have an C<nlink> count matching the number of sub-directories. 305 Examples are ISO-9660 (CD-ROM), AFS, HPFS (OS/2 file system), FAT (DOS file 306 system) and a couple of others. 307 308 You shouldn't need to set this variable, since File::Find should now detect 309 such file systems on-the-fly and switch itself to using stat. This works even 310 for parts of your file system, like a mounted CD-ROM. 311 312 If you do set C<$File::Find::dont_use_nlink> to 1, you will notice slow-downs. 313 314 =item symlinks 315 316 Be aware that the option to follow symbolic links can be dangerous. 317 Depending on the structure of the directory tree (including symbolic 318 links to directories) you might traverse a given (physical) directory 319 more than once (only if C<follow_fast> is in effect). 320 Furthermore, deleting or changing files in a symbolically linked directory 321 might cause very unpleasant surprises, since you delete or change files 322 in an unknown directory. 323 324 =back 325 326 =head1 NOTES 327 328 =over 4 329 330 =item * 331 332 Mac OS (Classic) users should note a few differences: 333 334 =over 4 335 336 =item * 337 338 The path separator is ':', not '/', and the current directory is denoted 339 as ':', not '.'. You should be careful about specifying relative pathnames. 340 While a full path always begins with a volume name, a relative pathname 341 should always begin with a ':'. If specifying a volume name only, a 342 trailing ':' is required. 343 344 =item * 345 346 C<$File::Find::dir> is guaranteed to end with a ':'. If C<$_> 347 contains the name of a directory, that name may or may not end with a 348 ':'. Likewise, C<$File::Find::name>, which contains the complete 349 pathname to that directory, and C<$File::Find::fullname>, which holds 350 the absolute pathname of that directory with all symbolic links resolved, 351 may or may not end with a ':'. 352 353 =item * 354 355 The default C<untaint_pattern> (see above) on Mac OS is set to 356 C<qr|^(.+)$|>. Note that the parentheses are vital. 357 358 =item * 359 360 The invisible system file "Icon\015" is ignored. While this file may 361 appear in every directory, there are some more invisible system files 362 on every volume, which are all located at the volume root level (i.e. 363 "MacintoshHD:"). These system files are B<not> excluded automatically. 364 Your filter may use the following code to recognize invisible files or 365 directories (requires Mac::Files): 366 367 use Mac::Files; 368 369 # invisible() -- returns 1 if file/directory is invisible, 370 # 0 if it's visible or undef if an error occurred 371 372 sub invisible($) { 373 my $file = shift; 374 my ($fileCat, $fileInfo); 375 my $invisible_flag = 1 << 14; 376 377 if ( $fileCat = FSpGetCatInfo($file) ) { 378 if ($fileInfo = $fileCat->ioFlFndrInfo() ) { 379 return (($fileInfo->fdFlags & $invisible_flag) && 1); 380 } 381 } 382 return undef; 383 } 384 385 Generally, invisible files are system files, unless an odd application 386 decides to use invisible files for its own purposes. To distinguish 387 such files from system files, you have to look at the B<type> and B<creator> 388 file attributes. The MacPerl built-in functions C<GetFileInfo(FILE)> and 389 C<SetFileInfo(CREATOR, TYPE, FILES)> offer access to these attributes 390 (see MacPerl.pm for details). 391 392 Files that appear on the desktop actually reside in an (hidden) directory 393 named "Desktop Folder" on the particular disk volume. Note that, although 394 all desktop files appear to be on the same "virtual" desktop, each disk 395 volume actually maintains its own "Desktop Folder" directory. 396 397 =back 398 399 =back 400 401 =head1 BUGS AND CAVEATS 402 403 Despite the name of the C<finddepth()> function, both C<find()> and 404 C<finddepth()> perform a depth-first search of the directory 405 hierarchy. 406 407 =head1 HISTORY 408 409 File::Find used to produce incorrect results if called recursively. 410 During the development of perl 5.8 this bug was fixed. 411 The first fixed version of File::Find was 1.01. 412 413 =cut 414 415 our @ISA = qw(Exporter); 416 our @EXPORT = qw(find finddepth); 417 418 419 use strict; 420 my $Is_VMS; 421 my $Is_MacOS; 422 423 require File::Basename; 424 require File::Spec; 425 426 # Should ideally be my() not our() but local() currently 427 # refuses to operate on lexicals 428 429 our %SLnkSeen; 430 our ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow, 431 $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat, 432 $pre_process, $post_process, $dangling_symlinks); 433 434 sub contract_name { 435 my ($cdir,$fn) = @_; 436 437 return substr($cdir,0,rindex($cdir,'/')) if $fn eq $File::Find::current_dir; 438 439 $cdir = substr($cdir,0,rindex($cdir,'/')+1); 440 441 $fn =~ s|^\./||; 442 443 my $abs_name= $cdir . $fn; 444 445 if (substr($fn,0,3) eq '../') { 446 1 while $abs_name =~ s!/[^/]*/\.\./!/!; 447 } 448 449 return $abs_name; 450 } 451 452 # return the absolute name of a directory or file 453 sub contract_name_Mac { 454 my ($cdir,$fn) = @_; 455 my $abs_name; 456 457 if ($fn =~ /^(:+)(.*)$/) { # valid pathname starting with a ':' 458 459 my $colon_count = length ($1); 460 if ($colon_count == 1) { 461 $abs_name = $cdir . $2; 462 return $abs_name; 463 } 464 else { 465 # need to move up the tree, but 466 # only if it's not a volume name 467 for (my $i=1; $i<$colon_count; $i++) { 468 unless ($cdir =~ /^[^:]+:$/) { # volume name 469 $cdir =~ s/[^:]+:$//; 470 } 471 else { 472 return undef; 473 } 474 } 475 $abs_name = $cdir . $2; 476 return $abs_name; 477 } 478 479 } 480 else { 481 482 # $fn may be a valid path to a directory or file or (dangling) 483 # symlink, without a leading ':' 484 if ( (-e $fn) || (-l $fn) ) { 485 if ($fn =~ /^[^:]+:/) { # a volume name like DataHD:* 486 return $fn; # $fn is already an absolute path 487 } 488 else { 489 $abs_name = $cdir . $fn; 490 return $abs_name; 491 } 492 } 493 else { # argh!, $fn is not a valid directory/file 494 return undef; 495 } 496 } 497 } 498 499 sub PathCombine($$) { 500 my ($Base,$Name) = @_; 501 my $AbsName; 502 503 if ($Is_MacOS) { 504 # $Name is the resolved symlink (always a full path on MacOS), 505 # i.e. there's no need to call contract_name_Mac() 506 $AbsName = $Name; 507 508 # (simple) check for recursion 509 if ( ( $Base =~ /^$AbsName/) && (-d $AbsName) ) { # recursion 510 return undef; 511 } 512 } 513 else { 514 if (substr($Name,0,1) eq '/') { 515 $AbsName= $Name; 516 } 517 else { 518 $AbsName= contract_name($Base,$Name); 519 } 520 521 # (simple) check for recursion 522 my $newlen= length($AbsName); 523 if ($newlen <= length($Base)) { 524 if (($newlen == length($Base) || substr($Base,$newlen,1) eq '/') 525 && $AbsName eq substr($Base,0,$newlen)) 526 { 527 return undef; 528 } 529 } 530 } 531 return $AbsName; 532 } 533 534 sub Follow_SymLink($) { 535 my ($AbsName) = @_; 536 537 my ($NewName,$DEV, $INO); 538 ($DEV, $INO)= lstat $AbsName; 539 540 while (-l _) { 541 if ($SLnkSeen{$DEV, $INO}++) { 542 if ($follow_skip < 2) { 543 die "$AbsName is encountered a second time"; 544 } 545 else { 546 return undef; 547 } 548 } 549 $NewName= PathCombine($AbsName, readlink($AbsName)); 550 unless(defined $NewName) { 551 if ($follow_skip < 2) { 552 die "$AbsName is a recursive symbolic link"; 553 } 554 else { 555 return undef; 556 } 557 } 558 else { 559 $AbsName= $NewName; 560 } 561 ($DEV, $INO) = lstat($AbsName); 562 return undef unless defined $DEV; # dangling symbolic link 563 } 564 565 if ($full_check && defined $DEV && $SLnkSeen{$DEV, $INO}++) { 566 if ( ($follow_skip < 1) || ((-d _) && ($follow_skip < 2)) ) { 567 die "$AbsName encountered a second time"; 568 } 569 else { 570 return undef; 571 } 572 } 573 574 return $AbsName; 575 } 576 577 our($dir, $name, $fullname, $prune); 578 sub _find_dir_symlnk($$$); 579 sub _find_dir($$$); 580 581 # check whether or not a scalar variable is tainted 582 # (code straight from the Camel, 3rd ed., page 561) 583 sub is_tainted_pp { 584 my $arg = shift; 585 my $nada = substr($arg, 0, 0); # zero-length 586 local $@; 587 eval { eval "# $nada" }; 588 return length($@) != 0; 589 } 590 591 sub _find_opt { 592 my $wanted = shift; 593 die "invalid top directory" unless defined $_[0]; 594 595 # This function must local()ize everything because callbacks may 596 # call find() or finddepth() 597 598 local %SLnkSeen; 599 local ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow, 600 $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat, 601 $pre_process, $post_process, $dangling_symlinks); 602 local($dir, $name, $fullname, $prune); 603 local *_ = \my $a; 604 605 my $cwd = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::getcwd(); 606 if ($Is_VMS) { 607 # VMS returns this by default in VMS format which just doesn't 608 # work for the rest of this module. 609 $cwd = VMS::Filespec::unixpath($cwd); 610 611 # Apparently this is not expected to have a trailing space. 612 # To attempt to make VMS/UNIX conversions mostly reversable, 613 # a trailing slash is needed. The run-time functions ignore the 614 # resulting double slash, but it causes the perl tests to fail. 615 $cwd =~ s#/\z##; 616 617 # This comes up in upper case now, but should be lower. 618 # In the future this could be exact case, no need to change. 619 } 620 my $cwd_untainted = $cwd; 621 my $check_t_cwd = 1; 622 $wanted_callback = $wanted->{wanted}; 623 $bydepth = $wanted->{bydepth}; 624 $pre_process = $wanted->{preprocess}; 625 $post_process = $wanted->{postprocess}; 626 $no_chdir = $wanted->{no_chdir}; 627 $full_check = $^O eq 'MSWin32' ? 0 : $wanted->{follow}; 628 $follow = $^O eq 'MSWin32' ? 0 : 629 $full_check || $wanted->{follow_fast}; 630 $follow_skip = $wanted->{follow_skip}; 631 $untaint = $wanted->{untaint}; 632 $untaint_pat = $wanted->{untaint_pattern}; 633 $untaint_skip = $wanted->{untaint_skip}; 634 $dangling_symlinks = $wanted->{dangling_symlinks}; 635 636 # for compatibility reasons (find.pl, find2perl) 637 local our ($topdir, $topdev, $topino, $topmode, $topnlink); 638 639 # a symbolic link to a directory doesn't increase the link count 640 $avoid_nlink = $follow || $File::Find::dont_use_nlink; 641 642 my ($abs_dir, $Is_Dir); 643 644 Proc_Top_Item: 645 foreach my $TOP (@_) { 646 my $top_item = $TOP; 647 648 ($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item; 649 650 if ($Is_MacOS) { 651 $top_item = ":$top_item" 652 if ( (-d _) && ( $top_item !~ /:/ ) ); 653 } elsif ($^O eq 'MSWin32') { 654 $top_item =~ s|/\z|| unless $top_item =~ m|\w:/$|; 655 } 656 else { 657 $top_item =~ s|/\z|| unless $top_item eq '/'; 658 } 659 660 $Is_Dir= 0; 661 662 if ($follow) { 663 664 if ($Is_MacOS) { 665 $cwd = "$cwd:" unless ($cwd =~ /:$/); # for safety 666 667 if ($top_item eq $File::Find::current_dir) { 668 $abs_dir = $cwd; 669 } 670 else { 671 $abs_dir = contract_name_Mac($cwd, $top_item); 672 unless (defined $abs_dir) { 673 warnings::warnif "Can't determine absolute path for $top_item (No such file or directory)\n"; 674 next Proc_Top_Item; 675 } 676 } 677 678 } 679 else { 680 if (substr($top_item,0,1) eq '/') { 681 $abs_dir = $top_item; 682 } 683 elsif ($top_item eq $File::Find::current_dir) { 684 $abs_dir = $cwd; 685 } 686 else { # care about any ../ 687 $top_item =~ s/\.dir\z//i if $Is_VMS; 688 $abs_dir = contract_name("$cwd/",$top_item); 689 } 690 } 691 $abs_dir= Follow_SymLink($abs_dir); 692 unless (defined $abs_dir) { 693 if ($dangling_symlinks) { 694 if (ref $dangling_symlinks eq 'CODE') { 695 $dangling_symlinks->($top_item, $cwd); 696 } else { 697 warnings::warnif "$top_item is a dangling symbolic link\n"; 698 } 699 } 700 next Proc_Top_Item; 701 } 702 703 if (-d _) { 704 $top_item =~ s/\.dir\z//i if $Is_VMS; 705 _find_dir_symlnk($wanted, $abs_dir, $top_item); 706 $Is_Dir= 1; 707 } 708 } 709 else { # no follow 710 $topdir = $top_item; 711 unless (defined $topnlink) { 712 warnings::warnif "Can't stat $top_item: $!\n"; 713 next Proc_Top_Item; 714 } 715 if (-d _) { 716 $top_item =~ s/\.dir\z//i if $Is_VMS; 717 _find_dir($wanted, $top_item, $topnlink); 718 $Is_Dir= 1; 719 } 720 else { 721 $abs_dir= $top_item; 722 } 723 } 724 725 unless ($Is_Dir) { 726 unless (($_,$dir) = File::Basename::fileparse($abs_dir)) { 727 if ($Is_MacOS) { 728 ($dir,$_) = (':', $top_item); # $File::Find::dir, $_ 729 } 730 else { 731 ($dir,$_) = ('./', $top_item); 732 } 733 } 734 735 $abs_dir = $dir; 736 if (( $untaint ) && (is_tainted($dir) )) { 737 ( $abs_dir ) = $dir =~ m|$untaint_pat|; 738 unless (defined $abs_dir) { 739 if ($untaint_skip == 0) { 740 die "directory $dir is still tainted"; 741 } 742 else { 743 next Proc_Top_Item; 744 } 745 } 746 } 747 748 unless ($no_chdir || chdir $abs_dir) { 749 warnings::warnif "Couldn't chdir $abs_dir: $!\n"; 750 next Proc_Top_Item; 751 } 752 753 $name = $abs_dir . $_; # $File::Find::name 754 $_ = $name if $no_chdir; 755 756 { $wanted_callback->() }; # protect against wild "next" 757 758 } 759 760 unless ( $no_chdir ) { 761 if ( ($check_t_cwd) && (($untaint) && (is_tainted($cwd) )) ) { 762 ( $cwd_untainted ) = $cwd =~ m|$untaint_pat|; 763 unless (defined $cwd_untainted) { 764 die "insecure cwd in find(depth)"; 765 } 766 $check_t_cwd = 0; 767 } 768 unless (chdir $cwd_untainted) { 769 die "Can't cd to $cwd: $!\n"; 770 } 771 } 772 } 773 } 774 775 # API: 776 # $wanted 777 # $p_dir : "parent directory" 778 # $nlink : what came back from the stat 779 # preconditions: 780 # chdir (if not no_chdir) to dir 781 782 sub _find_dir($$$) { 783 my ($wanted, $p_dir, $nlink) = @_; 784 my ($CdLvl,$Level) = (0,0); 785 my @Stack; 786 my @filenames; 787 my ($subcount,$sub_nlink); 788 my $SE= []; 789 my $dir_name= $p_dir; 790 my $dir_pref; 791 my $dir_rel = $File::Find::current_dir; 792 my $tainted = 0; 793 my $no_nlink; 794 795 if ($Is_MacOS) { 796 $dir_pref= ($p_dir =~ /:$/) ? $p_dir : "$p_dir:"; # preface 797 } elsif ($^O eq 'MSWin32') { 798 $dir_pref = ($p_dir =~ m|\w:/$| ? $p_dir : "$p_dir/" ); 799 } elsif ($^O eq 'VMS') { 800 801 # VMS is returning trailing .dir on directories 802 # and trailing . on files and symbolic links 803 # in UNIX syntax. 804 # 805 806 $p_dir =~ s/\.(dir)?$//i unless $p_dir eq '.'; 807 808 $dir_pref = ($p_dir =~ m/[\]>]+$/ ? $p_dir : "$p_dir/" ); 809 } 810 else { 811 $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" ); 812 } 813 814 local ($dir, $name, $prune, *DIR); 815 816 unless ( $no_chdir || ($p_dir eq $File::Find::current_dir)) { 817 my $udir = $p_dir; 818 if (( $untaint ) && (is_tainted($p_dir) )) { 819 ( $udir ) = $p_dir =~ m|$untaint_pat|; 820 unless (defined $udir) { 821 if ($untaint_skip == 0) { 822 die "directory $p_dir is still tainted"; 823 } 824 else { 825 return; 826 } 827 } 828 } 829 unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) { 830 warnings::warnif "Can't cd to $udir: $!\n"; 831 return; 832 } 833 } 834 835 # push the starting directory 836 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth; 837 838 if ($Is_MacOS) { 839 $p_dir = $dir_pref; # ensure trailing ':' 840 } 841 842 while (defined $SE) { 843 unless ($bydepth) { 844 $dir= $p_dir; # $File::Find::dir 845 $name= $dir_name; # $File::Find::name 846 $_= ($no_chdir ? $dir_name : $dir_rel ); # $_ 847 # prune may happen here 848 $prune= 0; 849 { $wanted_callback->() }; # protect against wild "next" 850 next if $prune; 851 } 852 853 # change to that directory 854 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) { 855 my $udir= $dir_rel; 856 if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_rel) )) ) { 857 ( $udir ) = $dir_rel =~ m|$untaint_pat|; 858 unless (defined $udir) { 859 if ($untaint_skip == 0) { 860 if ($Is_MacOS) { 861 die "directory ($p_dir) $dir_rel is still tainted"; 862 } 863 else { 864 die "directory (" . ($p_dir ne '/' ? $p_dir : '') . "/) $dir_rel is still tainted"; 865 } 866 } else { # $untaint_skip == 1 867 next; 868 } 869 } 870 } 871 unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) { 872 if ($Is_MacOS) { 873 warnings::warnif "Can't cd to ($p_dir) $udir: $!\n"; 874 } 875 else { 876 warnings::warnif "Can't cd to (" . 877 ($p_dir ne '/' ? $p_dir : '') . "/) $udir: $!\n"; 878 } 879 next; 880 } 881 $CdLvl++; 882 } 883 884 if ($Is_MacOS) { 885 $dir_name = "$dir_name:" unless ($dir_name =~ /:$/); 886 } 887 888 $dir= $dir_name; # $File::Find::dir 889 890 # Get the list of files in the current directory. 891 unless (opendir DIR, ($no_chdir ? $dir_name : $File::Find::current_dir)) { 892 warnings::warnif "Can't opendir($dir_name): $!\n"; 893 next; 894 } 895 @filenames = readdir DIR; 896 closedir(DIR); 897 @filenames = $pre_process->(@filenames) if $pre_process; 898 push @Stack,[$CdLvl,$dir_name,"",-2] if $post_process; 899 900 # default: use whatever was specifid 901 # (if $nlink >= 2, and $avoid_nlink == 0, this will switch back) 902 $no_nlink = $avoid_nlink; 903 # if dir has wrong nlink count, force switch to slower stat method 904 $no_nlink = 1 if ($nlink < 2); 905 906 if ($nlink == 2 && !$no_nlink) { 907 # This dir has no subdirectories. 908 for my $FN (@filenames) { 909 if ($Is_VMS) { 910 # Big hammer here - Compensate for VMS trailing . and .dir 911 # No win situation until this is changed, but this 912 # will handle the majority of the cases with breaking the fewest 913 914 $FN =~ s/\.dir\z//i; 915 $FN =~ s#\.$## if ($FN ne '.'); 916 } 917 next if $FN =~ $File::Find::skip_pattern; 918 919 $name = $dir_pref . $FN; # $File::Find::name 920 $_ = ($no_chdir ? $name : $FN); # $_ 921 { $wanted_callback->() }; # protect against wild "next" 922 } 923 924 } 925 else { 926 # This dir has subdirectories. 927 $subcount = $nlink - 2; 928 929 # HACK: insert directories at this position. so as to preserve 930 # the user pre-processed ordering of files. 931 # EG: directory traversal is in user sorted order, not at random. 932 my $stack_top = @Stack; 933 934 for my $FN (@filenames) { 935 next if $FN =~ $File::Find::skip_pattern; 936 if ($subcount > 0 || $no_nlink) { 937 # Seen all the subdirs? 938 # check for directoriness. 939 # stat is faster for a file in the current directory 940 $sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3]; 941 942 if (-d _) { 943 --$subcount; 944 $FN =~ s/\.dir\z//i if $Is_VMS; 945 # HACK: replace push to preserve dir traversal order 946 #push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink]; 947 splice @Stack, $stack_top, 0, 948 [$CdLvl,$dir_name,$FN,$sub_nlink]; 949 } 950 else { 951 $name = $dir_pref . $FN; # $File::Find::name 952 $_= ($no_chdir ? $name : $FN); # $_ 953 { $wanted_callback->() }; # protect against wild "next" 954 } 955 } 956 else { 957 $name = $dir_pref . $FN; # $File::Find::name 958 $_= ($no_chdir ? $name : $FN); # $_ 959 { $wanted_callback->() }; # protect against wild "next" 960 } 961 } 962 } 963 } 964 continue { 965 while ( defined ($SE = pop @Stack) ) { 966 ($Level, $p_dir, $dir_rel, $nlink) = @$SE; 967 if ($CdLvl > $Level && !$no_chdir) { 968 my $tmp; 969 if ($Is_MacOS) { 970 $tmp = (':' x ($CdLvl-$Level)) . ':'; 971 } 972 elsif ($Is_VMS) { 973 $tmp = '[' . ('-' x ($CdLvl-$Level)) . ']'; 974 } 975 else { 976 $tmp = join('/',('..') x ($CdLvl-$Level)); 977 } 978 die "Can't cd to $tmp from $dir_name" 979 unless chdir ($tmp); 980 $CdLvl = $Level; 981 } 982 983 if ($Is_MacOS) { 984 # $pdir always has a trailing ':', except for the starting dir, 985 # where $dir_rel eq ':' 986 $dir_name = "$p_dir$dir_rel"; 987 $dir_pref = "$dir_name:"; 988 } 989 elsif ($^O eq 'MSWin32') { 990 $dir_name = ($p_dir =~ m|\w:/$| ? "$p_dir$dir_rel" : "$p_dir/$dir_rel"); 991 $dir_pref = "$dir_name/"; 992 } 993 elsif ($^O eq 'VMS') { 994 if ($p_dir =~ m/[\]>]+$/) { 995 $dir_name = $p_dir; 996 $dir_name =~ s/([\]>]+)$/.$dir_rel$1/; 997 $dir_pref = $dir_name; 998 } 999 else { 1000 $dir_name = "$p_dir/$dir_rel"; 1001 $dir_pref = "$dir_name/"; 1002 } 1003 } 1004 else { 1005 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel"); 1006 $dir_pref = "$dir_name/"; 1007 } 1008 1009 if ( $nlink == -2 ) { 1010 $name = $dir = $p_dir; # $File::Find::name / dir 1011 $_ = $File::Find::current_dir; 1012 $post_process->(); # End-of-directory processing 1013 } 1014 elsif ( $nlink < 0 ) { # must be finddepth, report dirname now 1015 $name = $dir_name; 1016 if ($Is_MacOS) { 1017 if ($dir_rel eq ':') { # must be the top dir, where we started 1018 $name =~ s|:$||; # $File::Find::name 1019 $p_dir = "$p_dir:" unless ($p_dir =~ /:$/); 1020 } 1021 $dir = $p_dir; # $File::Find::dir 1022 $_ = ($no_chdir ? $name : $dir_rel); # $_ 1023 } 1024 else { 1025 if ( substr($name,-2) eq '/.' ) { 1026 substr($name, length($name) == 2 ? -1 : -2) = ''; 1027 } 1028 $dir = $p_dir; 1029 $_ = ($no_chdir ? $dir_name : $dir_rel ); 1030 if ( substr($_,-2) eq '/.' ) { 1031 substr($_, length($_) == 2 ? -1 : -2) = ''; 1032 } 1033 } 1034 { $wanted_callback->() }; # protect against wild "next" 1035 } 1036 else { 1037 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth; 1038 last; 1039 } 1040 } 1041 } 1042 } 1043 1044 1045 # API: 1046 # $wanted 1047 # $dir_loc : absolute location of a dir 1048 # $p_dir : "parent directory" 1049 # preconditions: 1050 # chdir (if not no_chdir) to dir 1051 1052 sub _find_dir_symlnk($$$) { 1053 my ($wanted, $dir_loc, $p_dir) = @_; # $dir_loc is the absolute directory 1054 my @Stack; 1055 my @filenames; 1056 my $new_loc; 1057 my $updir_loc = $dir_loc; # untainted parent directory 1058 my $SE = []; 1059 my $dir_name = $p_dir; 1060 my $dir_pref; 1061 my $loc_pref; 1062 my $dir_rel = $File::Find::current_dir; 1063 my $byd_flag; # flag for pending stack entry if $bydepth 1064 my $tainted = 0; 1065 my $ok = 1; 1066 1067 if ($Is_MacOS) { 1068 $dir_pref = ($p_dir =~ /:$/) ? "$p_dir" : "$p_dir:"; 1069 $loc_pref = ($dir_loc =~ /:$/) ? "$dir_loc" : "$dir_loc:"; 1070 } else { 1071 $dir_pref = ( $p_dir eq '/' ? '/' : "$p_dir/" ); 1072 $loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" ); 1073 } 1074 1075 local ($dir, $name, $fullname, $prune, *DIR); 1076 1077 unless ($no_chdir) { 1078 # untaint the topdir 1079 if (( $untaint ) && (is_tainted($dir_loc) )) { 1080 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|; # parent dir, now untainted 1081 # once untainted, $updir_loc is pushed on the stack (as parent directory); 1082 # hence, we don't need to untaint the parent directory every time we chdir 1083 # to it later 1084 unless (defined $updir_loc) { 1085 if ($untaint_skip == 0) { 1086 die "directory $dir_loc is still tainted"; 1087 } 1088 else { 1089 return; 1090 } 1091 } 1092 } 1093 $ok = chdir($updir_loc) unless ($p_dir eq $File::Find::current_dir); 1094 unless ($ok) { 1095 warnings::warnif "Can't cd to $updir_loc: $!\n"; 1096 return; 1097 } 1098 } 1099 1100 push @Stack,[$dir_loc,$updir_loc,$p_dir,$dir_rel,-1] if $bydepth; 1101 1102 if ($Is_MacOS) { 1103 $p_dir = $dir_pref; # ensure trailing ':' 1104 } 1105 1106 while (defined $SE) { 1107 1108 unless ($bydepth) { 1109 # change (back) to parent directory (always untainted) 1110 unless ($no_chdir) { 1111 unless (chdir $updir_loc) { 1112 warnings::warnif "Can't cd to $updir_loc: $!\n"; 1113 next; 1114 } 1115 } 1116 $dir= $p_dir; # $File::Find::dir 1117 $name= $dir_name; # $File::Find::name 1118 $_= ($no_chdir ? $dir_name : $dir_rel ); # $_ 1119 $fullname= $dir_loc; # $File::Find::fullname 1120 # prune may happen here 1121 $prune= 0; 1122 lstat($_); # make sure file tests with '_' work 1123 { $wanted_callback->() }; # protect against wild "next" 1124 next if $prune; 1125 } 1126 1127 # change to that directory 1128 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) { 1129 $updir_loc = $dir_loc; 1130 if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_loc) )) ) { 1131 # untaint $dir_loc, what will be pushed on the stack as (untainted) parent dir 1132 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|; 1133 unless (defined $updir_loc) { 1134 if ($untaint_skip == 0) { 1135 die "directory $dir_loc is still tainted"; 1136 } 1137 else { 1138 next; 1139 } 1140 } 1141 } 1142 unless (chdir $updir_loc) { 1143 warnings::warnif "Can't cd to $updir_loc: $!\n"; 1144 next; 1145 } 1146 } 1147 1148 if ($Is_MacOS) { 1149 $dir_name = "$dir_name:" unless ($dir_name =~ /:$/); 1150 } 1151 1152 $dir = $dir_name; # $File::Find::dir 1153 1154 # Get the list of files in the current directory. 1155 unless (opendir DIR, ($no_chdir ? $dir_loc : $File::Find::current_dir)) { 1156 warnings::warnif "Can't opendir($dir_loc): $!\n"; 1157 next; 1158 } 1159 @filenames = readdir DIR; 1160 closedir(DIR); 1161 1162 for my $FN (@filenames) { 1163 if ($Is_VMS) { 1164 # Big hammer here - Compensate for VMS trailing . and .dir 1165 # No win situation until this is changed, but this 1166 # will handle the majority of the cases with breaking the fewest. 1167 1168 $FN =~ s/\.dir\z//i; 1169 $FN =~ s#\.$## if ($FN ne '.'); 1170 } 1171 next if $FN =~ $File::Find::skip_pattern; 1172 1173 # follow symbolic links / do an lstat 1174 $new_loc = Follow_SymLink($loc_pref.$FN); 1175 1176 # ignore if invalid symlink 1177 unless (defined $new_loc) { 1178 if (!defined -l _ && $dangling_symlinks) { 1179 if (ref $dangling_symlinks eq 'CODE') { 1180 $dangling_symlinks->($FN, $dir_pref); 1181 } else { 1182 warnings::warnif "$dir_pref$FN is a dangling symbolic link\n"; 1183 } 1184 } 1185 1186 $fullname = undef; 1187 $name = $dir_pref . $FN; 1188 $_ = ($no_chdir ? $name : $FN); 1189 { $wanted_callback->() }; 1190 next; 1191 } 1192 1193 if (-d _) { 1194 if ($Is_VMS) { 1195 $FN =~ s/\.dir\z//i; 1196 $FN =~ s#\.$## if ($FN ne '.'); 1197 $new_loc =~ s/\.dir\z//i; 1198 $new_loc =~ s#\.$## if ($new_loc ne '.'); 1199 } 1200 push @Stack,[$new_loc,$updir_loc,$dir_name,$FN,1]; 1201 } 1202 else { 1203 $fullname = $new_loc; # $File::Find::fullname 1204 $name = $dir_pref . $FN; # $File::Find::name 1205 $_ = ($no_chdir ? $name : $FN); # $_ 1206 { $wanted_callback->() }; # protect against wild "next" 1207 } 1208 } 1209 1210 } 1211 continue { 1212 while (defined($SE = pop @Stack)) { 1213 ($dir_loc, $updir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE; 1214 if ($Is_MacOS) { 1215 # $p_dir always has a trailing ':', except for the starting dir, 1216 # where $dir_rel eq ':' 1217 $dir_name = "$p_dir$dir_rel"; 1218 $dir_pref = "$dir_name:"; 1219 $loc_pref = ($dir_loc =~ /:$/) ? $dir_loc : "$dir_loc:"; 1220 } 1221 else { 1222 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel"); 1223 $dir_pref = "$dir_name/"; 1224 $loc_pref = "$dir_loc/"; 1225 } 1226 if ( $byd_flag < 0 ) { # must be finddepth, report dirname now 1227 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) { 1228 unless (chdir $updir_loc) { # $updir_loc (parent dir) is always untainted 1229 warnings::warnif "Can't cd to $updir_loc: $!\n"; 1230 next; 1231 } 1232 } 1233 $fullname = $dir_loc; # $File::Find::fullname 1234 $name = $dir_name; # $File::Find::name 1235 if ($Is_MacOS) { 1236 if ($dir_rel eq ':') { # must be the top dir, where we started 1237 $name =~ s|:$||; # $File::Find::name 1238 $p_dir = "$p_dir:" unless ($p_dir =~ /:$/); 1239 } 1240 $dir = $p_dir; # $File::Find::dir 1241 $_ = ($no_chdir ? $name : $dir_rel); # $_ 1242 } 1243 else { 1244 if ( substr($name,-2) eq '/.' ) { 1245 substr($name, length($name) == 2 ? -1 : -2) = ''; # $File::Find::name 1246 } 1247 $dir = $p_dir; # $File::Find::dir 1248 $_ = ($no_chdir ? $dir_name : $dir_rel); # $_ 1249 if ( substr($_,-2) eq '/.' ) { 1250 substr($_, length($_) == 2 ? -1 : -2) = ''; 1251 } 1252 } 1253 1254 lstat($_); # make sure file tests with '_' work 1255 { $wanted_callback->() }; # protect against wild "next" 1256 } 1257 else { 1258 push @Stack,[$dir_loc, $updir_loc, $p_dir, $dir_rel,-1] if $bydepth; 1259 last; 1260 } 1261 } 1262 } 1263 } 1264 1265 1266 sub wrap_wanted { 1267 my $wanted = shift; 1268 if ( ref($wanted) eq 'HASH' ) { 1269 if ( $wanted->{follow} || $wanted->{follow_fast}) { 1270 $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip}; 1271 } 1272 if ( $wanted->{untaint} ) { 1273 $wanted->{untaint_pattern} = $File::Find::untaint_pattern 1274 unless defined $wanted->{untaint_pattern}; 1275 $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip}; 1276 } 1277 return $wanted; 1278 } 1279 else { 1280 return { wanted => $wanted }; 1281 } 1282 } 1283 1284 sub find { 1285 my $wanted = shift; 1286 _find_opt(wrap_wanted($wanted), @_); 1287 } 1288 1289 sub finddepth { 1290 my $wanted = wrap_wanted(shift); 1291 $wanted->{bydepth} = 1; 1292 _find_opt($wanted, @_); 1293 } 1294 1295 # default 1296 $File::Find::skip_pattern = qr/^\.{1,2}\z/; 1297 $File::Find::untaint_pattern = qr|^([-+@\w./]+)$|; 1298 1299 # These are hard-coded for now, but may move to hint files. 1300 if ($^O eq 'VMS') { 1301 $Is_VMS = 1; 1302 $File::Find::dont_use_nlink = 1; 1303 } 1304 elsif ($^O eq 'MacOS') { 1305 $Is_MacOS = 1; 1306 $File::Find::dont_use_nlink = 1; 1307 $File::Find::skip_pattern = qr/^Icon\015\z/; 1308 $File::Find::untaint_pattern = qr|^(.+)$|; 1309 } 1310 1311 # this _should_ work properly on all platforms 1312 # where File::Find can be expected to work 1313 $File::Find::current_dir = File::Spec->curdir || '.'; 1314 1315 $File::Find::dont_use_nlink = 1 1316 if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32' || 1317 $^O eq 'interix' || $^O eq 'cygwin' || $^O eq 'epoc' || $^O eq 'qnx' || 1318 $^O eq 'nto'; 1319 1320 # Set dont_use_nlink in your hint file if your system's stat doesn't 1321 # report the number of links in a directory as an indication 1322 # of the number of files. 1323 # See, e.g. hints/machten.sh for MachTen 2.2. 1324 unless ($File::Find::dont_use_nlink) { 1325 require Config; 1326 $File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'}); 1327 } 1328 1329 # We need a function that checks if a scalar is tainted. Either use the 1330 # Scalar::Util module's tainted() function or our (slower) pure Perl 1331 # fallback is_tainted_pp() 1332 { 1333 local $@; 1334 eval { require Scalar::Util }; 1335 *is_tainted = $@ ? \&is_tainted_pp : \&Scalar::Util::tainted; 1336 } 1337 1338 1;
title
Description
Body
title
Description
Body
title
Description
Body
title
Body
| Generated: Tue Mar 17 22:47:18 2015 | Cross-referenced by PHPXref 0.7.1 |