1#!./perl -t 2 3BEGIN { 4 chdir 't' if -d 't'; 5 @INC = '../lib'; 6 require './test.pl'; 7} 8 9use Config; 10 11if (exists($Config{taint_support}) && !$Config{taint_support}) { 12 skip_all("perl built without taint support"); 13} 14 15plan tests => 13; 16 17my $Perl = which_perl(); 18 19my $warning; 20local $SIG{__WARN__} = sub { $warning = join "\n", @_; }; 21my $Tmsg = 'while running with -t switch'; 22 23is( ${^TAINT}, -1, '${^TAINT} == -1' ); 24 25my $out = `$Perl -le "print q(Hello)"`; 26is( $out, "Hello\n", '`` worked' ); 27like( $warning, qr/^Insecure .* $Tmsg/, ' taint warn' ); 28 29{ 30 no warnings 'taint'; 31 $warning = ''; 32 my $out = `$Perl -le "print q(Hello)"`; 33 is( $out, "Hello\n", '`` worked' ); 34 is( $warning, '', ' no warnings "taint"' ); 35} 36 37# Get ourselves a tainted variable. 38my $filename = tempfile(); 39$file = $0; 40$file =~ s/.*/$filename/; 41ok( open(FILE, ">$file"), 'open >' ) or DIE $!; 42print FILE "Stuff\n"; 43close FILE; 44like( $warning, qr/^Insecure dependency in open $Tmsg/, 'open > taint warn' ); 45ok( -e $file, ' file written' ); 46 47unlink($file); 48like( $warning, qr/^Insecure dependency in unlink $Tmsg/, 49 'unlink() taint warn' ); 50ok( !-e $file, 'unlink worked' ); 51 52ok( !$^W, "-t doesn't enable regular warnings" ); 53 54 55mkdir('ttdir'); 56open(FH,'>','ttdir/ttest.pl')or DIE $!; 57print FH 'return 42'; 58close FH or DIE $!; 59 60SKIP: { 61 ($^O eq 'MSWin32') || skip('skip tainted do test with \ separator'); 62 my $test = 0; 63 $test = do '.\ttdir/ttest.pl'; 64 is($test, 42, 'Could "do" .\ttdir/ttest.pl'); 65} 66{ 67 my $test = 0; 68 $test = do './ttdir/ttest.pl'; 69 is($test, 42, 'Could "do" ./ttdir/ttest.pl'); 70} 71unlink ('./ttdir/ttest.pl'); 72rmdir ('ttdir'); 73