X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=taint.c;h=ec568be2ccd7bc62a7f1d0a1cb9b3b14163b1157;hb=76c43448ac432c021de5e478d6210fa84dcac466;hp=7a8baac7b0ff4f3f607ccae0bb39d86a4bea855f;hpb=0e06870bf080a38cda51c06c6612359afc2334e1;p=p5sagit%2Fp5-mst-13.2.git diff --git a/taint.c b/taint.c index 7a8baac..ec568be 100644 --- a/taint.c +++ b/taint.c @@ -1,9 +1,22 @@ +/* taint.c + * + * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, + * 2000, 2001, 2002, 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 */ +/* This file contains a few functions for handling data tainting in Perl + */ + #include "EXTERN.h" #define PERL_IN_TAINT_C #include "perl.h" @@ -13,9 +26,26 @@ Perl_taint_proper(pTHX_ const char *f, const char *s) { char *ug; -#ifdef HAS_SETEUID - DEBUG_u(PerlIO_printf(Perl_debug_log, - "%s %d %"Uid_t_f" %"Uid_t_f"\n", s, PL_tainted, PL_uid, PL_euid)); +#if defined(HAS_SETEUID) && defined(DEBUGGING) +# if Uid_t_size == 1 + { + UV uid = PL_uid; + UV euid = PL_euid; + + DEBUG_u(PerlIO_printf(Perl_debug_log, + "%s %d %"UVuf" %"UVuf"\n", + s, PL_tainted, uid, euid)); + } +# else + { + IV uid = PL_uid; + IV euid = PL_euid; + + DEBUG_u(PerlIO_printf(Perl_debug_log, + "%s %d %"IVdf" %"IVdf"\n", + s, PL_tainted, uid, euid)); + } +# endif #endif if (PL_tainted) { @@ -25,12 +55,17 @@ Perl_taint_proper(pTHX_ const char *f, const char *s) ug = " while running setuid"; else if (PL_egid != PL_gid) 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) { + if(ckWARN(WARN_TAINT)) + Perl_warner(aTHX_ packWARN(WARN_TAINT), f, s, ug); + } + else { + Perl_croak(aTHX_ f, s, ug); + } } } @@ -48,8 +83,25 @@ Perl_taint_env(pTHX) 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((SV*)GvHV(PL_envgv), PERL_MAGIC_env))) { + bool was_tainted = PL_tainted; + char *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 { @@ -66,7 +118,7 @@ Perl_taint_env(pTHX) TAINT; taint_proper("Insecure %s%s", "$ENV{DCL$PATH}"); } - if ((mg = mg_find(*svp, 'e')) && MgTAINTEDDIR(mg)) { + if ((mg = mg_find(*svp, PERL_MAGIC_envelem)) && MgTAINTEDDIR(mg)) { TAINT; taint_proper("Insecure directory in %s%s", "$ENV{DCL$PATH}"); } @@ -81,7 +133,7 @@ Perl_taint_env(pTHX) TAINT; taint_proper("Insecure %s%s", "$ENV{PATH}"); } - if ((mg = mg_find(*svp, 'e')) && MgTAINTEDDIR(mg)) { + if ((mg = mg_find(*svp, PERL_MAGIC_envelem)) && MgTAINTEDDIR(mg)) { TAINT; taint_proper("Insecure directory in %s%s", "$ENV{PATH}"); } @@ -98,7 +150,7 @@ Perl_taint_env(pTHX) 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;