Further yak-shaving on Pod::Usage. Now, t/pod/pod2usage2.t tests
[perl.git] / taint.c
1 /*    taint.c
2  *
3  *    Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
4  *    2000, 2001, 2002, 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."  --Theoden
15  */
16
17 /* This file contains a few functions for handling data tainting in Perl
18  */
19
20 #include "EXTERN.h"
21 #define PERL_IN_TAINT_C
22 #include "perl.h"
23
24 void
25 Perl_taint_proper(pTHX_ const char *f, const char *s)
26 {
27 #if defined(HAS_SETEUID) && defined(DEBUGGING)
28 #   if Uid_t_size == 1
29     {
30         const UV  uid = PL_uid;
31         const UV euid = PL_euid;
32
33         DEBUG_u(PerlIO_printf(Perl_debug_log,
34                                "%s %d %"UVuf" %"UVuf"\n",
35                                s, PL_tainted, uid, euid));
36     }
37 #   else
38     {
39         const IV  uid = PL_uid;
40         const IV euid = PL_euid;
41
42         DEBUG_u(PerlIO_printf(Perl_debug_log,
43                                "%s %d %"IVdf" %"IVdf"\n",
44                                s, PL_tainted, uid, euid));
45     }
46 #   endif
47 #endif
48
49     if (PL_tainted) {
50         const char *ug;
51
52         if (!f)
53             f = PL_no_security;
54         if (PL_euid != PL_uid)
55             ug = " while running setuid";
56         else if (PL_egid != PL_gid)
57             ug = " while running setgid";
58         else if (PL_taint_warn)
59             ug = " while running with -t switch";
60         else
61             ug = " while running with -T switch";
62         if (PL_unsafe || PL_taint_warn) {
63             if(ckWARN(WARN_TAINT))
64                 Perl_warner(aTHX_ packWARN(WARN_TAINT), f, s, ug);
65         }
66         else {
67             Perl_croak(aTHX_ f, s, ug);
68         }
69     }
70 }
71
72 void
73 Perl_taint_env(pTHX)
74 {
75     SV** svp;
76     MAGIC* mg;
77     const char* const *e;
78     static const char* const misc_env[] = {
79         "IFS",          /* most shells' inter-field separators */
80         "CDPATH",       /* ksh dain bramage #1 */
81         "ENV",          /* ksh dain bramage #2 */
82         "BASH_ENV",     /* bash dain bramage -- I guess it's contagious */
83         NULL
84     };
85
86     /* Don't bother if there's no *ENV glob */
87     if (!PL_envgv)
88         return;
89     /* If there's no %ENV hash of if it's not magical, croak, because
90      * it probably doesn't reflect the actual environment */
91     if (!GvHV(PL_envgv) || !(SvRMAGICAL(GvHV(PL_envgv))
92             && mg_find((SV*)GvHV(PL_envgv), PERL_MAGIC_env))) {
93         const bool was_tainted = PL_tainted;
94         const char * const name = GvENAME(PL_envgv);
95         PL_tainted = TRUE;
96         if (strEQ(name,"ENV"))
97             /* hash alias */
98             taint_proper("%%ENV is aliased to %s%s", "another variable");
99         else
100             /* glob alias: report it in the error message */
101             taint_proper("%%ENV is aliased to %%%s%s", name);
102         /* this statement is reached under -t or -U */
103         PL_tainted = was_tainted;
104     }
105
106 #ifdef VMS
107     {
108     int i = 0;
109     char name[10 + TYPE_DIGITS(int)] = "DCL$PATH";
110     STRLEN len = 8; /* strlen(name)  */
111
112     while (1) {
113         if (i)
114             len = my_sprintf(name,"DCL$PATH;%d", i);
115         svp = hv_fetch(GvHVn(PL_envgv), name, len, FALSE);
116         if (!svp || *svp == &PL_sv_undef)
117             break;
118         if (SvTAINTED(*svp)) {
119             TAINT;
120             taint_proper("Insecure %s%s", "$ENV{DCL$PATH}");
121         }
122         if ((mg = mg_find(*svp, PERL_MAGIC_envelem)) && MgTAINTEDDIR(mg)) {
123             TAINT;
124             taint_proper("Insecure directory in %s%s", "$ENV{DCL$PATH}");
125         }
126         i++;
127     }
128   }
129 #endif /* VMS */
130
131     svp = hv_fetch(GvHVn(PL_envgv),"PATH",4,FALSE);
132     if (svp && *svp) {
133         if (SvTAINTED(*svp)) {
134             TAINT;
135             taint_proper("Insecure %s%s", "$ENV{PATH}");
136         }
137         if ((mg = mg_find(*svp, PERL_MAGIC_envelem)) && MgTAINTEDDIR(mg)) {
138             TAINT;
139             taint_proper("Insecure directory in %s%s", "$ENV{PATH}");
140         }
141     }
142
143 #ifndef VMS
144     /* tainted $TERM is okay if it contains no metachars */
145     svp = hv_fetch(GvHVn(PL_envgv),"TERM",4,FALSE);
146     if (svp && *svp && SvTAINTED(*svp)) {
147         STRLEN len;
148         const bool was_tainted = PL_tainted;
149         const char *t = SvPV_const(*svp, len);
150         const char * const e = t + len;
151         PL_tainted = was_tainted;
152         if (t < e && isALNUM(*t))
153             t++;
154         while (t < e && (isALNUM(*t) || strchr("-_.+", *t)))
155             t++;
156         if (t < e) {
157             TAINT;
158             taint_proper("Insecure $ENV{%s}%s", "TERM");
159         }
160     }
161 #endif /* !VMS */
162
163     for (e = misc_env; *e; e++) {
164         SV * const * const svp = hv_fetch(GvHVn(PL_envgv), *e, strlen(*e), FALSE);
165         if (svp && *svp != &PL_sv_undef && SvTAINTED(*svp)) {
166             TAINT;
167             taint_proper("Insecure $ENV{%s}%s", *e);
168         }
169     }
170 }
171
172 /*
173  * Local variables:
174  * c-indentation-style: bsd
175  * c-basic-offset: 4
176  * indent-tabs-mode: t
177  * End:
178  *
179  * ex: set ts=8 sts=4 sw=4 noet:
180  */