1#!./perl -T 2 3use strict; 4use lib qw( ./t/lib ); 5 6BEGIN { 7 require File::Spec; 8 if ($ENV{PERL_CORE}) { 9 # May be doing dynamic loading while @INC is all relative 10 @INC = map { $_ = File::Spec->rel2abs($_); /(.*)/; $1 } @INC; 11 } 12 if ($^O eq 'MSWin32' || $^O eq 'cygwin' || $^O eq 'VMS') { 13 # This is a hack - at present File::Find does not produce native names 14 # on Win32 or VMS, so force File::Spec to use Unix names. 15 # must be set *before* importing File::Find 16 require File::Spec::Unix; 17 @File::Spec::ISA = 'File::Spec::Unix'; 18 } 19} 20 21use Test::More; 22use File::Find; 23use File::Spec; 24use Cwd; 25use Testing qw( 26 create_file_ok 27 mkdir_ok 28 symlink_ok 29 dir_path 30 file_path 31 _cleanup_start 32); 33use Errno (); 34use Config; 35use File::Temp qw(tempdir); 36 37BEGIN { 38 plan( 39 ${^TAINT} 40 ? (tests => 48) 41 : (skip_all => "A perl without taint support") 42 ); 43} 44 45my %Expect_File = (); # what we expect for $_ 46my %Expect_Name = (); # what we expect for $File::Find::name/fullname 47my %Expect_Dir = (); # what we expect for $File::Find::dir 48my ($cwd, $cwd_untainted); 49 50BEGIN { 51 if ($^O ne 'VMS') { 52 for (keys %ENV) { # untaint ENV 53 ($ENV{$_}) = $ENV{$_} =~ /(.*)/; 54 } 55 } 56 57 # Remove insecure directories from PATH 58 my @path; 59 my $sep = $Config{path_sep}; 60 foreach my $dir (split(/\Q$sep/,$ENV{'PATH'})) 61 { 62 ## 63 ## Match the directory taint tests in mg.c::Perl_magic_setenv() 64 ## 65 push(@path,$dir) unless (length($dir) >= 256 66 or 67 substr($dir,0,1) ne "/" 68 or 69 (stat $dir)[2] & 002); 70 } 71 $ENV{'PATH'} = join($sep,@path); 72} 73 74my $symlink_exists = eval { symlink("",""); 1 }; 75 76my $test_root_dir; # where we are when this test starts 77my $test_root_dir_tainted = cwd(); 78if ($test_root_dir_tainted =~ /^(.*)$/) { 79 $test_root_dir = $1; 80} else { 81 die "Failed to untaint root dir of test"; 82} 83ok($test_root_dir,"test_root_dir is set up as expected"); 84my $test_temp_dir = tempdir("FF_taint_t_XXXXXX",CLEANUP=>1); 85ok($test_temp_dir,"test_temp_dir is set up as expected"); 86 87my $found; 88find({wanted => sub { ++$found if $_ eq 'taint.t' }, 89 untaint => 1, untaint_pattern => qr|^(.+)$|}, File::Spec->curdir); 90 91is($found, 1, 'taint.t found once'); 92$found = 0; 93 94finddepth({wanted => sub { ++$found if $_ eq 'taint.t'; }, 95 untaint => 1, untaint_pattern => qr|^(.+)$|}, File::Spec->curdir); 96 97is($found, 1, 'taint.t found once again'); 98 99my $case = 2; 100my $FastFileTests_OK = 0; 101 102my $chdir_error = ""; 103chdir($test_temp_dir) 104 or $chdir_error = "Failed to chdir to '$test_temp_dir': $!"; 105is($chdir_error,"","chdir to temp dir '$test_temp_dir' successful") 106 or die $chdir_error; 107 108sub cleanup { 109 # the following chdirs into $test_root_dir/$test_temp_dir but 110 # handles various possible edge case errors cleanly. If it returns 111 # false then we bail out of the cleanup. 112 _cleanup_start($test_root_dir, $test_temp_dir) 113 or return; 114 115 my $need_updir = 0; 116 if (-d dir_path('for_find_taint')) { 117 $need_updir = 1 if chdir(dir_path('for_find_taint')); 118 } 119 if (-d dir_path('fa_taint')) { 120 unlink file_path('fa_taint', 'fa_ord'), 121 file_path('fa_taint', 'fsl'), 122 file_path('fa_taint', 'faa', 'faa_ord'), 123 file_path('fa_taint', 'fab', 'fab_ord'), 124 file_path('fa_taint', 'fab', 'faba', 'faba_ord'), 125 file_path('fb_taint', 'fb_ord'), 126 file_path('fb_taint', 'fba', 'fba_ord'); 127 rmdir dir_path('fa_taint', 'faa'); 128 rmdir dir_path('fa_taint', 'fab', 'faba'); 129 rmdir dir_path('fa_taint', 'fab'); 130 rmdir dir_path('fa_taint'); 131 rmdir dir_path('fb_taint', 'fba'); 132 rmdir dir_path('fb_taint'); 133 } 134 if ($need_updir) { 135 my $updir = $^O eq 'VMS' ? File::Spec::VMS->updir() : File::Spec->updir; 136 chdir($updir); 137 } 138 if (-d dir_path('for_find_taint')) { 139 rmdir dir_path('for_find_taint') or print "# Can't rmdir for_find_taint: $!\n"; 140 } 141 chdir($test_root_dir) or die "Failed to chdir to '$test_root_dir': $!"; 142} 143 144END { 145 cleanup(); 146} 147 148sub wanted_File_Dir { 149 print "# \$File::Find::dir => '$File::Find::dir'\t\$_ => '$_'\n"; 150 s#\.$## if ($^O eq 'VMS' && $_ ne '.'); # 151 s/(.dir)?$//i if ($^O eq 'VMS' && -d _); 152 ok( $Expect_File{$_}, "found $_ for \$_, as expected" ); 153 if ( $FastFileTests_OK ) { 154 delete $Expect_File{$_} 155 unless ( $Expect_Dir{$_} && ! -d _ ); 156 } 157 else { 158 delete $Expect_File{$_} 159 unless ( $Expect_Dir{$_} && ! -d $_ ); 160 } 161} 162 163sub wanted_File_Dir_prune { 164 &wanted_File_Dir; 165 $File::Find::prune=1 if $_ eq 'faba'; 166} 167 168sub simple_wanted { 169 print "# \$File::Find::dir => '$File::Find::dir'\n"; 170 print "# \$_ => '$_'\n"; 171} 172 173# Use topdir() to specify a directory path that you want to pass to 174# find/finddepth. Historically topdir() differed on Mac OS classic. 175 176*topdir = \&dir_path; 177 178# Use file_path_name() to specify a file path that's expected for 179# $File::Find::Name (%Expect_Name). Note: When the no_chdir => 1 180# option is in effect, $_ is the same as $File::Find::Name. In that 181# case, also use this function to specify a file path that's expected 182# for $_. 183# 184# Historically file_path_name differed on Mac OS classic. 185 186*file_path_name = \&file_path; 187 188##### Create directories, files and symlinks used in testing ##### 189mkdir_ok( dir_path('for_find_taint'), 0770 ); 190ok( chdir( dir_path('for_find_taint')), 'successful chdir() to for_find_taint' ); 191 192$cwd = cwd(); # save cwd 193( $cwd_untainted ) = $cwd =~ m|^(.+)$|; # untaint it 194 195mkdir_ok( dir_path('fa_taint'), 0770 ); 196mkdir_ok( dir_path('fb_taint'), 0770 ); 197create_file_ok( file_path('fb_taint', 'fb_ord') ); 198mkdir_ok( dir_path('fb_taint', 'fba'), 0770 ); 199create_file_ok( file_path('fb_taint', 'fba', 'fba_ord') ); 200SKIP: { 201 skip "Creating symlink", 1, unless $symlink_exists; 202 if (symlink('../fb_taint','fa_taint/fsl')) { 203 pass('Created symbolic link' ); 204 } 205 else { 206 my $error = 0 + $!; 207 if ($^O eq "MSWin32" && 208 ($error == &Errno::ENOSYS || $error == &Errno::EPERM)) { 209 $symlink_exists = 0; 210 skip "symbolic links not available", 1; 211 } 212 else { 213 fail('Created symbolic link'); 214 } 215 } 216} 217create_file_ok( file_path('fa_taint', 'fa_ord') ); 218 219mkdir_ok( dir_path('fa_taint', 'faa'), 0770 ); 220create_file_ok( file_path('fa_taint', 'faa', 'faa_ord') ); 221mkdir_ok( dir_path('fa_taint', 'fab'), 0770 ); 222create_file_ok( file_path('fa_taint', 'fab', 'fab_ord') ); 223mkdir_ok( dir_path('fa_taint', 'fab', 'faba'), 0770 ); 224create_file_ok( file_path('fa_taint', 'fab', 'faba', 'faba_ord') ); 225 226print "# check untainting (no follow)\n"; 227 228# untainting here should work correctly 229 230%Expect_File = (File::Spec->curdir => 1, file_path('fsl') => 231 1,file_path('fa_ord') => 1, file_path('fab') => 1, 232 file_path('fab_ord') => 1, file_path('faba') => 1, 233 file_path('faa') => 1, file_path('faa_ord') => 1); 234delete $Expect_File{ file_path('fsl') } unless $symlink_exists; 235%Expect_Name = (); 236 237%Expect_Dir = ( dir_path('fa_taint') => 1, dir_path('faa') => 1, 238 dir_path('fab') => 1, dir_path('faba') => 1, 239 dir_path('fb_taint') => 1, dir_path('fba') => 1); 240 241delete @Expect_Dir{ dir_path('fb_taint'), dir_path('fba') } unless $symlink_exists; 242 243File::Find::find( {wanted => \&wanted_File_Dir_prune, untaint => 1, 244 untaint_pattern => qr|^(.+)$|}, topdir('fa_taint') ); 245 246is(scalar keys %Expect_File, 0, 'Found all expected files') 247 or diag "Not found " . join(" ", sort keys %Expect_File); 248 249# don't untaint at all, should die 250%Expect_File = (); 251%Expect_Name = (); 252%Expect_Dir = (); 253undef $@; 254eval {File::Find::find( {wanted => \&simple_wanted}, topdir('fa_taint') );}; 255like( $@, qr|Insecure dependency|, 'Tainted directory causes death (good)' ); 256chdir($cwd_untainted); 257 258 259# untaint pattern doesn't match, should die 260undef $@; 261 262eval {File::Find::find( {wanted => \&simple_wanted, untaint => 1, 263 untaint_pattern => qr|^(NO_MATCH)$|}, 264 topdir('fa_taint') );}; 265 266like( $@, qr|is still tainted|, 'Bad untaint pattern causes death (good)' ); 267chdir($cwd_untainted); 268 269 270# untaint pattern doesn't match, should die when we chdir to cwd 271print "# check untaint_skip (No follow)\n"; 272undef $@; 273 274eval {File::Find::find( {wanted => \&simple_wanted, untaint => 1, 275 untaint_skip => 1, untaint_pattern => 276 qr|^(NO_MATCH)$|}, topdir('fa_taint') );}; 277 278print "# $@" if $@; 279#$^D = 8; 280like( $@, qr|insecure cwd|, 'Bad untaint pattern causes death in cwd (good)' ); 281 282chdir($cwd_untainted); 283 284 285SKIP: { 286 skip "Symbolic link tests", 17, unless $symlink_exists; 287 print "# --- symbolic link tests --- \n"; 288 $FastFileTests_OK= 1; 289 290 print "# check untainting (follow)\n"; 291 292 # untainting here should work correctly 293 # no_chdir is in effect, hence we use file_path_name to specify the expected paths for %Expect_File 294 295 %Expect_File = (file_path_name('fa_taint') => 1, 296 file_path_name('fa_taint','fa_ord') => 1, 297 file_path_name('fa_taint', 'fsl') => 1, 298 file_path_name('fa_taint', 'fsl', 'fb_ord') => 1, 299 file_path_name('fa_taint', 'fsl', 'fba') => 1, 300 file_path_name('fa_taint', 'fsl', 'fba', 'fba_ord') => 1, 301 file_path_name('fa_taint', 'fab') => 1, 302 file_path_name('fa_taint', 'fab', 'fab_ord') => 1, 303 file_path_name('fa_taint', 'fab', 'faba') => 1, 304 file_path_name('fa_taint', 'fab', 'faba', 'faba_ord') => 1, 305 file_path_name('fa_taint', 'faa') => 1, 306 file_path_name('fa_taint', 'faa', 'faa_ord') => 1); 307 308 %Expect_Name = (); 309 310 %Expect_Dir = (dir_path('fa_taint') => 1, 311 dir_path('fa_taint', 'faa') => 1, 312 dir_path('fa_taint', 'fab') => 1, 313 dir_path('fa_taint', 'fab', 'faba') => 1, 314 dir_path('fb_taint') => 1, 315 dir_path('fb_taint', 'fba') => 1); 316 317 File::Find::find( {wanted => \&wanted_File_Dir, follow_fast => 1, 318 no_chdir => 1, untaint => 1, untaint_pattern => 319 qr|^(.+)$| }, topdir('fa_taint') ); 320 321 is( scalar(keys %Expect_File), 0, 'Found all files in symlink test' ); 322 323 324 # don't untaint at all, should die 325 undef $@; 326 327 eval {File::Find::find( {wanted => \&simple_wanted, follow => 1}, 328 topdir('fa_taint') );}; 329 330 like( $@, qr|Insecure dependency|, 'Not untainting causes death (good)' ); 331 chdir($cwd_untainted); 332 333 # untaint pattern doesn't match, should die 334 undef $@; 335 336 eval {File::Find::find( {wanted => \&simple_wanted, follow => 1, 337 untaint => 1, untaint_pattern => 338 qr|^(NO_MATCH)$|}, topdir('fa_taint') );}; 339 340 like( $@, qr|is still tainted|, 'Bat untaint pattern causes death (good)' ); 341 chdir($cwd_untainted); 342 343 # untaint pattern doesn't match, should die when we chdir to cwd 344 print "# check untaint_skip (Follow)\n"; 345 undef $@; 346 347 eval {File::Find::find( {wanted => \&simple_wanted, untaint => 1, 348 untaint_skip => 1, untaint_pattern => 349 qr|^(NO_MATCH)$|}, topdir('fa_taint') );}; 350 like( $@, qr|insecure cwd|, 'Cwd not untainted with bad pattern (good)' ); 351 352 chdir($cwd_untainted); 353} 354