Commit b6038484 authored by Tom Lane's avatar Tom Lane

Fix memory clobber problem reported by John Hansen: plperl_safe_init()

may expand the Perl stack, therefore we must SPAGAIN to reload the local
stack pointer after calling it.  Also a couple other marginal readability
improvements.
parent da1c19aa
...@@ -33,7 +33,7 @@ ...@@ -33,7 +33,7 @@
* ENHANCEMENTS, OR MODIFICATIONS. * ENHANCEMENTS, OR MODIFICATIONS.
* *
* IDENTIFICATION * IDENTIFICATION
* $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.57 2004/11/17 21:23:36 tgl Exp $ * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.58 2004/11/18 21:35:42 tgl Exp $
* *
**********************************************************************/ **********************************************************************/
...@@ -240,7 +240,6 @@ plperl_init_interp(void) ...@@ -240,7 +240,6 @@ plperl_init_interp(void)
* Initialize the proc and query hash tables * Initialize the proc and query hash tables
************************************************************/ ************************************************************/
plperl_proc_hash = newHV(); plperl_proc_hash = newHV();
} }
...@@ -497,10 +496,7 @@ plperl_get_elem(HV *hash, char *key) ...@@ -497,10 +496,7 @@ plperl_get_elem(HV *hash, char *key)
{ {
SV **svp = hv_fetch(hash, key, strlen(key), FALSE); SV **svp = hv_fetch(hash, key, strlen(key), FALSE);
if (!svp) if (!svp)
{
elog(ERROR, "plperl: key '%s' not found", key); elog(ERROR, "plperl: key '%s' not found", key);
return NULL;
}
return SvTYPE(*svp) == SVt_NULL ? NULL : SvPV(*svp, PL_na); return SvTYPE(*svp) == SVt_NULL ? NULL : SvPV(*svp, PL_na);
} }
...@@ -659,7 +655,10 @@ plperl_create_sub(char *s, bool trusted) ...@@ -659,7 +655,10 @@ plperl_create_sub(char *s, bool trusted)
int count; int count;
if (trusted && !plperl_safe_init_done) if (trusted && !plperl_safe_init_done)
{
plperl_safe_init(); plperl_safe_init();
SPAGAIN;
}
ENTER; ENTER;
SAVETMPS; SAVETMPS;
...@@ -759,12 +758,10 @@ plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo) ...@@ -759,12 +758,10 @@ plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo)
PUSHMARK(SP); PUSHMARK(SP);
XPUSHs(sv_2mortal(newSVpv("undef", 0))); XPUSHs(sv_2mortal(newSVpv("undef", 0)));
for (i = 0; i < desc->nargs; i++) for (i = 0; i < desc->nargs; i++)
{
if (desc->arg_is_rowtype[i])
{ {
if (fcinfo->argnull[i]) if (fcinfo->argnull[i])
XPUSHs(&PL_sv_undef); XPUSHs(&PL_sv_undef);
else else if (desc->arg_is_rowtype[i])
{ {
HeapTupleHeader td; HeapTupleHeader td;
Oid tupType; Oid tupType;
...@@ -782,17 +779,10 @@ plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo) ...@@ -782,17 +779,10 @@ plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo)
tmptup.t_len = HeapTupleHeaderGetDatumLength(td); tmptup.t_len = HeapTupleHeaderGetDatumLength(td);
tmptup.t_data = td; tmptup.t_data = td;
/* /* plperl_build_tuple_argument better return a mortal SV */
* plperl_build_tuple_argument better return a mortal SV.
*/
hashref = plperl_build_tuple_argument(&tmptup, tupdesc); hashref = plperl_build_tuple_argument(&tmptup, tupdesc);
XPUSHs(hashref); XPUSHs(hashref);
} }
}
else
{
if (fcinfo->argnull[i])
XPUSHs(&PL_sv_undef);
else else
{ {
char *tmp; char *tmp;
...@@ -805,7 +795,6 @@ plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo) ...@@ -805,7 +795,6 @@ plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo)
pfree(tmp); pfree(tmp);
} }
} }
}
PUTBACK; PUTBACK;
/* Do NOT use G_KEEPERR here */ /* Do NOT use G_KEEPERR here */
...@@ -848,6 +837,7 @@ plperl_call_perl_trigger_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo, S ...@@ -848,6 +837,7 @@ plperl_call_perl_trigger_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo, S
{ {
dSP; dSP;
SV *retval; SV *retval;
Trigger *tg_trigger;
int i; int i;
int count; int count;
...@@ -856,8 +846,9 @@ plperl_call_perl_trigger_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo, S ...@@ -856,8 +846,9 @@ plperl_call_perl_trigger_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo, S
PUSHMARK(sp); PUSHMARK(sp);
XPUSHs(td); XPUSHs(td);
for (i = 0; i < ((TriggerData *) fcinfo->context)->tg_trigger->tgnargs; i++) tg_trigger = ((TriggerData *) fcinfo->context)->tg_trigger;
XPUSHs(sv_2mortal(newSVpv(((TriggerData *) fcinfo->context)->tg_trigger->tgargs[i], 0))); for (i = 0; i < tg_trigger->tgnargs; i++)
XPUSHs(sv_2mortal(newSVpv(tg_trigger->tgargs[i], 0)));
PUTBACK; PUTBACK;
count = perl_call_sv(desc->reference, G_SCALAR | G_EVAL | G_KEEPERR); count = perl_call_sv(desc->reference, G_SCALAR | G_EVAL | G_KEEPERR);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment