Commit | Line | Data |
0e247040 |
1 | #!./perl -Tw |
2 | |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
5 | @INC = '../lib'; |
6 | require Config; import Config; |
7 | if ($^O ne 'VMS' and $Config{'extensions'} !~ /\bPOSIX\b/) { |
8 | print "1..0\n"; |
9 | exit 0; |
10 | } |
11 | } |
12 | |
64087619 |
13 | use Test::More tests => 7; |
0e247040 |
14 | use Scalar::Util qw/tainted/; |
0e247040 |
15 | |
16 | |
17 | use POSIX qw(fcntl_h open read mkfifo); |
18 | use strict ; |
19 | |
20 | $| = 1; |
21 | |
22 | my $buffer; |
23 | my @buffer; |
24 | my $testfd; |
25 | |
26 | # Sources of taint: |
27 | # The empty tainted value, for tainting strings |
28 | |
29 | my $TAINT = substr($^X, 0, 0); |
30 | |
943b127a |
31 | # there is a bug in GUSI that causes problems trying to open |
32 | # files and directories ... it is being fixed, this is just |
33 | # a stopgap -- pudge |
34 | my $file = $^O eq 'MacOS' ? 'TEST-OLD' : 'TEST'; |
35 | |
36 | eval { mkfifo($TAINT. $file, 0) }; |
64087619 |
37 | like($@, qr/^Insecure dependency/, 'mkfifo with tainted data'); |
0e247040 |
38 | |
943b127a |
39 | eval { $testfd = open($TAINT. $file, O_WRONLY, 0) }; |
64087619 |
40 | like($@, qr/^Insecure dependency/, 'open with tainted data'); |
0e247040 |
41 | |
943b127a |
42 | eval { $testfd = open($file, O_RDONLY, 0) }; |
64087619 |
43 | is($@, "", 'open with untainted data'); |
0e247040 |
44 | |
45 | read($testfd, $buffer, 2) if $testfd > 2; |
46 | is( $buffer, "#!", ' read' ); |
47 | ok(tainted($buffer), ' scalar tainted'); |
0e247040 |
48 | |
64087619 |
49 | TODO: { |
50 | local $TODO = "POSIX::read won't taint an array element"; |
51 | |
52 | read($testfd, $buffer[1], 2) if $testfd > 2; |
53 | |
54 | is( $buffer[1], "./", ' read' ); |
55 | ok(tainted($buffer[1]), ' array element tainted'); |
56 | } |