1#!./perl -T 2 3 4my %Expect_File = (); # what we expect for $_ 5my %Expect_Name = (); # what we expect for $File::Find::name/fullname 6my %Expect_Dir = (); # what we expect for $File::Find::dir 7my ($cwd, $cwd_untainted); 8 9 10BEGIN { 11 chdir 't' if -d 't'; 12 unshift @INC => '../lib'; 13} 14 15use Config; 16 17BEGIN { 18 if ($^O ne 'VMS') { 19 for (keys %ENV) { # untaint ENV 20 ($ENV{$_}) = $ENV{$_} =~ /(.*)/; 21 } 22 } 23 24 # Remove insecure directories from PATH 25 my @path; 26 my $sep = $Config{path_sep}; 27 foreach my $dir (split(/\Q$sep/,$ENV{'PATH'})) 28 { 29 ## 30 ## Match the directory taint tests in mg.c::Perl_magic_setenv() 31 ## 32 push(@path,$dir) unless (length($dir) >= 256 33 or 34 substr($dir,0,1) ne "/" 35 or 36 (stat $dir)[2] & 002); 37 } 38 $ENV{'PATH'} = join($sep,@path); 39} 40 41use Test::More tests => 45; 42 43my $symlink_exists = eval { symlink("",""); 1 }; 44 45use File::Find; 46use File::Spec; 47use Cwd; 48 49cleanup(); 50 51my $found; 52find({wanted => sub { $found = 1 if ($_ eq 'commonsense.t') }, 53 untaint => 1, untaint_pattern => qr|^(.+)$|}, File::Spec->curdir); 54 55ok($found, 'commonsense.t found'); 56$found = 0; 57 58finddepth({wanted => sub { $found = 1 if $_ eq 'commonsense.t'; }, 59 untaint => 1, untaint_pattern => qr|^(.+)$|}, File::Spec->curdir); 60 61ok($found, 'commonsense.t found again'); 62 63my $case = 2; 64my $FastFileTests_OK = 0; 65 66sub cleanup { 67 if (-d dir_path('for_find')) { 68 chdir(dir_path('for_find')); 69 } 70 if (-d dir_path('fa')) { 71 unlink file_path('fa', 'fa_ord'), 72 file_path('fa', 'fsl'), 73 file_path('fa', 'faa', 'faa_ord'), 74 file_path('fa', 'fab', 'fab_ord'), 75 file_path('fa', 'fab', 'faba', 'faba_ord'), 76 file_path('fb', 'fb_ord'), 77 file_path('fb', 'fba', 'fba_ord'); 78 rmdir dir_path('fa', 'faa'); 79 rmdir dir_path('fa', 'fab', 'faba'); 80 rmdir dir_path('fa', 'fab'); 81 rmdir dir_path('fa'); 82 rmdir dir_path('fb', 'fba'); 83 rmdir dir_path('fb'); 84 } 85 chdir File::Spec->updir; 86 if (-d dir_path('for_find')) { 87 rmdir dir_path('for_find') or print "# Can't rmdir for_find: $!\n"; 88 } 89} 90 91END { 92 cleanup(); 93} 94 95sub touch { 96 ok( open(my $T,'>',$_[0]), "Opened $_[0] successfully" ); 97} 98 99sub MkDir($$) { 100 ok( mkdir($_[0],$_[1]), "Created directory $_[0] successfully" ); 101} 102 103sub wanted_File_Dir { 104 print "# \$File::Find::dir => '$File::Find::dir'\n"; 105 print "# \$_ => '$_'\n"; 106 s#\.$## if ($^O eq 'VMS' && $_ ne '.'); 107 ok( $Expect_File{$_}, "Expected and found $File::Find::name" ); 108 if ( $FastFileTests_OK ) { 109 delete $Expect_File{ $_} 110 unless ( $Expect_Dir{$_} && ! -d _ ); 111 } else { 112 delete $Expect_File{$_} 113 unless ( $Expect_Dir{$_} && ! -d $_ ); 114 } 115} 116 117sub wanted_File_Dir_prune { 118 &wanted_File_Dir; 119 $File::Find::prune=1 if $_ eq 'faba'; 120} 121 122sub simple_wanted { 123 print "# \$File::Find::dir => '$File::Find::dir'\n"; 124 print "# \$_ => '$_'\n"; 125} 126 127 128# Use dir_path() to specify a directory path that's expected for 129# $File::Find::dir (%Expect_Dir). Also use it in file operations like 130# chdir, rmdir etc. 131# 132# dir_path() concatenates directory names to form a *relative* 133# directory path, independent from the platform it's run on, although 134# there are limitations. Don't try to create an absolute path, 135# because that may fail on operating systems that have the concept of 136# volume names (e.g. Mac OS). As a special case, you can pass it a "." 137# as first argument, to create a directory path like "./fa/dir" on 138# operating systems other than Mac OS (actually, Mac OS will ignore 139# the ".", if it's the first argument). If there's no second argument, 140# this function will return the empty string on Mac OS and the string 141# "./" otherwise. 142 143sub dir_path { 144 my $first_arg = shift @_; 145 146 if ($first_arg eq '.') { 147 if ($^O eq 'MacOS') { 148 return '' unless @_; 149 # ignore first argument; return a relative path 150 # with leading ":" and with trailing ":" 151 return File::Spec->catdir(@_); 152 } else { # other OS 153 return './' unless @_; 154 my $path = File::Spec->catdir(@_); 155 # add leading "./" 156 $path = "./$path"; 157 return $path; 158 } 159 160 } else { # $first_arg ne '.' 161 return $first_arg unless @_; # return plain filename 162 return File::Spec->catdir($first_arg, @_); # relative path 163 } 164} 165 166 167# Use topdir() to specify a directory path that you want to pass to 168# find/finddepth. Basically, topdir() does the same as dir_path() (see 169# above), except that there's no trailing ":" on Mac OS. 170 171sub topdir { 172 my $path = dir_path(@_); 173 $path =~ s/:$// if ($^O eq 'MacOS'); 174 return $path; 175} 176 177 178# Use file_path() to specify a file path that's expected for $_ 179# (%Expect_File). Also suitable for file operations like unlink etc. 180# 181# file_path() concatenates directory names (if any) and a filename to 182# form a *relative* file path (the last argument is assumed to be a 183# file). It's independent from the platform it's run on, although 184# there are limitations. As a special case, you can pass it a "." as 185# first argument, to create a file path like "./fa/file" on operating 186# systems other than Mac OS (actually, Mac OS will ignore the ".", if 187# it's the first argument). If there's no second argument, this 188# function will return the empty string on Mac OS and the string "./" 189# otherwise. 190 191sub file_path { 192 my $first_arg = shift @_; 193 194 if ($first_arg eq '.') { 195 if ($^O eq 'MacOS') { 196 return '' unless @_; 197 # ignore first argument; return a relative path 198 # with leading ":", but without trailing ":" 199 return File::Spec->catfile(@_); 200 } else { # other OS 201 return './' unless @_; 202 my $path = File::Spec->catfile(@_); 203 # add leading "./" 204 $path = "./$path"; 205 return $path; 206 } 207 208 } else { # $first_arg ne '.' 209 return $first_arg unless @_; # return plain filename 210 return File::Spec->catfile($first_arg, @_); # relative path 211 } 212} 213 214 215# Use file_path_name() to specify a file path that's expected for 216# $File::Find::Name (%Expect_Name). Note: When the no_chdir => 1 217# option is in effect, $_ is the same as $File::Find::Name. In that 218# case, also use this function to specify a file path that's expected 219# for $_. 220# 221# Basically, file_path_name() does the same as file_path() (see 222# above), except that there's always a leading ":" on Mac OS, even for 223# plain file/directory names. 224 225sub file_path_name { 226 my $path = file_path(@_); 227 $path = ":$path" if (($^O eq 'MacOS') && ($path !~ /:/)); 228 return $path; 229} 230 231 232MkDir( dir_path('for_find'), 0770 ); 233ok( chdir( dir_path('for_find')), 'successful chdir() to for_find' ); 234 235$cwd = cwd(); # save cwd 236( $cwd_untainted ) = $cwd =~ m|^(.+)$|; # untaint it 237 238MkDir( dir_path('fa'), 0770 ); 239MkDir( dir_path('fb'), 0770 ); 240touch( file_path('fb', 'fb_ord') ); 241MkDir( dir_path('fb', 'fba'), 0770 ); 242touch( file_path('fb', 'fba', 'fba_ord') ); 243SKIP: { 244 skip "Creating symlink", 1, unless $symlink_exists; 245if ($^O eq 'MacOS') { 246 ok( symlink(':fb',':fa:fsl'), 'Created symbolic link' ); 247} else { 248 ok( symlink('../fb','fa/fsl'), 'Created symbolic link' ); 249} 250} 251touch( file_path('fa', 'fa_ord') ); 252 253MkDir( dir_path('fa', 'faa'), 0770 ); 254touch( file_path('fa', 'faa', 'faa_ord') ); 255MkDir( dir_path('fa', 'fab'), 0770 ); 256touch( file_path('fa', 'fab', 'fab_ord') ); 257MkDir( dir_path('fa', 'fab', 'faba'), 0770 ); 258touch( file_path('fa', 'fab', 'faba', 'faba_ord') ); 259 260print "# check untainting (no follow)\n"; 261 262# untainting here should work correctly 263 264%Expect_File = (File::Spec->curdir => 1, file_path('fsl') => 265 1,file_path('fa_ord') => 1, file_path('fab') => 1, 266 file_path('fab_ord') => 1, file_path('faba') => 1, 267 file_path('faa') => 1, file_path('faa_ord') => 1); 268delete $Expect_File{ file_path('fsl') } unless $symlink_exists; 269%Expect_Name = (); 270 271%Expect_Dir = ( dir_path('fa') => 1, dir_path('faa') => 1, 272 dir_path('fab') => 1, dir_path('faba') => 1, 273 dir_path('fb') => 1, dir_path('fba') => 1); 274 275delete @Expect_Dir{ dir_path('fb'), dir_path('fba') } unless $symlink_exists; 276 277File::Find::find( {wanted => \&wanted_File_Dir_prune, untaint => 1, 278 untaint_pattern => qr|^(.+)$|}, topdir('fa') ); 279 280is(scalar keys %Expect_File, 0, 'Found all expected files'); 281 282 283# don't untaint at all, should die 284%Expect_File = (); 285%Expect_Name = (); 286%Expect_Dir = (); 287undef $@; 288eval {File::Find::find( {wanted => \&simple_wanted}, topdir('fa') );}; 289like( $@, qr|Insecure dependency|, 'Tainted directory causes death (good)' ); 290chdir($cwd_untainted); 291 292 293# untaint pattern doesn't match, should die 294undef $@; 295 296eval {File::Find::find( {wanted => \&simple_wanted, untaint => 1, 297 untaint_pattern => qr|^(NO_MATCH)$|}, 298 topdir('fa') );}; 299 300like( $@, qr|is still tainted|, 'Bad untaint pattern causes death (good)' ); 301chdir($cwd_untainted); 302 303 304# untaint pattern doesn't match, should die when we chdir to cwd 305print "# check untaint_skip (No follow)\n"; 306undef $@; 307 308eval {File::Find::find( {wanted => \&simple_wanted, untaint => 1, 309 untaint_skip => 1, untaint_pattern => 310 qr|^(NO_MATCH)$|}, topdir('fa') );}; 311 312print "# $@" if $@; 313#$^D = 8; 314like( $@, qr|insecure cwd|, 'Bad untaint pattern causes death in cwd (good)' ); 315 316chdir($cwd_untainted); 317 318 319SKIP: { 320 skip "Symbolic link tests", 17, unless $symlink_exists; 321 print "# --- symbolic link tests --- \n"; 322 $FastFileTests_OK= 1; 323 324 print "# check untainting (follow)\n"; 325 326 # untainting here should work correctly 327 # no_chdir is in effect, hence we use file_path_name to specify the expected paths for %Expect_File 328 329 %Expect_File = (file_path_name('fa') => 1, 330 file_path_name('fa','fa_ord') => 1, 331 file_path_name('fa', 'fsl') => 1, 332 file_path_name('fa', 'fsl', 'fb_ord') => 1, 333 file_path_name('fa', 'fsl', 'fba') => 1, 334 file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1, 335 file_path_name('fa', 'fab') => 1, 336 file_path_name('fa', 'fab', 'fab_ord') => 1, 337 file_path_name('fa', 'fab', 'faba') => 1, 338 file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1, 339 file_path_name('fa', 'faa') => 1, 340 file_path_name('fa', 'faa', 'faa_ord') => 1); 341 342 %Expect_Name = (); 343 344 %Expect_Dir = (dir_path('fa') => 1, 345 dir_path('fa', 'faa') => 1, 346 dir_path('fa', 'fab') => 1, 347 dir_path('fa', 'fab', 'faba') => 1, 348 dir_path('fb') => 1, 349 dir_path('fb', 'fba') => 1); 350 351 File::Find::find( {wanted => \&wanted_File_Dir, follow_fast => 1, 352 no_chdir => 1, untaint => 1, untaint_pattern => 353 qr|^(.+)$| }, topdir('fa') ); 354 355 is( scalar(keys %Expect_File), 0, 'Found all files in symlink test' ); 356 357 358 # don't untaint at all, should die 359 undef $@; 360 361 eval {File::Find::find( {wanted => \&simple_wanted, follow => 1}, 362 topdir('fa') );}; 363 364 like( $@, qr|Insecure dependency|, 'Not untainting causes death (good)' ); 365 chdir($cwd_untainted); 366 367 # untaint pattern doesn't match, should die 368 undef $@; 369 370 eval {File::Find::find( {wanted => \&simple_wanted, follow => 1, 371 untaint => 1, untaint_pattern => 372 qr|^(NO_MATCH)$|}, topdir('fa') );}; 373 374 like( $@, qr|is still tainted|, 'Bat untaint pattern causes death (good)' ); 375 chdir($cwd_untainted); 376 377 # untaint pattern doesn't match, should die when we chdir to cwd 378 print "# check untaint_skip (Follow)\n"; 379 undef $@; 380 381 eval {File::Find::find( {wanted => \&simple_wanted, untaint => 1, 382 untaint_skip => 1, untaint_pattern => 383 qr|^(NO_MATCH)$|}, topdir('fa') );}; 384 like( $@, qr|insecure cwd|, 'Cwd not untainted with bad pattern (good)' ); 385 386 chdir($cwd_untainted); 387} 388