This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Eliminate (SV *) casts from sv.c and [tu]*.c, except for the cast in
[perl5.git] / taint.c
CommitLineData
d6376244
JH
1/* taint.c
2 *
663f364b 3 * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001,
1129b882 4 * 2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others
d6376244
JH
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
a0d0e21e
LW
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." --Theoden
15 */
16
166f8a29
DM
17/* This file contains a few functions for handling data tainting in Perl
18 */
19
463ee0b2 20#include "EXTERN.h"
864dbfa3 21#define PERL_IN_TAINT_C
463ee0b2
LW
22#include "perl.h"
23
24void
e1c41806 25Perl_taint_proper(pTHX_ const char *f, const char *const s)
79072805 26{
26e623cf 27#if defined(HAS_SETEUID) && defined(DEBUGGING)
97aff369 28 dVAR;
7918f24d
NC
29
30 PERL_ARGS_ASSERT_TAINT_PROPER;
31
26e623cf
JH
32# if Uid_t_size == 1
33 {
8772537c
AL
34 const UV uid = PL_uid;
35 const UV euid = PL_euid;
26e623cf 36
8772537c 37 DEBUG_u(PerlIO_printf(Perl_debug_log,
26e623cf
JH
38 "%s %d %"UVuf" %"UVuf"\n",
39 s, PL_tainted, uid, euid));
40 }
41# else
42 {
8772537c
AL
43 const IV uid = PL_uid;
44 const IV euid = PL_euid;
26e623cf 45
8772537c 46 DEBUG_u(PerlIO_printf(Perl_debug_log,
26e623cf
JH
47 "%s %d %"IVdf" %"IVdf"\n",
48 s, PL_tainted, uid, euid));
49 }
50# endif
a52cb5f7 51#endif
1e422769 52
3280af22 53 if (PL_tainted) {
8772537c
AL
54 const char *ug;
55
22c35a8c
GS
56 if (!f)
57 f = PL_no_security;
3280af22 58 if (PL_euid != PL_uid)
bbce6d69 59 ug = " while running setuid";
3280af22 60 else if (PL_egid != PL_gid)
bbce6d69 61 ug = " while running setgid";
6537fe72
MS
62 else if (PL_taint_warn)
63 ug = " while running with -t switch";
64 else
bbce6d69 65 ug = " while running with -T switch";
6537fe72 66 if (PL_unsafe || PL_taint_warn) {
b7bf404b 67 if(ckWARN_d(WARN_TAINT))
9014280d 68 Perl_warner(aTHX_ packWARN(WARN_TAINT), f, s, ug);
6537fe72
MS
69 }
70 else {
71 Perl_croak(aTHX_ f, s, ug);
72 }
79072805
LW
73 }
74}
75
76void
864dbfa3 77Perl_taint_env(pTHX)
79072805 78{
97aff369 79 dVAR;
79072805 80 SV** svp;
7bac28a0 81 MAGIC* mg;
27da23d5
JH
82 const char* const *e;
83 static const char* const misc_env[] = {
7bac28a0 84 "IFS", /* most shells' inter-field separators */
c90c0ff4
PP
85 "CDPATH", /* ksh dain bramage #1 */
86 "ENV", /* ksh dain bramage #2 */
87 "BASH_ENV", /* bash dain bramage -- I guess it's contagious */
e62a6770
RGS
88#ifdef WIN32
89 "PERL5SHELL", /* used for system() on Windows */
90#endif
7bac28a0
PP
91 NULL
92 };
1e422769 93
c038024b
RGS
94 /* Don't bother if there's no *ENV glob */
95 if (!PL_envgv)
142393a6 96 return;
c038024b
RGS
97 /* If there's no %ENV hash of 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))
daba3364 100 && mg_find((const SV *)GvHV(PL_envgv), PERL_MAGIC_env))) {
e1ec3a88 101 const bool was_tainted = PL_tainted;
8772537c 102 const char * const name = GvENAME(PL_envgv);
c038024b
RGS
103 PL_tainted = TRUE;
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 PL_tainted = was_tainted;
112 }
142393a6 113
1e422769 114#ifdef VMS
82f1aded 115 {
1e422769 116 int i = 0;
0dc443ab 117 char name[10 + TYPE_DIGITS(int)] = "DCL$PATH";
86c11942 118 STRLEN len = 8; /* strlen(name) */
1e422769
PP
119
120 while (1) {
121 if (i)
86c11942
NC
122 len = my_sprintf(name,"DCL$PATH;%d", i);
123 svp = hv_fetch(GvHVn(PL_envgv), name, len, FALSE);
6b88bc9c 124 if (!svp || *svp == &PL_sv_undef)
1e422769
PP
125 break;
126 if (SvTAINTED(*svp)) {
127 TAINT;
128 taint_proper("Insecure %s%s", "$ENV{DCL$PATH}");
129 }
c038024b 130 if ((mg = mg_find(*svp, PERL_MAGIC_envelem)) && MgTAINTEDDIR(mg)) {
1e422769
PP
131 TAINT;
132 taint_proper("Insecure directory in %s%s", "$ENV{DCL$PATH}");
133 }
134 i++;
135 }
82f1aded 136 }
1e422769 137#endif /* VMS */
79072805 138
a4fc7abc 139 svp = hv_fetchs(GvHVn(PL_envgv),"PATH",FALSE);
1e422769
PP
140 if (svp && *svp) {
141 if (SvTAINTED(*svp)) {
142 TAINT;
bbce6d69 143 taint_proper("Insecure %s%s", "$ENV{PATH}");
1e422769 144 }
c038024b 145 if ((mg = mg_find(*svp, PERL_MAGIC_envelem)) && MgTAINTEDDIR(mg)) {
1e422769
PP
146 TAINT;
147 taint_proper("Insecure directory in %s%s", "$ENV{PATH}");
148 }
79072805 149 }
79072805 150
c90c0ff4
PP
151#ifndef VMS
152 /* tainted $TERM is okay if it contains no metachars */
a4fc7abc 153 svp = hv_fetchs(GvHVn(PL_envgv),"TERM",FALSE);
c90c0ff4 154 if (svp && *svp && SvTAINTED(*svp)) {
8b6b16e7 155 STRLEN len;
73d840c0 156 const bool was_tainted = PL_tainted;
cfd0369c 157 const char *t = SvPV_const(*svp, len);
8772537c 158 const char * const e = t + len;
3280af22 159 PL_tainted = was_tainted;
c90c0ff4
PP
160 if (t < e && isALNUM(*t))
161 t++;
d085cc71 162 while (t < e && (isALNUM(*t) || strchr("-_.+", *t)))
c90c0ff4
PP
163 t++;
164 if (t < e) {
165 TAINT;
166 taint_proper("Insecure $ENV{%s}%s", "TERM");
167 }
168 }
169#endif /* !VMS */
170
7bac28a0 171 for (e = misc_env; *e; e++) {
0bd48802 172 SV * const * const svp = hv_fetch(GvHVn(PL_envgv), *e, strlen(*e), FALSE);
3280af22 173 if (svp && *svp != &PL_sv_undef && SvTAINTED(*svp)) {
7bac28a0
PP
174 TAINT;
175 taint_proper("Insecure $ENV{%s}%s", *e);
176 }
bbce6d69
PP
177 }
178}
66610fdd
RGS
179
180/*
181 * Local variables:
182 * c-indentation-style: bsd
183 * c-basic-offset: 4
184 * indent-tabs-mode: t
185 * End:
186 *
37442d52
RGS
187 * ex: set ts=8 sts=4 sw=4 noet:
188 */