Commit dac7a37d authored by Tom Lane's avatar Tom Lane

Use SvROK(sv) rather than directly checking SvTYPE(sv) == SVt_RV in plperl.

The latter is considered unwarranted chumminess with the implementation,
and can lead to crashes with recent Perl versions.

Report and fix by Tim Bunce.  Back-patch to all versions containing the
questionable coding pattern.
parent ff5ab912
/********************************************************************** /**********************************************************************
* plperl.c - perl as a procedural language for PostgreSQL * plperl.c - perl as a procedural language for PostgreSQL
* *
* $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.170 2010/03/09 02:48:33 adunstan Exp $ * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.171 2010/03/09 22:34:38 tgl Exp $
* *
**********************************************************************/ **********************************************************************/
...@@ -976,7 +976,7 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup) ...@@ -976,7 +976,7 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup)
ereport(ERROR, ereport(ERROR,
(errcode(ERRCODE_UNDEFINED_COLUMN), (errcode(ERRCODE_UNDEFINED_COLUMN),
errmsg("$_TD->{new} does not exist"))); errmsg("$_TD->{new} does not exist")));
if (!SvOK(*svp) || SvTYPE(*svp) != SVt_RV || SvTYPE(SvRV(*svp)) != SVt_PVHV) if (!SvOK(*svp) || !SvROK(*svp) || SvTYPE(SvRV(*svp)) != SVt_PVHV)
ereport(ERROR, ereport(ERROR,
(errcode(ERRCODE_DATATYPE_MISMATCH), (errcode(ERRCODE_DATATYPE_MISMATCH),
errmsg("$_TD->{new} is not a hash reference"))); errmsg("$_TD->{new} is not a hash reference")));
...@@ -1549,7 +1549,7 @@ plperl_func_handler(PG_FUNCTION_ARGS) ...@@ -1549,7 +1549,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
* value is an error, except undef which means return an empty set. * value is an error, except undef which means return an empty set.
*/ */
if (SvOK(perlret) && if (SvOK(perlret) &&
SvTYPE(perlret) == SVt_RV && SvROK(perlret) &&
SvTYPE(SvRV(perlret)) == SVt_PVAV) SvTYPE(SvRV(perlret)) == SVt_PVAV)
{ {
int i = 0; int i = 0;
...@@ -1594,7 +1594,7 @@ plperl_func_handler(PG_FUNCTION_ARGS) ...@@ -1594,7 +1594,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
AttInMetadata *attinmeta; AttInMetadata *attinmeta;
HeapTuple tup; HeapTuple tup;
if (!SvOK(perlret) || SvTYPE(perlret) != SVt_RV || if (!SvOK(perlret) || !SvROK(perlret) ||
SvTYPE(SvRV(perlret)) != SVt_PVHV) SvTYPE(SvRV(perlret)) != SVt_PVHV)
{ {
ereport(ERROR, ereport(ERROR,
...@@ -2220,7 +2220,7 @@ plperl_return_next(SV *sv) ...@@ -2220,7 +2220,7 @@ plperl_return_next(SV *sv)
errmsg("cannot use return_next in a non-SETOF function"))); errmsg("cannot use return_next in a non-SETOF function")));
if (prodesc->fn_retistuple && if (prodesc->fn_retistuple &&
!(SvOK(sv) && SvTYPE(sv) == SVt_RV && SvTYPE(SvRV(sv)) == SVt_PVHV)) !(SvOK(sv) && SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVHV))
ereport(ERROR, ereport(ERROR,
(errcode(ERRCODE_DATATYPE_MISMATCH), (errcode(ERRCODE_DATATYPE_MISMATCH),
errmsg("SETOF-composite-returning PL/Perl function " errmsg("SETOF-composite-returning PL/Perl function "
......
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