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