void unroll_this(pTHX_ OP* op) {
struct sljit_compiler* compiler = sljit_create_compiler();
HV* seenops = newHV();
#ifdef DEBUG
if (getenv("RUNOPS_OPTIMIZED_DEBUG")) {
CV *runcv = Perl_find_runcv(NULL);
sljit_compiler_verbose(compiler, stderr);
DEBUGf(("Unroll %s::%s cv=%p, op=%p (%s)\n", HvNAME_get(CvSTASH(runcv)),
GvENAME(CvGV(runcv)), runcv, op, sljit_get_platform_name()));
}
#endif
sljit_emit_enter(compiler, 0, 2, 1, 0);
unroll_tree(compiler, seenops, op, NULL);
fixup_jumps(compiler, needjumps, labels);
// This is needed for things that drop off the runloop without a
// return, e.g. S_sortcv. TODO: Make conditional?
sljit_emit_return(compiler, SLJIT_MEM, (sljit_w) &PL_op);
op->op_ppaddr = sljit_generate_code(compiler);
op->op_spare = 3;
DEBUGf(("Code at %p\n", op->op_ppaddr));
labels = NULL;
needjumps = NULL;
SvREFCNT_dec(seenops);
sljit_free_compiler(compiler);
}
JSObject*
PJS_NewPerlSub(
pTHX_
JSContext *cx,
JSObject *parent,
SV *cvref
) {
JSObject *newobj = PJS_CreateJSVis(
aTHX_ cx,
JS_NewObject(cx, &perlsub_class, NULL, parent),
cvref
);
if(newobj) {
CV *cv = (CV *)SvRV(cvref);
const char *fname = CvANON(cv) ? "(anonymous)" : GvENAME(CvGV(cv));
JSString *jstr = JS_InternString(cx, fname);
if(!jstr || !JS_DefineProperty(cx, newobj, "name",
STRING_TO_JSVAL(jstr),
NULL, NULL,
JSPROP_READONLY | JSPROP_PERMANENT)
) {
PJS_unrootJSVis(cx, newobj);
newobj = NULL;
}
}
return newobj;
}
STATIC const char *
_sub_name( pTHX ) {
const CV *const cv = _curcv( aTHX );
if ( cv ) {
const GV *const gv = CvGV( cv );
if ( gv ) {
return GvENAME( gv );
}
}
return NULL;
}
void
Perl_taint_env(pTHX)
{
SV** svp;
MAGIC* mg;
char** e;
static char* 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
};
/* 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
{
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 */
svp = hv_fetch(GvHVn(PL_envgv),"PATH",4,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_fetch(GvHVn(PL_envgv),"TERM",4,FALSE);
if (svp && *svp && SvTAINTED(*svp)) {
STRLEN n_a;
bool was_tainted = PL_tainted;
char *t = SvPV(*svp, n_a);
char *e = t + n_a;
PL_tainted = was_tainted;
if (t < e && isALNUM(*t))
t++;
while (t < e && (isALNUM(*t) || strchr("-_.+", *t)))
t++;
if (t < e) {
TAINT;
taint_proper("Insecure $ENV{%s}%s", "TERM");
}
}
#endif /* !VMS */
for (e = misc_env; *e; e++) {
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);
}
}
}
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);
}
}
}
