STATIC char S_grok_bslash_c(pTHX_ const char source, const bool output_warning) { U8 result; if (! isPRINT_A(source)) { Perl_croak(aTHX_ "%s", "Character following \"\\c\" must be printable ASCII"); } else if (source == '{') { assert(isPRINT_A(toCTRL('{'))); /* diag_listed_as: Use "%s" instead of "%s" */ Perl_croak(aTHX_ "Use \"%c\" instead of \"\\c{\"", toCTRL('{')); } result = toCTRL(source); if (output_warning && isPRINT_A(result)) { U8 clearer[3]; U8 i = 0; if (! isWORDCHAR(result)) { clearer[i++] = '\\'; } clearer[i++] = result; clearer[i++] = '\0'; Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), "\"\\c%c\" is more clearly written simply as \"%s\"", source, clearer); } return result; }
void Perl_taint_env(pTHX) { SV** svp; MAGIC* mg; 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 or 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 = TAINT_get; const char * const name = GvENAME(PL_envgv); TAINT; 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 */ TAINT_set(was_tainted); #ifdef NO_TAINT_SUPPORT PERL_UNUSED_VAR(was_tainted); #endif } #ifdef VMS { int i = 0; char name[10 + TYPE_DIGITS(int)] = "DCL$PATH"; STRLEN len = 8; /* strlen(name) */ while (1) { if (i) 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)) { 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 */ svp = hv_fetchs(GvHVn(PL_envgv),"PATH",FALSE); if (svp && *svp) { if (SvTAINTED(*svp)) { TAINT; taint_proper("Insecure %s%s", "$ENV{PATH}"); } if ((mg = mg_find(*svp, PERL_MAGIC_envelem)) && MgTAINTEDDIR(mg)) { TAINT; taint_proper("Insecure directory in %s%s", "$ENV{PATH}"); } } #ifndef VMS /* tainted $TERM is okay if it contains no metachars */ svp = hv_fetchs(GvHVn(PL_envgv),"TERM",FALSE); if (svp && *svp && SvTAINTED(*svp)) { STRLEN len; const bool was_tainted = TAINT_get; const char *t = SvPV_const(*svp, len); const char * const e = t + len; TAINT_set(was_tainted); #ifdef NO_TAINT_SUPPORT PERL_UNUSED_VAR(was_tainted); #endif if (t < e && isWORDCHAR(*t)) t++; while (t < e && (isWORDCHAR(*t) || strchr("-_.+", *t))) t++; if (t < e) { TAINT; taint_proper("Insecure $ENV{%s}%s", "TERM"); } } #endif /* !VMS */ for (e = misc_env; *e; e++) { SV * const * const svp = hv_fetch(GvHVn(PL_envgv), *e, strlen(*e), FALSE); if (svp && *svp != &PL_sv_undef && SvTAINTED(*svp)) { TAINT; taint_proper("Insecure $ENV{%s}%s", *e); } } }