This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Band-aid until we've got %{Uid_t} or something similar
[perl5.git] / taint.c
1 /*
2  * "...we will have peace, when you and all your works have perished--and
3  * the works of your dark master to whom you would deliver us.  You are a
4  * liar, Saruman, and a corrupter of men's hearts."  --Theoden
5  */
6
7 #include "EXTERN.h"
8 #define PERL_IN_TAINT_C
9 #include "perl.h"
10
11 void
12 Perl_taint_proper(pTHX_ const char *f, char *s)
13 {
14     dTHR;       /* just for taint */
15     char *ug;
16
17 #ifdef IV_IS_QUAD
18     DEBUG_u(PerlIO_printf(Perl_debug_log,
19             "%s %d %" PERL_PRId64 " %" PERL_PRId64 "\n", s, PL_tainted, (IV)PL_uid, (IV)PL_euid));
20 #else
21     DEBUG_u(PerlIO_printf(Perl_debug_log,
22             "%s %d %lu %lu\n", s, PL_tainted, (unsigned long)PL_uid, (unsigned long)PL_euid));
23 #endif
24
25     if (PL_tainted) {
26         if (!f)
27             f = PL_no_security;
28         if (PL_euid != PL_uid)
29             ug = " while running setuid";
30         else if (PL_egid != PL_gid)
31             ug = " while running setgid";
32         else
33             ug = " while running with -T switch";
34         if (!PL_unsafe)
35             Perl_croak(aTHX_ f, s, ug);
36         else if (ckWARN(WARN_TAINT))
37             Perl_warner(aTHX_ WARN_TAINT, f, s, ug);
38     }
39 }
40
41 void
42 Perl_taint_env(pTHX)
43 {
44     SV** svp;
45     MAGIC* mg;
46     char** e;
47     static char* misc_env[] = {
48         "IFS",          /* most shells' inter-field separators */
49         "CDPATH",       /* ksh dain bramage #1 */
50         "ENV",          /* ksh dain bramage #2 */
51         "BASH_ENV",     /* bash dain bramage -- I guess it's contagious */
52         NULL
53     };
54
55     if (!PL_envgv)
56         return;
57
58 #ifdef VMS
59     {
60     int i = 0;
61     char name[10 + TYPE_DIGITS(int)] = "DCL$PATH";
62
63     while (1) {
64         if (i)
65             (void)sprintf(name,"DCL$PATH;%d", i);
66         svp = hv_fetch(GvHVn(PL_envgv), name, strlen(name), FALSE);
67         if (!svp || *svp == &PL_sv_undef)
68             break;
69         if (SvTAINTED(*svp)) {
70             dTHR;
71             TAINT;
72             taint_proper("Insecure %s%s", "$ENV{DCL$PATH}");
73         }
74         if ((mg = mg_find(*svp, 'e')) && MgTAINTEDDIR(mg)) {
75             dTHR;
76             TAINT;
77             taint_proper("Insecure directory in %s%s", "$ENV{DCL$PATH}");
78         }
79         i++;
80     }
81   }
82 #endif /* VMS */
83
84     svp = hv_fetch(GvHVn(PL_envgv),"PATH",4,FALSE);
85     if (svp && *svp) {
86         if (SvTAINTED(*svp)) {
87             dTHR;
88             TAINT;
89             taint_proper("Insecure %s%s", "$ENV{PATH}");
90         }
91         if ((mg = mg_find(*svp, 'e')) && MgTAINTEDDIR(mg)) {
92             dTHR;
93             TAINT;
94             taint_proper("Insecure directory in %s%s", "$ENV{PATH}");
95         }
96     }
97
98 #ifndef VMS
99     /* tainted $TERM is okay if it contains no metachars */
100     svp = hv_fetch(GvHVn(PL_envgv),"TERM",4,FALSE);
101     if (svp && *svp && SvTAINTED(*svp)) {
102         dTHR;   /* just for taint */
103         STRLEN n_a;
104         bool was_tainted = PL_tainted;
105         char *t = SvPV(*svp, n_a);
106         char *e = t + n_a;
107         PL_tainted = was_tainted;
108         if (t < e && isALNUM(*t))
109             t++;
110         while (t < e && (isALNUM(*t) || *t == '-' || *t == ':'))
111             t++;
112         if (t < e) {
113             TAINT;
114             taint_proper("Insecure $ENV{%s}%s", "TERM");
115         }
116     }
117 #endif /* !VMS */
118
119     for (e = misc_env; *e; e++) {
120         svp = hv_fetch(GvHVn(PL_envgv), *e, strlen(*e), FALSE);
121         if (svp && *svp != &PL_sv_undef && SvTAINTED(*svp)) {
122             dTHR;       /* just for taint */
123             TAINT;
124             taint_proper("Insecure $ENV{%s}%s", *e);
125         }
126     }
127 }