1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
|
#!/usr/bin/perl -T
use strict;
use Test::More tests => 74;
use Taint::Util;
# untainted
my $s = 420;
ok !tainted($s) => "fresh scalar untainted";
# taint
taint($s); ok tainted($s) => "tainted my scalar";
# untaint
untaint($s); ok !tainted($s) => "untainted my scalar";
# taint again
taint($s); ok tainted($s) => "tainted my scalar again";
# taint/untaint never return true
ok !untaint($s) => "return value of untaint";
ok !taint($s) => "return value of taint";
ok !untaint($s) => "return value of untaint";
#
# Constant tainting
#
ok !tainted("goood") => "constant not tainted";
{
local $@;
eval { taint("bewbs") };
my $err = $@; chomp $err; # Don't put \n in TAP output
ok(!$@, "We don't attempt to taint constants");
}
#
# Multiple arguments
#
my ($a, $b, $c) = qw(a b c);
ok !tainted($a) => "fresh scalar \$a untainted";
ok !tainted($b) => "fresh scalar \$b untainted";
ok !tainted($c) => "fresh scalar \$c untainted";
taint($a, $b, $c);
ok tainted($a) => "scalar \$a tainted";
ok tainted($b) => "scalar \$b tainted";
ok tainted($c) => "scalar \$c tainted";
untaint($a, $b, $c);
ok !tainted($a) => "scalar \$a untainted";
ok !tainted($b) => "scalar \$a untainted";
ok !tainted($c) => "scalar \$a untainted";
#
# Taint/untaint array elements
#
my @elem = ($a, $b, $c);
ok !tainted($_) => "array elem untainted" for @elem;
taint(@elem);
ok tainted($_) => "array elem tainted" for @elem;
untaint(@elem);
ok !tainted($_) => "array elem tainted" for @elem;
#
# Hash keys can't be tainted
#
my %hv = qw(a b c d);
taint(%hv);
ok tainted($_) => "Hash value $_ tainted" for values %hv;
ok !tainted($_) => "Hash key $_ untainted" for keys %hv;
#
# Tainting references
#
my $sv = 420;
my $sr = \$sv;
my $ar = [ qw(a o e u) ];
my $hr = { qw(a o e u) };
my $cr = sub { "tainted?" };
my $gr = \*STDIN;
my $ov = bless [ qw(tainted magic) ] => "Mushrooms";
ok !tainted($_) => "$_ untainted" for ($sv, $sr, $ar, $hr);
taint($sv, $sr, $ar, $hr);
ok tainted($_) => "$_ tainted" for ($sv, $sr, $ar, $hr);
untaint($sv, $sr, $ar, $hr);
ok !tainted($_) => "$_ untainted" for ($sv, $sr, $ar, $hr);
# SCALAR
taint($sr);
ok tainted($sr) => "SCALAR tainted...";
ok !tainted($sv) => "...but not its value";
ok !tainted($$sr) => "...but not its value";
untaint($sr);
ok !tainted($sr) => "SCALAR untainted";
# ARRAY - Taint its elements but not it
taint(@$ar[0..3]);
ok !tainted($ar) => "ARRAY untainted";
ok tainted($_) => "ARRAY element $_ tainted" for @$ar;
untaint(@$ar[0..3]);
ok !tainted($_) => "ARRAY element $_ untainted" for @$ar;
# CODE
ok !tainted($cr) => "CODE untainted";
taint($cr);
ok tainted($cr) => "CODE tainted";
ok tainted("$cr") => '"CODE" tainted';
ok !tainted($cr->()) => 'CODE->() untainted';
# GLOB
ok !tainted(*$gr) => "*STDIN untainted";
taint(*STDIN);
ok tainted(*$gr) => "*STDIN tainted";
# Blessed objects
ok !tainted($ov) => "object untainted";
taint($ov);
ok tainted($ov) => "object tainted";
#
# Tainted file handles, a tainted handle does not taint its lines
#
ok !tainted(*DATA) => "*DATA untainted";
taint(*DATA);
ok tainted(*DATA) => "*DATA tainted";
while (<DATA>) {
chomp;
like $_, qr/^ba[xyz]$/ => "DATA line $_";
ok !tainted($_) => "DATA line $_ untainted";
}
#
# qr// returns a blessed object which is tainted
#
taint(my $str = "bewbs");
ok tainted($str) => "New scalar tainted";
if ($] < 5.008) {
SKIP: {
skip "qr// tainted is known to fail on 5.6.2 and below" => 1;
}
} else {
my $re = qr/$str/;
ok tainted($re) => "qr// tainted";
}
__DATA__
bax
bay
baz
|
