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 /* 27 =for apidoc taint_proper 28 29 Implements the L</TAINT_PROPER> macro, which you should generally use instead. 30 31 =cut 32 */ 33 34 void 35 Perl_taint_proper(pTHX_ const char *f, const char *const s) 36 { 37 /* Don't use directly; instead use TAINT_PROPER 38 * 39 * Output a tainting violation, croaking unless we're just to warn. 40 * '_proper' is just to throw you off the scent */ 41 42 #if defined(HAS_SETEUID) && defined(DEBUGGING) 43 PERL_ARGS_ASSERT_TAINT_PROPER; 44 45 { 46 const Uid_t uid = PerlProc_getuid(); 47 const Uid_t euid = PerlProc_geteuid(); 48 49 #if Uid_t_sign == 1 /* uid_t is unsigned. */ 50 DEBUG_u(PerlIO_printf(Perl_debug_log, 51 "%s %d %" UVuf " %" UVuf "\n", 52 s, TAINT_get, (UV)uid, (UV)euid)); 53 #else /* uid_t is signed (Uid_t_sign == -1), or don't know. */ 54 DEBUG_u(PerlIO_printf(Perl_debug_log, 55 "%s %d %" IVdf " %" IVdf "\n", 56 s, TAINT_get, (IV)uid, (IV)euid)); 57 #endif 58 } 59 #endif 60 61 if (TAINT_get) { 62 const char *ug; 63 64 if (!f) 65 f = PL_no_security; 66 if (PerlProc_getuid() != PerlProc_geteuid()) 67 ug = " while running setuid"; 68 else if (PerlProc_getgid() != PerlProc_getegid()) 69 ug = " while running setgid"; 70 else if (TAINT_WARN_get) 71 ug = " while running with -t switch"; 72 else 73 ug = " while running with -T switch"; 74 75 /* XXX because taint_proper adds extra format args, we can't 76 * get the caller to check properly; so we just silence the warning 77 * and hope the callers aren't naughty */ 78 GCC_DIAG_IGNORE_STMT(-Wformat-nonliteral); 79 if (PL_unsafe || TAINT_WARN_get) { 80 Perl_ck_warner_d(aTHX_ packWARN(WARN_TAINT), f, s, ug); 81 } 82 else { 83 Perl_croak(aTHX_ f, s, ug); 84 } 85 GCC_DIAG_RESTORE_STMT; 86 87 } 88 } 89 90 /* 91 =for apidoc taint_env 92 93 Implements the L</TAINT_ENV> macro, which you should generally use instead. 94 95 =cut 96 */ 97 void 98 Perl_taint_env(pTHX) 99 { 100 /* Don't use directly; instead use TAINT_ENV */ 101 102 SV** svp; 103 const char* const *e; 104 static const char* const misc_env[] = { 105 "IFS", /* most shells' inter-field separators */ 106 "CDPATH", /* ksh dain bramage #1 */ 107 "ENV", /* ksh dain bramage #2 */ 108 "BASH_ENV", /* bash dain bramage -- I guess it's contagious */ 109 #ifdef WIN32 110 "PERL5SHELL", /* used for system() on Windows */ 111 #endif 112 NULL 113 }; 114 115 /* Don't bother if there's no *ENV glob */ 116 if (!PL_envgv) 117 return; 118 /* If there's no %ENV hash or if it's not magical, croak, because 119 * it probably doesn't reflect the actual environment */ 120 if (!GvHV(PL_envgv) || !(SvRMAGICAL(GvHV(PL_envgv)) 121 && mg_find((const SV *)GvHV(PL_envgv), PERL_MAGIC_env))) { 122 const bool was_tainted = TAINT_get; 123 const char * const name = GvENAME(PL_envgv); 124 TAINT; 125 if (strEQ(name,"ENV")) 126 /* hash alias */ 127 taint_proper("%%ENV is aliased to %s%s", "another variable"); 128 else 129 /* glob alias: report it in the error message */ 130 taint_proper("%%ENV is aliased to %%%s%s", name); 131 /* this statement is reached under -t or -U */ 132 TAINT_set(was_tainted); 133 #ifdef NO_TAINT_SUPPORT 134 PERL_UNUSED_VAR(was_tainted); 135 #endif 136 } 137 138 #ifdef VMS 139 { 140 int i = 0; 141 char name[10 + TYPE_DIGITS(int)] = "DCL$PATH"; 142 STRLEN len = 8; /* strlen(name) */ 143 144 while (1) { 145 MAGIC* mg; 146 if (i) 147 len = my_snprintf(name, sizeof name, "DCL$PATH;%d", i); 148 svp = hv_fetch(GvHVn(PL_envgv), name, len, FALSE); 149 if (!svp || *svp == &PL_sv_undef) 150 break; 151 if (SvTAINTED(*svp)) { 152 TAINT; 153 taint_proper("Insecure %s%s", "$ENV{DCL$PATH}"); 154 } 155 if ((mg = mg_find(*svp, PERL_MAGIC_envelem)) && MgTAINTEDDIR(mg)) { 156 TAINT; 157 taint_proper("Insecure directory in %s%s", "$ENV{DCL$PATH}"); 158 } 159 i++; 160 } 161 } 162 #endif /* VMS */ 163 164 svp = hv_fetchs(GvHVn(PL_envgv),"PATH",FALSE); 165 if (svp && *svp) { 166 MAGIC* mg; 167 if (SvTAINTED(*svp)) { 168 TAINT; 169 taint_proper("Insecure %s%s", "$ENV{PATH}"); 170 } 171 if ((mg = mg_find(*svp, PERL_MAGIC_envelem)) && MgTAINTEDDIR(mg)) { 172 TAINT; 173 taint_proper("Insecure directory in %s%s", "$ENV{PATH}"); 174 } 175 } 176 177 #ifndef VMS 178 /* tainted $TERM is okay if it contains no metachars */ 179 svp = hv_fetchs(GvHVn(PL_envgv),"TERM",FALSE); 180 if (svp && *svp && SvTAINTED(*svp)) { 181 STRLEN len; 182 const bool was_tainted = TAINT_get; 183 const char *t = SvPV_const(*svp, len); 184 const char * const e = t + len; 185 186 TAINT_set(was_tainted); 187 #ifdef NO_TAINT_SUPPORT 188 PERL_UNUSED_VAR(was_tainted); 189 #endif 190 if (t < e && isWORDCHAR(*t)) 191 t++; 192 while (t < e && (isWORDCHAR(*t) || memCHRs("-_.+", *t))) 193 t++; 194 if (t < e) { 195 TAINT; 196 taint_proper("Insecure $ENV{%s}%s", "TERM"); 197 } 198 } 199 #endif /* !VMS */ 200 201 for (e = misc_env; *e; e++) { 202 SV * const * const svp = hv_fetch(GvHVn(PL_envgv), *e, strlen(*e), FALSE); 203 if (svp && *svp != &PL_sv_undef && SvTAINTED(*svp)) { 204 TAINT; 205 taint_proper("Insecure $ENV{%s}%s", *e); 206 } 207 } 208 } 209 210 /* 211 * ex: set ts=8 sts=4 sw=4 et: 212 */ 213