/*    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"
		
		void
		Perl_taint_proper(pTHX_ const char *f, const char *s)
       25679    {
		#if defined(HAS_SETEUID) && defined(DEBUGGING)
		#   if Uid_t_size == 1
		    {
			const UV  uid = PL_uid;
			const UV euid = PL_euid;
		
			DEBUG_u(PerlIO_printf(Perl_debug_log,
					       "%s %d %"UVuf" %"UVuf"\n",
					       s, PL_tainted, uid, euid));
		    }
		#   else
		    {
       25679    	const IV  uid = PL_uid;
       25679    	const IV euid = PL_euid;
		
			DEBUG_u(PerlIO_printf(Perl_debug_log,
					       "%s %d %"IVdf" %"IVdf"\n",
       25679    			       s, PL_tainted, uid, euid));
		    }
		#   endif
		#endif
		
       25679        if (PL_tainted) {
         269    	const char *ug;
		
         269    	if (!f)
         255    	    f = PL_no_security;
         269    	if (PL_euid != PL_uid)
      ######    	    ug = " while running setuid";
         269    	else if (PL_egid != PL_gid)
      ######    	    ug = " while running setgid";
         269    	else if (PL_taint_warn)
          10                ug = " while running with -t switch";
		        else
         259    	    ug = " while running with -T switch";
         269    	if (PL_unsafe || PL_taint_warn) {
          13                if(ckWARN(WARN_TAINT))
           8                    Perl_warner(aTHX_ packWARN(WARN_TAINT), f, s, ug);
		        }
		        else {
         256                Perl_croak(aTHX_ f, s, ug);
		        }
		    }
		}
		
		void
		Perl_taint_env(pTHX)
          39    {
          39        SV** svp;
          39        MAGIC* mg;
          39        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 */
			NULL
          39        };
		
		    /* Don't bother if there's no *ENV glob */
          39        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 */
          39        if (!GvHV(PL_envgv) || !(SvRMAGICAL(GvHV(PL_envgv))
			    && mg_find((SV*)GvHV(PL_envgv), PERL_MAGIC_env))) {
           2    	const bool was_tainted = PL_tainted;
           2    	const char * const name = GvENAME(PL_envgv);
           2    	PL_tainted = TRUE;
           2    	if (strEQ(name,"ENV"))
			    /* hash alias */
           1    	    taint_proper("%%ENV is aliased to %s%s", "another variable");
			else
			    /* glob alias: report it in the error message */
           1    	    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";
		
		    while (1) {
			if (i)
			    (void)sprintf(name,"DCL$PATH;%d", i);
			svp = hv_fetch(GvHVn(PL_envgv), name, strlen(name), FALSE);
			if (!svp || *svp == &PL_sv_undef)
			    break;
			if (SvTAINTED(*svp)) {
			    TAINT;
			    taint_proper("Insecure %s%s", "$ENV{DCL$PATH}");
			}
			if ((mg = mg_find(*svp, PERL_MAGIC_envelem)) && MgTAINTEDDIR(mg)) {
			    TAINT;
			    taint_proper("Insecure directory in %s%s", "$ENV{DCL$PATH}");
			}
			i++;
		    }
		  }
		#endif /* VMS */
		
          37        svp = hv_fetch(GvHVn(PL_envgv),"PATH",4,FALSE);
          37        if (svp && *svp) {
          35    	if (SvTAINTED(*svp)) {
           5    	    TAINT;
           5    	    taint_proper("Insecure %s%s", "$ENV{PATH}");
			}
          32    	if ((mg = mg_find(*svp, PERL_MAGIC_envelem)) && MgTAINTEDDIR(mg)) {
           1    	    TAINT;
           1    	    taint_proper("Insecure directory in %s%s", "$ENV{PATH}");
			}
		    }
		
		#ifndef VMS
		    /* tainted $TERM is okay if it contains no metachars */
          33        svp = hv_fetch(GvHVn(PL_envgv),"TERM",4,FALSE);
          33        if (svp && *svp && SvTAINTED(*svp)) {
           7    	STRLEN len;
           7    	const bool was_tainted = PL_tainted;
           7    	const char *t = SvPV_const(*svp, len);
           7    	const char * const e = t + len;
           7    	PL_tainted = was_tainted;
           7    	if (t < e && isALNUM(*t))
           7    	    t++;
          37    	while (t < e && (isALNUM(*t) || strchr("-_.+", *t)))
          30    	    t++;
           7    	if (t < e) {
           1    	    TAINT;
           1    	    taint_proper("Insecure $ENV{%s}%s", "TERM");
			}
		    }
		#endif /* !VMS */
		
         150        for (e = misc_env; *e; e++) {
         122    	SV ** const svp = hv_fetch(GvHVn(PL_envgv), *e, strlen(*e), FALSE);
         122    	if (svp && *svp != &PL_sv_undef && SvTAINTED(*svp)) {
           4    	    TAINT;
           4    	    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:
		 */