This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fcc52c2d29ddbb0b94ce25836bfa57737da0ad3f
[perl5.git] / ext / POSIX / t / taint.t
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
13 use Test::More tests => 7;
14 use Scalar::Util qw/tainted/;
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
31 eval { mkfifo($TAINT. "TEST", 0) };
32 like($@, qr/^Insecure dependency/,              'mkfifo with tainted data');
33
34 eval { $testfd = open($TAINT. "TEST", O_WRONLY, 0) };
35 like($@, qr/^Insecure dependency/,              'open with tainted data');
36
37 eval { $testfd = open("TEST", O_RDONLY, 0) };
38 is($@, "",                                  'open with untainted data');
39
40 read($testfd, $buffer, 2) if $testfd > 2;
41 is( $buffer, "#!",                                '    read' );
42 ok(tainted($buffer),                          '    scalar tainted');
43
44 TODO: {
45     local $TODO = "POSIX::read won't taint an array element";
46
47     read($testfd, $buffer[1], 2) if $testfd > 2;
48
49     is( $buffer[1], "./",                             '    read' );
50     ok(tainted($buffer[1]),                       '    array element tainted');
51 }