Mercurial > repo
comparison perl-5.22.2/taint.c @ 8045:a16537d2fe07
<xfix> tar xf perl-5.22.2.tar.gz # Ah, whatever, I\'m doing it anyway
author | HackBot |
---|---|
date | Sat, 14 May 2016 14:54:38 +0000 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
8044:711c038a7dce | 8045:a16537d2fe07 |
---|---|
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 Perl_taint_proper(pTHX_ const char *f, const char *const s) | |
28 { | |
29 #if defined(HAS_SETEUID) && defined(DEBUGGING) | |
30 PERL_ARGS_ASSERT_TAINT_PROPER; | |
31 | |
32 { | |
33 const Uid_t uid = PerlProc_getuid(); | |
34 const Uid_t euid = PerlProc_geteuid(); | |
35 | |
36 #if Uid_t_sign == 1 /* uid_t is unsigned. */ | |
37 DEBUG_u(PerlIO_printf(Perl_debug_log, | |
38 "%s %d %"UVuf" %"UVuf"\n", | |
39 s, TAINT_get, (UV)uid, (UV)euid)); | |
40 #else /* uid_t is signed (Uid_t_sign == -1), or don't know. */ | |
41 DEBUG_u(PerlIO_printf(Perl_debug_log, | |
42 "%s %d %"IVdf" %"IVdf"\n", | |
43 s, TAINT_get, (IV)uid, (IV)euid)); | |
44 #endif | |
45 } | |
46 #endif | |
47 | |
48 if (TAINT_get) { | |
49 const char *ug; | |
50 | |
51 if (!f) | |
52 f = PL_no_security; | |
53 if (PerlProc_getuid() != PerlProc_geteuid()) | |
54 ug = " while running setuid"; | |
55 else if (PerlProc_getgid() != PerlProc_getegid()) | |
56 ug = " while running setgid"; | |
57 else if (TAINT_WARN_get) | |
58 ug = " while running with -t switch"; | |
59 else | |
60 ug = " while running with -T switch"; | |
61 | |
62 /* XXX because taint_proper adds extra format args, we can't | |
63 * get the caller to check properly; o we just silence the warning | |
64 * and hope the callers aren't naughty */ | |
65 GCC_DIAG_IGNORE(-Wformat-nonliteral); | |
66 if (PL_unsafe || TAINT_WARN_get) { | |
67 Perl_ck_warner_d(aTHX_ packWARN(WARN_TAINT), f, s, ug); | |
68 } | |
69 else { | |
70 Perl_croak(aTHX_ f, s, ug); | |
71 } | |
72 GCC_DIAG_RESTORE; | |
73 | |
74 } | |
75 } | |
76 | |
77 void | |
78 Perl_taint_env(pTHX) | |
79 { | |
80 SV** svp; | |
81 MAGIC* mg; | |
82 const char* const *e; | |
83 static const char* const misc_env[] = { | |
84 "IFS", /* most shells' inter-field separators */ | |
85 "CDPATH", /* ksh dain bramage #1 */ | |
86 "ENV", /* ksh dain bramage #2 */ | |
87 "BASH_ENV", /* bash dain bramage -- I guess it's contagious */ | |
88 #ifdef WIN32 | |
89 "PERL5SHELL", /* used for system() on Windows */ | |
90 #endif | |
91 NULL | |
92 }; | |
93 | |
94 /* Don't bother if there's no *ENV glob */ | |
95 if (!PL_envgv) | |
96 return; | |
97 /* If there's no %ENV hash or if it's not magical, croak, because | |
98 * it probably doesn't reflect the actual environment */ | |
99 if (!GvHV(PL_envgv) || !(SvRMAGICAL(GvHV(PL_envgv)) | |
100 && mg_find((const SV *)GvHV(PL_envgv), PERL_MAGIC_env))) { | |
101 const bool was_tainted = TAINT_get; | |
102 const char * const name = GvENAME(PL_envgv); | |
103 TAINT; | |
104 if (strEQ(name,"ENV")) | |
105 /* hash alias */ | |
106 taint_proper("%%ENV is aliased to %s%s", "another variable"); | |
107 else | |
108 /* glob alias: report it in the error message */ | |
109 taint_proper("%%ENV is aliased to %%%s%s", name); | |
110 /* this statement is reached under -t or -U */ | |
111 TAINT_set(was_tainted); | |
112 #ifdef NO_TAINT_SUPPORT | |
113 PERL_UNUSED_VAR(was_tainted); | |
114 #endif | |
115 } | |
116 | |
117 #ifdef VMS | |
118 { | |
119 int i = 0; | |
120 char name[10 + TYPE_DIGITS(int)] = "DCL$PATH"; | |
121 STRLEN len = 8; /* strlen(name) */ | |
122 | |
123 while (1) { | |
124 if (i) | |
125 len = my_sprintf(name,"DCL$PATH;%d", i); | |
126 svp = hv_fetch(GvHVn(PL_envgv), name, len, FALSE); | |
127 if (!svp || *svp == &PL_sv_undef) | |
128 break; | |
129 if (SvTAINTED(*svp)) { | |
130 TAINT; | |
131 taint_proper("Insecure %s%s", "$ENV{DCL$PATH}"); | |
132 } | |
133 if ((mg = mg_find(*svp, PERL_MAGIC_envelem)) && MgTAINTEDDIR(mg)) { | |
134 TAINT; | |
135 taint_proper("Insecure directory in %s%s", "$ENV{DCL$PATH}"); | |
136 } | |
137 i++; | |
138 } | |
139 } | |
140 #endif /* VMS */ | |
141 | |
142 svp = hv_fetchs(GvHVn(PL_envgv),"PATH",FALSE); | |
143 if (svp && *svp) { | |
144 if (SvTAINTED(*svp)) { | |
145 TAINT; | |
146 taint_proper("Insecure %s%s", "$ENV{PATH}"); | |
147 } | |
148 if ((mg = mg_find(*svp, PERL_MAGIC_envelem)) && MgTAINTEDDIR(mg)) { | |
149 TAINT; | |
150 taint_proper("Insecure directory in %s%s", "$ENV{PATH}"); | |
151 } | |
152 } | |
153 | |
154 #ifndef VMS | |
155 /* tainted $TERM is okay if it contains no metachars */ | |
156 svp = hv_fetchs(GvHVn(PL_envgv),"TERM",FALSE); | |
157 if (svp && *svp && SvTAINTED(*svp)) { | |
158 STRLEN len; | |
159 const bool was_tainted = TAINT_get; | |
160 const char *t = SvPV_const(*svp, len); | |
161 const char * const e = t + len; | |
162 | |
163 TAINT_set(was_tainted); | |
164 #ifdef NO_TAINT_SUPPORT | |
165 PERL_UNUSED_VAR(was_tainted); | |
166 #endif | |
167 if (t < e && isWORDCHAR(*t)) | |
168 t++; | |
169 while (t < e && (isWORDCHAR(*t) || strchr("-_.+", *t))) | |
170 t++; | |
171 if (t < e) { | |
172 TAINT; | |
173 taint_proper("Insecure $ENV{%s}%s", "TERM"); | |
174 } | |
175 } | |
176 #endif /* !VMS */ | |
177 | |
178 for (e = misc_env; *e; e++) { | |
179 SV * const * const svp = hv_fetch(GvHVn(PL_envgv), *e, strlen(*e), FALSE); | |
180 if (svp && *svp != &PL_sv_undef && SvTAINTED(*svp)) { | |
181 TAINT; | |
182 taint_proper("Insecure $ENV{%s}%s", *e); | |
183 } | |
184 } | |
185 } | |
186 | |
187 /* | |
188 * ex: set ts=8 sts=4 sw=4 et: | |
189 */ |