line |
stmt |
bran |
cond |
sub |
time |
code |
1
|
|
|
|
|
|
/* taint.c |
2
|
|
|
|
|
|
* |
3
|
|
|
|
|
|
* Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, |
4
|
|
|
|
|
|
* 2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others |
5
|
|
|
|
|
|
* |
6
|
|
|
|
|
|
* You may distribute under the terms of either the GNU General Public |
7
|
|
|
|
|
|
* License or the Artistic License, as specified in the README file. |
8
|
|
|
|
|
|
* |
9
|
|
|
|
|
|
*/ |
10
|
|
|
|
|
|
|
11
|
|
|
|
|
|
/* |
12
|
|
|
|
|
|
* '...we will have peace, when you and all your works have perished--and |
13
|
|
|
|
|
|
* the works of your dark master to whom you would deliver us. You are a |
14
|
|
|
|
|
|
* liar, Saruman, and a corrupter of men's hearts.' --Théoden |
15
|
|
|
|
|
|
* |
16
|
|
|
|
|
|
* [p.580 of _The Lord of the Rings_, III/x: "The Voice of Saruman"] |
17
|
|
|
|
|
|
*/ |
18
|
|
|
|
|
|
|
19
|
|
|
|
|
|
/* This file contains a few functions for handling data tainting in Perl |
20
|
|
|
|
|
|
*/ |
21
|
|
|
|
|
|
|
22
|
|
|
|
|
|
#include "EXTERN.h" |
23
|
|
|
|
|
|
#define PERL_IN_TAINT_C |
24
|
|
|
|
|
|
#include "perl.h" |
25
|
|
|
|
|
|
|
26
|
|
|
|
|
|
void |
27
|
81340
|
|
|
|
|
Perl_taint_proper(pTHX_ const char *f, const char *const s) |
28
|
|
|
|
|
|
{ |
29
|
|
|
|
|
|
#if defined(HAS_SETEUID) && defined(DEBUGGING) |
30
|
|
|
|
|
|
dVAR; |
31
|
|
|
|
|
|
|
32
|
|
|
|
|
|
PERL_ARGS_ASSERT_TAINT_PROPER; |
33
|
|
|
|
|
|
|
34
|
|
|
|
|
|
{ |
35
|
|
|
|
|
|
const Uid_t uid = PerlProc_getuid(); |
36
|
|
|
|
|
|
const Uid_t euid = PerlProc_geteuid(); |
37
|
|
|
|
|
|
|
38
|
|
|
|
|
|
DEBUG_u(PerlIO_printf(Perl_debug_log, |
39
|
|
|
|
|
|
"%s %d %"Uid_t_f" %"Uid_t_f"\n", |
40
|
|
|
|
|
|
s, TAINT_get, uid, euid)); |
41
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
#endif |
43
|
|
|
|
|
|
|
44
|
81340
|
100
|
|
|
|
if (TAINT_get) { |
45
|
|
|
|
|
|
const char *ug; |
46
|
|
|
|
|
|
|
47
|
288
|
100
|
|
|
|
if (!f) |
48
|
|
|
|
|
|
f = PL_no_security; |
49
|
288
|
50
|
|
|
|
if (PerlProc_getuid() != PerlProc_geteuid()) |
50
|
|
|
|
|
|
ug = " while running setuid"; |
51
|
288
|
50
|
|
|
|
else if (PerlProc_getgid() != PerlProc_getegid()) |
52
|
|
|
|
|
|
ug = " while running setgid"; |
53
|
288
|
100
|
|
|
|
else if (TAINT_WARN_get) |
54
|
|
|
|
|
|
ug = " while running with -t switch"; |
55
|
|
|
|
|
|
else |
56
|
|
|
|
|
|
ug = " while running with -T switch"; |
57
|
288
|
100
|
|
|
|
if (PL_unsafe || TAINT_WARN_get) { |
|
|
100
|
|
|
|
|
58
|
16
|
|
|
|
|
Perl_ck_warner_d(aTHX_ packWARN(WARN_TAINT), f, s, ug); |
59
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
else { |
61
|
272
|
|
|
|
|
Perl_croak(aTHX_ f, s, ug); |
62
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
} |
64
|
81068
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
66
|
|
|
|
|
|
void |
67
|
2
|
|
|
|
|
Perl_taint_env(pTHX) |
68
|
|
|
|
|
|
{ |
69
|
|
|
|
|
|
dVAR; |
70
|
|
|
|
|
|
SV** svp; |
71
|
|
|
|
|
|
MAGIC* mg; |
72
|
|
|
|
|
|
const char* const *e; |
73
|
|
|
|
|
|
static const char* const misc_env[] = { |
74
|
|
|
|
|
|
"IFS", /* most shells' inter-field separators */ |
75
|
|
|
|
|
|
"CDPATH", /* ksh dain bramage #1 */ |
76
|
|
|
|
|
|
"ENV", /* ksh dain bramage #2 */ |
77
|
|
|
|
|
|
"BASH_ENV", /* bash dain bramage -- I guess it's contagious */ |
78
|
|
|
|
|
|
#ifdef WIN32 |
79
|
|
|
|
|
|
"PERL5SHELL", /* used for system() on Windows */ |
80
|
|
|
|
|
|
#endif |
81
|
|
|
|
|
|
NULL |
82
|
|
|
|
|
|
}; |
83
|
|
|
|
|
|
|
84
|
|
|
|
|
|
/* Don't bother if there's no *ENV glob */ |
85
|
2
|
50
|
|
|
|
if (!PL_envgv) |
86
|
2
|
|
|
|
|
return; |
87
|
|
|
|
|
|
/* If there's no %ENV hash or if it's not magical, croak, because |
88
|
|
|
|
|
|
* it probably doesn't reflect the actual environment */ |
89
|
4
|
50
|
|
|
|
if (!GvHV(PL_envgv) || !(SvRMAGICAL(GvHV(PL_envgv)) |
90
|
2
|
|
|
|
|
&& mg_find((const SV *)GvHV(PL_envgv), PERL_MAGIC_env))) { |
91
|
0
|
|
|
|
|
const bool was_tainted = TAINT_get; |
92
|
0
|
0
|
|
|
|
const char * const name = GvENAME(PL_envgv); |
93
|
0
|
|
|
|
|
TAINT; |
94
|
0
|
0
|
|
|
|
if (strEQ(name,"ENV")) |
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
95
|
|
|
|
|
|
/* hash alias */ |
96
|
0
|
|
|
|
|
taint_proper("%%ENV is aliased to %s%s", "another variable"); |
97
|
|
|
|
|
|
else |
98
|
|
|
|
|
|
/* glob alias: report it in the error message */ |
99
|
0
|
|
|
|
|
taint_proper("%%ENV is aliased to %%%s%s", name); |
100
|
|
|
|
|
|
/* this statement is reached under -t or -U */ |
101
|
0
|
|
|
|
|
TAINT_set(was_tainted); |
102
|
|
|
|
|
|
#ifdef NO_TAINT_SUPPORT |
103
|
|
|
|
|
|
PERL_UNUSED_VAR(was_tainted); |
104
|
|
|
|
|
|
#endif |
105
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
107
|
|
|
|
|
|
#ifdef VMS |
108
|
|
|
|
|
|
{ |
109
|
|
|
|
|
|
int i = 0; |
110
|
|
|
|
|
|
char name[10 + TYPE_DIGITS(int)] = "DCL$PATH"; |
111
|
|
|
|
|
|
STRLEN len = 8; /* strlen(name) */ |
112
|
|
|
|
|
|
|
113
|
|
|
|
|
|
while (1) { |
114
|
|
|
|
|
|
if (i) |
115
|
|
|
|
|
|
len = my_sprintf(name,"DCL$PATH;%d", i); |
116
|
|
|
|
|
|
svp = hv_fetch(GvHVn(PL_envgv), name, len, FALSE); |
117
|
|
|
|
|
|
if (!svp || *svp == &PL_sv_undef) |
118
|
|
|
|
|
|
break; |
119
|
|
|
|
|
|
if (SvTAINTED(*svp)) { |
120
|
|
|
|
|
|
TAINT; |
121
|
|
|
|
|
|
taint_proper("Insecure %s%s", "$ENV{DCL$PATH}"); |
122
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
if ((mg = mg_find(*svp, PERL_MAGIC_envelem)) && MgTAINTEDDIR(mg)) { |
124
|
|
|
|
|
|
TAINT; |
125
|
|
|
|
|
|
taint_proper("Insecure directory in %s%s", "$ENV{DCL$PATH}"); |
126
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
i++; |
128
|
|
|
|
|
|
} |
129
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
#endif /* VMS */ |
131
|
|
|
|
|
|
|
132
|
2
|
50
|
|
|
|
svp = hv_fetchs(GvHVn(PL_envgv),"PATH",FALSE); |
133
|
2
|
50
|
|
|
|
if (svp && *svp) { |
|
|
50
|
|
|
|
|
134
|
2
|
50
|
|
|
|
if (SvTAINTED(*svp)) { |
|
|
50
|
|
|
|
|
135
|
2
|
|
|
|
|
TAINT; |
136
|
2
|
|
|
|
|
taint_proper("Insecure %s%s", "$ENV{PATH}"); |
137
|
|
|
|
|
|
} |
138
|
2
|
50
|
|
|
|
if ((mg = mg_find(*svp, PERL_MAGIC_envelem)) && MgTAINTEDDIR(mg)) { |
|
|
50
|
|
|
|
|
139
|
0
|
|
|
|
|
TAINT; |
140
|
0
|
|
|
|
|
taint_proper("Insecure directory in %s%s", "$ENV{PATH}"); |
141
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
144
|
|
|
|
|
|
#ifndef VMS |
145
|
|
|
|
|
|
/* tainted $TERM is okay if it contains no metachars */ |
146
|
2
|
50
|
|
|
|
svp = hv_fetchs(GvHVn(PL_envgv),"TERM",FALSE); |
147
|
2
|
50
|
|
|
|
if (svp && *svp && SvTAINTED(*svp)) { |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
148
|
|
|
|
|
|
STRLEN len; |
149
|
2
|
|
|
|
|
const bool was_tainted = TAINT_get; |
150
|
2
|
50
|
|
|
|
const char *t = SvPV_const(*svp, len); |
151
|
2
|
|
|
|
|
const char * const e = t + len; |
152
|
|
|
|
|
|
|
153
|
2
|
|
|
|
|
TAINT_set(was_tainted); |
154
|
|
|
|
|
|
#ifdef NO_TAINT_SUPPORT |
155
|
|
|
|
|
|
PERL_UNUSED_VAR(was_tainted); |
156
|
|
|
|
|
|
#endif |
157
|
2
|
50
|
|
|
|
if (t < e && isWORDCHAR(*t)) |
|
|
50
|
|
|
|
|
158
|
2
|
|
|
|
|
t++; |
159
|
30
|
100
|
|
|
|
while (t < e && (isWORDCHAR(*t) || strchr("-_.+", *t))) |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
160
|
28
|
|
|
|
|
t++; |
161
|
2
|
50
|
|
|
|
if (t < e) { |
162
|
0
|
|
|
|
|
TAINT; |
163
|
1
|
|
|
|
|
taint_proper("Insecure $ENV{%s}%s", "TERM"); |
164
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
} |
166
|
|
|
|
|
|
#endif /* !VMS */ |
167
|
|
|
|
|
|
|
168
|
9
|
100
|
|
|
|
for (e = misc_env; *e; e++) { |
169
|
8
|
50
|
|
|
|
SV * const * const svp = hv_fetch(GvHVn(PL_envgv), *e, strlen(*e), FALSE); |
170
|
8
|
50
|
|
|
|
if (svp && *svp != &PL_sv_undef && SvTAINTED(*svp)) { |
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
171
|
0
|
|
|
|
|
TAINT; |
172
|
0
|
|
|
|
|
taint_proper("Insecure $ENV{%s}%s", *e); |
173
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
177
|
|
|
|
|
|
/* |
178
|
|
|
|
|
|
* Local variables: |
179
|
|
|
|
|
|
* c-indentation-style: bsd |
180
|
|
|
|
|
|
* c-basic-offset: 4 |
181
|
|
|
|
|
|
* indent-tabs-mode: nil |
182
|
|
|
|
|
|
* End: |
183
|
|
|
|
|
|
* |
184
|
|
|
|
|
|
* ex: set ts=8 sts=4 sw=4 et: |
185
|
|
|
|
|
|
*/ |