LXR perl/taint.c

   1/*    taint.c
   2 *
   3 *    Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001,
   4 *    2002, 2003, 2004, 2005, 2006, 2007, 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
  24void
  25Perl_taint_proper(pTHX_ const char *f, const char *s)
  26{
  27#if defined(HAS_SETEUID) && defined(DEBUGGING)
  28    dVAR;
  29#   if Uid_t_size == 1
  30    {
  31        const UV  uid = PL_uid;
  32        const UV euid = PL_euid;
  33
  34        DEBUG_u(PerlIO_printf(Perl_debug_log,
  35                               "%s %d %"UVuf" %"UVuf"\n",
  36                               s, PL_tainted, uid, euid));
  37    }
  38#   else
  39    {
  40        const IV  uid = PL_uid;
  41        const IV euid = PL_euid;
  42
  43        DEBUG_u(PerlIO_printf(Perl_debug_log,
  44                               "%s %d %"IVdf" %"IVdf"\n",
  45                               s, PL_tainted, uid, euid));
  46    }
  47#   endif
  48#endif
  49
  50    if (PL_tainted) {
  51        const char *ug;
  52
  53        if (!f)
  54            f = PL_no_security;
  55        if (PL_euid != PL_uid)
  56            ug = " while running setuid";
  57        else if (PL_egid != PL_gid)
  58            ug = " while running setgid";
  59        else if (PL_taint_warn)
  60            ug = " while running with -t switch";
  61        else
  62            ug = " while running with -T switch";
  63        if (PL_unsafe || PL_taint_warn) {
  64            if(ckWARN_d(WARN_TAINT))
  65                Perl_warner(aTHX_ packWARN(WARN_TAINT), f, s, ug);
  66        }
  67        else {
  68            Perl_croak(aTHX_ f, s, ug);
  69        }
  70    }
  71}
  72
  73void
  74Perl_taint_env(pTHX)
  75{
  76    dVAR;
  77    SV** svp;
  78    MAGIC* mg;
  79    const char* const *e;
  80    static const char* const misc_env[] = {
  81        "IFS",          /* most shells' inter-field separators */
  82        "CDPATH",       /* ksh dain bramage #1 */
  83        "ENV",          /* ksh dain bramage #2 */
  84        "BASH_ENV",     /* bash dain bramage -- I guess it's contagious */
  85#ifdef WIN32
  86        "PERL5SHELL",   /* used for system() on Windows */
  87#endif
  88        NULL
  89    };
  90
  91    /* Don't bother if there's no *ENV glob */
  92    if (!PL_envgv)
  93        return;
  94    /* If there's no %ENV hash of if it's not magical, croak, because
  95     * it probably doesn't reflect the actual environment */
  96    if (!GvHV(PL_envgv) || !(SvRMAGICAL(GvHV(PL_envgv))
  97            && mg_find((SV*)GvHV(PL_envgv), PERL_MAGIC_env))) {
  98        const bool was_tainted = PL_tainted;
  99        const char * const name = GvENAME(PL_envgv);
 100        PL_tainted = TRUE;
 101        if (strEQ(name,"ENV"))
 102            /* hash alias */
 103            taint_proper("%%ENV is aliased to %s%s", "another variable");
 104        else
 105            /* glob alias: report it in the error message */
 106            taint_proper("%%ENV is aliased to %%%s%s", name);
 107        /* this statement is reached under -t or -U */
 108        PL_tainted = was_tainted;
 109    }
 110
 111#ifdef VMS
 112    {
 113    int i = 0;
 114    char name[10 + TYPE_DIGITS(int)] = "DCL$PATH";
 115    STRLEN len = 8; /* strlen(name)  */
 116
 117    while (1) {
 118        if (i)
 119            len = my_sprintf(name,"DCL$PATH;%d", i);
 120        svp = hv_fetch(GvHVn(PL_envgv), name, len, FALSE);
 121        if (!svp || *svp == &PL_sv_undef)
 122            break;
 123        if (SvTAINTED(*svp)) {
 124            TAINT;
 125            taint_proper("Insecure %s%s", "$ENV{DCL$PATH}");
 126        }
 127        if ((mg = mg_find(*svp, PERL_MAGIC_envelem)) && MgTAINTEDDIR(mg)) {
 128            TAINT;
 129            taint_proper("Insecure directory in %s%s", "$ENV{DCL$PATH}");
 130        }
 131        i++;
 132    }
 133  }
 134#endif /* VMS */
 135
 136    svp = hv_fetchs(GvHVn(PL_envgv),"PATH",FALSE);
 137    if (svp && *svp) {
 138        if (SvTAINTED(*svp)) {
 139            TAINT;
 140            taint_proper("Insecure %s%s", "$ENV{PATH}");
 141        }
 142        if ((mg = mg_find(*svp, PERL_MAGIC_envelem)) && MgTAINTEDDIR(mg)) {
 143            TAINT;
 144            taint_proper("Insecure directory in %s%s", "$ENV{PATH}");
 145        }
 146    }
 147
 148#ifndef VMS
 149    /* tainted $TERM is okay if it contains no metachars */
 150    svp = hv_fetchs(GvHVn(PL_envgv),"TERM",FALSE);
 151    if (svp && *svp && SvTAINTED(*svp)) {
 152        STRLEN len;
 153        const bool was_tainted = PL_tainted;
 154        const char *t = SvPV_const(*svp, len);
 155        const char * const e = t + len;
 156        PL_tainted = was_tainted;
 157        if (t < e && isALNUM(*t))
 158            t++;
 159        while (t < e && (isALNUM(*t) || strchr("-_.+", *t)))
 160            t++;
 161        if (t < e) {
 162            TAINT;
 163            taint_proper("Insecure $ENV{%s}%s", "TERM");
 164        }
 165    }
 166#endif /* !VMS */
 167
 168    for (e = misc_env; *e; e++) {
 169        SV * const * const svp = hv_fetch(GvHVn(PL_envgv), *e, strlen(*e), FALSE);
 170        if (svp && *svp != &PL_sv_undef && SvTAINTED(*svp)) {
 171            TAINT;
 172            taint_proper("Insecure $ENV{%s}%s", *e);
 173        }
 174    }
 175}
 176
 177/*
 178 * Local variables:
 179 * c-indentation-style: bsd
 180 * c-basic-offset: 4
 181 * indent-tabs-mode: t
 182 * End:
 183 *
 184 * ex: set ts=8 sts=4 sw=4 noet:
 185 */
 186