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 = IO::File->new( "> ./__taint__$$" ) || die("Cannot open ./__taint__$$\n");
28print $x "$$\n";
29$x->close;
30
31$x = IO::File->new( "< ./__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($@, qr/^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 = IO::File->new( "< ./__taint__$$" ) || die("Cannot open ./__taint__$$\n");
43$x->untaint;
44ok(!$?); # Calling the method worked
45chop($unsafe = <$x>);
46eval { kill 0 * $unsafe };
47unlike($@,qr/^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