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	       25679    {
    27			#if defined(HAS_SETEUID) && defined(DEBUGGING)
    28			#   if Uid_t_size == 1
    29			    {
    30				const UV  uid = PL_uid;
    31				const UV euid = PL_euid;
    32			
    33				DEBUG_u(PerlIO_printf(Perl_debug_log,
    34						       "%s %d %"UVuf" %"UVuf"\n",
    35						       s, PL_tainted, uid, euid));
    36			    }
    37			#   else
    38			    {
    39	       25679    	const IV  uid = PL_uid;
    40	       25679    	const IV euid = PL_euid;
    41			
    42				DEBUG_u(PerlIO_printf(Perl_debug_log,
    43						       "%s %d %"IVdf" %"IVdf"\n",
    44	       25679    			       s, PL_tainted, uid, euid));
    45			    }
    46			#   endif
    47			#endif
    48			
    49	       25679        if (PL_tainted) {
    50	         269    	const char *ug;
    51			
    52	         269    	if (!f)
    53	         255    	    f = PL_no_security;
    54	         269    	if (PL_euid != PL_uid)
    55	      ######    	    ug = " while running setuid";
    56	         269    	else if (PL_egid != PL_gid)
    57	      ######    	    ug = " while running setgid";
    58	         269    	else if (PL_taint_warn)
    59	          10                ug = " while running with -t switch";
    60			        else
    61	         259    	    ug = " while running with -T switch";
    62	         269    	if (PL_unsafe || PL_taint_warn) {
    63	          13                if(ckWARN(WARN_TAINT))
    64	           8                    Perl_warner(aTHX_ packWARN(WARN_TAINT), f, s, ug);
    65			        }
    66			        else {
    67	         256                Perl_croak(aTHX_ f, s, ug);
    68			        }
    69			    }
    70			}
    71			
    72			void
    73			Perl_taint_env(pTHX)
    74	          39    {
    75	          39        SV** svp;
    76	          39        MAGIC* mg;
    77	          39        const char* const *e;
    78			    static const char* const 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	          39        };
    85			
    86			    /* Don't bother if there's no *ENV glob */
    87	          39        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	          39        if (!GvHV(PL_envgv) || !(SvRMAGICAL(GvHV(PL_envgv))
    92				    && mg_find((SV*)GvHV(PL_envgv), PERL_MAGIC_env))) {
    93	           2    	const bool was_tainted = PL_tainted;
    94	           2    	const char * const name = GvENAME(PL_envgv);
    95	           2    	PL_tainted = TRUE;
    96	           2    	if (strEQ(name,"ENV"))
    97				    /* hash alias */
    98	           1    	    taint_proper("%%ENV is aliased to %s%s", "another variable");
    99				else
   100				    /* glob alias: report it in the error message */
   101	           1    	    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	          37        svp = hv_fetch(GvHVn(PL_envgv),"PATH",4,FALSE);
   131	          37        if (svp && *svp) {
   132	          35    	if (SvTAINTED(*svp)) {
   133	           5    	    TAINT;
   134	           5    	    taint_proper("Insecure %s%s", "$ENV{PATH}");
   135				}
   136	          32    	if ((mg = mg_find(*svp, PERL_MAGIC_envelem)) && MgTAINTEDDIR(mg)) {
   137	           1    	    TAINT;
   138	           1    	    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	          33        svp = hv_fetch(GvHVn(PL_envgv),"TERM",4,FALSE);
   145	          33        if (svp && *svp && SvTAINTED(*svp)) {
   146	           7    	STRLEN len;
   147	           7    	const bool was_tainted = PL_tainted;
   148	           7    	const char *t = SvPV_const(*svp, len);
   149	           7    	const char * const e = t + len;
   150	           7    	PL_tainted = was_tainted;
   151	           7    	if (t < e && isALNUM(*t))
   152	           7    	    t++;
   153	          37    	while (t < e && (isALNUM(*t) || strchr("-_.+", *t)))
   154	          30    	    t++;
   155	           7    	if (t < e) {
   156	           1    	    TAINT;
   157	           1    	    taint_proper("Insecure $ENV{%s}%s", "TERM");
   158				}
   159			    }
   160			#endif /* !VMS */
   161			
   162	         150        for (e = misc_env; *e; e++) {
   163	         122    	SV ** const svp = hv_fetch(GvHVn(PL_envgv), *e, strlen(*e), FALSE);
   164	         122    	if (svp && *svp != &PL_sv_undef && SvTAINTED(*svp)) {
   165	           4    	    TAINT;
   166	           4    	    taint_proper("Insecure $ENV{%s}%s", *e);
   167				}
   168			    }
   169			}
   170			
   171			/*
   172			 * Local variables:
   173			 * c-indentation-style: bsd
   174			 * c-basic-offset: 4
   175			 * indent-tabs-mode: t
   176			 * End:
   177			 *
   178			 * ex: set ts=8 sts=4 sw=4 noet:
   179			 */