X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/57def98fcb6c98601beaf31e3c48ad681bfdc2a3..2653c1e3b10f71430de1ab8ab0417ca5b048ab19:/taint.c diff --git a/taint.c b/taint.c index c272066..72bb979 100644 --- a/taint.c +++ b/taint.c @@ -1,7 +1,22 @@ +/* taint.c + * + * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, + * 2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others + * + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. + * + */ + /* - * "...we will have peace, when you and all your works have perished--and - * the works of your dark master to whom you would deliver us. You are a - * liar, Saruman, and a corrupter of men's hearts." --Theoden + * '...we will have peace, when you and all your works have perished--and + * the works of your dark master to whom you would deliver us. You are a + * liar, Saruman, and a corrupter of men's hearts.' --Théoden + * + * [p.580 of _The Lord of the Rings_, III/x: "The Voice of Saruman"] + */ + +/* This file contains a few functions for handling data tainting in Perl */ #include "EXTERN.h" @@ -9,70 +24,111 @@ #include "perl.h" void -Perl_taint_proper(pTHX_ const char *f, char *s) +Perl_taint_proper(pTHX_ const char *f, const char *const s) { - dTHR; /* just for taint */ - char *ug; - -#if Uid_t_SIGN == -1 - DEBUG_u(PerlIO_printf(Perl_debug_log, - "%s %d %"IVdf" %"IVdf"\n", s, PL_tainted, (IV)PL_uid, (IV)PL_euid)); -#else - DEBUG_u(PerlIO_printf(Perl_debug_log, - "%s %d %"UVuf" %"UVuf"\n", s, PL_tainted, (UV)PL_uid, (UV)PL_euid)); +#if defined(HAS_SETEUID) && defined(DEBUGGING) + dVAR; + + PERL_ARGS_ASSERT_TAINT_PROPER; + +# if Uid_t_size == 1 + { + const UV uid = PerlProc_getuid(); + const UV euid = PerlProc_geteuid(); + + DEBUG_u(PerlIO_printf(Perl_debug_log, + "%s %d %"UVuf" %"UVuf"\n", + s, PL_tainted, uid, euid)); + } +# else + { + const IV uid = PerlProc_getuid(); + const IV euid = PerlProc_geteuid(); + + DEBUG_u(PerlIO_printf(Perl_debug_log, + "%s %d %"IVdf" %"IVdf"\n", + s, PL_tainted, uid, euid)); + } +# endif #endif if (PL_tainted) { + const char *ug; + if (!f) f = PL_no_security; - if (PL_euid != PL_uid) + if (PerlProc_getuid() != PerlProc_geteuid()) ug = " while running setuid"; - else if (PL_egid != PL_gid) + else if (PerlProc_getgid() != PerlProc_getegid()) ug = " while running setgid"; - else + else if (PL_taint_warn) + ug = " while running with -t switch"; + else ug = " while running with -T switch"; - if (!PL_unsafe) - Perl_croak(aTHX_ f, s, ug); - else if (ckWARN(WARN_TAINT)) - Perl_warner(aTHX_ WARN_TAINT, f, s, ug); + if (PL_unsafe || PL_taint_warn) { + Perl_ck_warner_d(aTHX_ packWARN(WARN_TAINT), f, s, ug); + } + else { + Perl_croak(aTHX_ f, s, ug); + } } } void Perl_taint_env(pTHX) { + dVAR; SV** svp; MAGIC* mg; - char** e; - static char* misc_env[] = { + const char* const *e; + static const char* const misc_env[] = { "IFS", /* most shells' inter-field separators */ "CDPATH", /* ksh dain bramage #1 */ "ENV", /* ksh dain bramage #2 */ "BASH_ENV", /* bash dain bramage -- I guess it's contagious */ +#ifdef WIN32 + "PERL5SHELL", /* used for system() on Windows */ +#endif NULL }; + /* Don't bother if there's no *ENV glob */ if (!PL_envgv) return; + /* If there's no %ENV hash of if it's not magical, croak, because + * it probably doesn't reflect the actual environment */ + if (!GvHV(PL_envgv) || !(SvRMAGICAL(GvHV(PL_envgv)) + && mg_find((const SV *)GvHV(PL_envgv), PERL_MAGIC_env))) { + const bool was_tainted = PL_tainted; + const char * const name = GvENAME(PL_envgv); + PL_tainted = TRUE; + if (strEQ(name,"ENV")) + /* hash alias */ + taint_proper("%%ENV is aliased to %s%s", "another variable"); + else + /* glob alias: report it in the error message */ + taint_proper("%%ENV is aliased to %%%s%s", name); + /* this statement is reached under -t or -U */ + PL_tainted = was_tainted; + } #ifdef VMS { int i = 0; char name[10 + TYPE_DIGITS(int)] = "DCL$PATH"; + STRLEN len = 8; /* strlen(name) */ while (1) { if (i) - (void)sprintf(name,"DCL$PATH;%d", i); - svp = hv_fetch(GvHVn(PL_envgv), name, strlen(name), FALSE); + len = my_sprintf(name,"DCL$PATH;%d", i); + svp = hv_fetch(GvHVn(PL_envgv), name, len, FALSE); if (!svp || *svp == &PL_sv_undef) break; if (SvTAINTED(*svp)) { - dTHR; TAINT; taint_proper("Insecure %s%s", "$ENV{DCL$PATH}"); } - if ((mg = mg_find(*svp, 'e')) && MgTAINTEDDIR(mg)) { - dTHR; + if ((mg = mg_find(*svp, PERL_MAGIC_envelem)) && MgTAINTEDDIR(mg)) { TAINT; taint_proper("Insecure directory in %s%s", "$ENV{DCL$PATH}"); } @@ -81,15 +137,13 @@ Perl_taint_env(pTHX) } #endif /* VMS */ - svp = hv_fetch(GvHVn(PL_envgv),"PATH",4,FALSE); + svp = hv_fetchs(GvHVn(PL_envgv),"PATH",FALSE); if (svp && *svp) { if (SvTAINTED(*svp)) { - dTHR; TAINT; taint_proper("Insecure %s%s", "$ENV{PATH}"); } - if ((mg = mg_find(*svp, 'e')) && MgTAINTEDDIR(mg)) { - dTHR; + if ((mg = mg_find(*svp, PERL_MAGIC_envelem)) && MgTAINTEDDIR(mg)) { TAINT; taint_proper("Insecure directory in %s%s", "$ENV{PATH}"); } @@ -97,17 +151,16 @@ Perl_taint_env(pTHX) #ifndef VMS /* tainted $TERM is okay if it contains no metachars */ - svp = hv_fetch(GvHVn(PL_envgv),"TERM",4,FALSE); + svp = hv_fetchs(GvHVn(PL_envgv),"TERM",FALSE); if (svp && *svp && SvTAINTED(*svp)) { - dTHR; /* just for taint */ - STRLEN n_a; - bool was_tainted = PL_tainted; - char *t = SvPV(*svp, n_a); - char *e = t + n_a; + STRLEN len; + const bool was_tainted = PL_tainted; + const char *t = SvPV_const(*svp, len); + const char * const e = t + len; PL_tainted = was_tainted; if (t < e && isALNUM(*t)) t++; - while (t < e && (isALNUM(*t) || *t == '-' || *t == ':')) + while (t < e && (isALNUM(*t) || strchr("-_.+", *t))) t++; if (t < e) { TAINT; @@ -117,11 +170,20 @@ Perl_taint_env(pTHX) #endif /* !VMS */ for (e = misc_env; *e; e++) { - svp = hv_fetch(GvHVn(PL_envgv), *e, strlen(*e), FALSE); + SV * const * const svp = hv_fetch(GvHVn(PL_envgv), *e, strlen(*e), FALSE); if (svp && *svp != &PL_sv_undef && SvTAINTED(*svp)) { - dTHR; /* just for taint */ TAINT; taint_proper("Insecure $ENV{%s}%s", *e); } } } + +/* + * Local variables: + * c-indentation-style: bsd + * c-basic-offset: 4 + * indent-tabs-mode: t + * End: + * + * ex: set ts=8 sts=4 sw=4 noet: + */