| 1 |
root |
1.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 |
|
|
char *ug; |
| 28 |
|
|
|
| 29 |
|
|
#if defined(HAS_SETEUID) && defined(DEBUGGING) |
| 30 |
|
|
# if Uid_t_size == 1 |
| 31 |
|
|
{ |
| 32 |
|
|
UV uid = PL_uid; |
| 33 |
|
|
UV euid = PL_euid; |
| 34 |
|
|
|
| 35 |
|
|
DEBUG_u(PerlIO_printf(Perl_debug_log, |
| 36 |
|
|
"%s %d %"UVuf" %"UVuf"\n", |
| 37 |
|
|
s, PL_tainted, uid, euid)); |
| 38 |
|
|
} |
| 39 |
|
|
# else |
| 40 |
|
|
{ |
| 41 |
|
|
IV uid = PL_uid; |
| 42 |
|
|
IV euid = PL_euid; |
| 43 |
|
|
|
| 44 |
|
|
DEBUG_u(PerlIO_printf(Perl_debug_log, |
| 45 |
|
|
"%s %d %"IVdf" %"IVdf"\n", |
| 46 |
|
|
s, PL_tainted, uid, euid)); |
| 47 |
|
|
} |
| 48 |
|
|
# endif |
| 49 |
|
|
#endif |
| 50 |
|
|
|
| 51 |
|
|
if (PL_tainted) { |
| 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 |
|
|
char** e; |
| 78 |
|
|
static char* 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 |
|
|
bool was_tainted = PL_tainted; |
| 94 |
|
|
char *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 |
|
|
|
| 111 |
|
|
while (1) { |
| 112 |
|
|
if (i) |
| 113 |
|
|
(void)sprintf(name,"DCL$PATH;%d", i); |
| 114 |
|
|
svp = hv_fetch(GvHVn(PL_envgv), name, strlen(name), FALSE); |
| 115 |
|
|
if (!svp || *svp == &PL_sv_undef) |
| 116 |
|
|
break; |
| 117 |
|
|
if (SvTAINTED(*svp)) { |
| 118 |
|
|
TAINT; |
| 119 |
|
|
taint_proper("Insecure %s%s", "$ENV{DCL$PATH}"); |
| 120 |
|
|
} |
| 121 |
|
|
if ((mg = mg_find(*svp, PERL_MAGIC_envelem)) && MgTAINTEDDIR(mg)) { |
| 122 |
|
|
TAINT; |
| 123 |
|
|
taint_proper("Insecure directory in %s%s", "$ENV{DCL$PATH}"); |
| 124 |
|
|
} |
| 125 |
|
|
i++; |
| 126 |
|
|
} |
| 127 |
|
|
} |
| 128 |
|
|
#endif /* VMS */ |
| 129 |
|
|
|
| 130 |
|
|
svp = hv_fetch(GvHVn(PL_envgv),"PATH",4,FALSE); |
| 131 |
|
|
if (svp && *svp) { |
| 132 |
|
|
if (SvTAINTED(*svp)) { |
| 133 |
|
|
TAINT; |
| 134 |
|
|
taint_proper("Insecure %s%s", "$ENV{PATH}"); |
| 135 |
|
|
} |
| 136 |
|
|
if ((mg = mg_find(*svp, PERL_MAGIC_envelem)) && MgTAINTEDDIR(mg)) { |
| 137 |
|
|
TAINT; |
| 138 |
|
|
taint_proper("Insecure directory in %s%s", "$ENV{PATH}"); |
| 139 |
|
|
} |
| 140 |
|
|
} |
| 141 |
|
|
|
| 142 |
|
|
#ifndef VMS |
| 143 |
|
|
/* tainted $TERM is okay if it contains no metachars */ |
| 144 |
|
|
svp = hv_fetch(GvHVn(PL_envgv),"TERM",4,FALSE); |
| 145 |
|
|
if (svp && *svp && SvTAINTED(*svp)) { |
| 146 |
|
|
STRLEN n_a; |
| 147 |
|
|
bool was_tainted = PL_tainted; |
| 148 |
|
|
char *t = SvPV(*svp, n_a); |
| 149 |
|
|
char *e = t + n_a; |
| 150 |
|
|
PL_tainted = was_tainted; |
| 151 |
|
|
if (t < e && isALNUM(*t)) |
| 152 |
|
|
t++; |
| 153 |
|
|
while (t < e && (isALNUM(*t) || strchr("-_.+", *t))) |
| 154 |
|
|
t++; |
| 155 |
|
|
if (t < e) { |
| 156 |
|
|
TAINT; |
| 157 |
|
|
taint_proper("Insecure $ENV{%s}%s", "TERM"); |
| 158 |
|
|
} |
| 159 |
|
|
} |
| 160 |
|
|
#endif /* !VMS */ |
| 161 |
|
|
|
| 162 |
|
|
for (e = misc_env; *e; e++) { |
| 163 |
|
|
svp = hv_fetch(GvHVn(PL_envgv), *e, strlen(*e), FALSE); |
| 164 |
|
|
if (svp && *svp != &PL_sv_undef && SvTAINTED(*svp)) { |
| 165 |
|
|
TAINT; |
| 166 |
|
|
taint_proper("Insecure $ENV{%s}%s", *e); |
| 167 |
|
|
} |
| 168 |
|
|
} |
| 169 |
|
|
} |
