1#!./perl -T 2 3use Config; 4 5BEGIN { 6 if ($ENV{PERL_CORE} 7 and $Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS' 8 or not ${^TAINT}) # not ${^TAINT} => perl without taint support 9 { 10 print "1..0\n"; 11 exit 0; 12 } 13} 14 15use strict; 16if ($ENV{PERL_CORE}) { 17 require("../../t/test.pl"); 18} 19else { 20 require("./t/test.pl"); 21} 22plan(tests => 5); 23 24END { unlink "./__taint__$$" } 25 26use IO::File; 27my $x = new IO::File "> ./__taint__$$" || die("Cannot open ./__taint__$$\n"); 28print $x "$$\n"; 29$x->close; 30 31$x = new IO::File "< ./__taint__$$" || die("Cannot open ./__taint__$$\n"); 32chop(my $unsafe = <$x>); 33eval { kill 0 * $unsafe }; 34SKIP: { 35 skip($^O) if $^O eq 'MSWin32' or $^O eq 'NetWare'; 36 like($@, '^Insecure'); 37} 38$x->close; 39 40# We could have just done a seek on $x, but technically we haven't tested 41# seek yet... 42$x = new IO::File "< ./__taint__$$" || die("Cannot open ./__taint__$$\n"); 43$x->untaint; 44ok(!$?); # Calling the method worked 45chop($unsafe = <$x>); 46eval { kill 0 * $unsafe }; 47unlike($@,'^Insecure'); 48$x->close; 49 50TODO: { 51 todo_skip("Known bug in 5.10.0",2) if $] >= 5.010 and $] < 5.010_001; 52 53 # this will segfault if it fails 54 55 sub PVBM () { 'foo' } 56 { my $dummy = index 'foo', PVBM } 57 58 eval { IO::Handle::untaint(PVBM) }; 59 pass(); 60 61 eval { IO::Handle::untaint(\PVBM) }; 62 pass(); 63} 64 65exit 0; 66