postgres.git / summary / log / commit / refs
commit aecc864821ad868618166d06f1bbdd892a73e19d
Author: Tom Lane <tgl@sss.pgh.pa.us>
Date: Tue Aug 18 21:33:44 2026 +0000
Defend against null "SV *" pointers in plperl modules.
Tied hashes, and probably tied arrays, are capable of returning Perl
value pointers that are actually NULL, not the usual pointer to an
undef SV. We were not defending against that everywhere, leading
to possible SIGSEGV. Fix the code to consistently treat a null
pointer returned from hv_iternext or av_fetch like a !SvOK one.
(Note that the large diff in SV_to_JsonbValue is actually quite
trivial, but it required reindenting a chunk of existing code.)
Claude Code found the instance in hstore_plperl, and I found the
others by code auditing. Perhaps the other instances aren't
actually reachable, but I see little reason to assume that.
The known test cases for these errors require perl's Tie modules,
which may not be present, so it doesn't seem worth the trouble
to create regression test cases that would cover them.
Reported-by: Claude Code (via Noah Misch)
Author: Tom Lane <tgl@sss.pgh.pa.us>
Discussion: https://postgr.es/m/569769.1786901901@sss.pgh.pa.us
Backpatch-through: 14
contrib/hstore_plperl/hstore_plperl.c | 2 +-
contrib/jsonb_plperl/jsonb_plperl.c | 155 ++++++++++++++++++----------------
src/pl/plperl/plperl.c | 2 +-
3 files changed, 83 insertions(+), 76 deletions(-)
diff --git a/contrib/hstore_plperl/hstore_plperl.c b/contrib/hstore_plperl/hstore_plperl.c
index 2a0c5000808..b56fc8c039c 100644
--- a/contrib/hstore_plperl/hstore_plperl.c
+++ b/contrib/hstore_plperl/hstore_plperl.c
@@ -149,7 +149,7 @@ plperl_to_hstore(PG_FUNCTION_ARGS)
pairs[i].keylen = hstoreCheckKeyLen(strlen(pairs[i].key));
pairs[i].needfree = true;
- if (!SvOK(value))
+ if (!value || !SvOK(value))
{
pairs[i].val = NULL;
pairs[i].vallen = 0;
diff --git a/contrib/jsonb_plperl/jsonb_plperl.c b/contrib/jsonb_plperl/jsonb_plperl.c
index 968ca30bd21..ca443c1a3c7 100644
--- a/contrib/jsonb_plperl/jsonb_plperl.c
+++ b/contrib/jsonb_plperl/jsonb_plperl.c
@@ -184,7 +184,7 @@ SV_to_JsonbValue(SV *in, JsonbParseState **jsonb_state, bool is_elem)
check_stack_depth();
/* Dereference references recursively. */
- while (SvROK(in))
+ while (in && SvROK(in))
{
/*
* It's possible for circular references to make this an infinite
@@ -195,84 +195,91 @@ SV_to_JsonbValue(SV *in, JsonbParseState **jsonb_state, bool is_elem)
in = SvRV(in);
}
- switch (SvTYPE(in))
+ if (!in)
{
- case SVt_PVAV:
- return AV_to_JsonbValue((AV *) in, jsonb_state);
+ out.type = jbvNull;
+ }
+ else
+ {
+ switch (SvTYPE(in))
+ {
+ case SVt_PVAV:
+ return AV_to_JsonbValue((AV *) in, jsonb_state);
- case SVt_PVHV:
- return HV_to_JsonbValue((HV *) in, jsonb_state);
+ case SVt_PVHV:
+ return HV_to_JsonbValue((HV *) in, jsonb_state);
- default:
- if (!SvOK(in))
- {
- out.type = jbvNull;
- }
- else if (SvUOK(in))
- {
- /*
- * If UV is >=64 bits, we have no better way to make this
- * happen than converting to text and back. Given the low
- * usage of UV in Perl code, it's not clear it's worth working
- * hard to provide alternate code paths.
- */
- const char *strval = SvPV_nolen(in);
-
- out.type = jbvNumeric;
- out.val.numeric =
- DatumGetNumeric(DirectFunctionCall3(numeric_in,
- CStringGetDatum(strval),
- ObjectIdGetDatum(InvalidOid),
- Int32GetDatum(-1)));
- }
- else if (SvIOK(in))
- {
- IV ival = SvIV(in);
+ default:
+ if (!SvOK(in))
+ {
+ out.type = jbvNull;
+ }
+ else if (SvUOK(in))
+ {
+ /*
+ * If UV is >=64 bits, we have no better way to make this
+ * happen than converting to text and back. Given the low
+ * usage of UV in Perl code, it's not clear it's worth
+ * working hard to provide alternate code paths.
+ */
+ const char *strval = SvPV_nolen(in);
+
+ out.type = jbvNumeric;
+ out.val.numeric =
+ DatumGetNumeric(DirectFunctionCall3(numeric_in,
+ CStringGetDatum(strval),
+ ObjectIdGetDatum(InvalidOid),
+ Int32GetDatum(-1)));
+ }
+ else if (SvIOK(in))
+ {
+ IV ival = SvIV(in);
- out.type = jbvNumeric;
- out.val.numeric = int64_to_numeric(ival);
- }
- else if (SvNOK(in))
- {
- double nval = SvNV(in);
-
- /*
- * jsonb doesn't allow infinity or NaN (per JSON
- * specification), but the numeric type that is used for the
- * storage accepts those, so we have to reject them here
- * explicitly.
- */
- if (isinf(nval))
- ereport(ERROR,
- (errcode(ERRCODE_NUMERIC_VALUE_OUT_OF_RANGE),
- errmsg("cannot convert infinity to jsonb")));
- if (isnan(nval))
+ out.type = jbvNumeric;
+ out.val.numeric = int64_to_numeric(ival);
+ }
+ else if (SvNOK(in))
+ {
+ double nval = SvNV(in);
+
+ /*
+ * jsonb doesn't allow infinity or NaN (per JSON
+ * specification), but the numeric type that is used for
+ * the storage accepts those, so we have to reject them
+ * here explicitly.
+ */
+ if (isinf(nval))
+ ereport(ERROR,
+ (errcode(ERRCODE_NUMERIC_VALUE_OUT_OF_RANGE),
+ errmsg("cannot convert infinity to jsonb")));
+ if (isnan(nval))
+ ereport(ERROR,
+ (errcode(ERRCODE_NUMERIC_VALUE_OUT_OF_RANGE),
+ errmsg("cannot convert NaN to jsonb")));
+
+ out.type = jbvNumeric;
+ out.val.numeric =
+ DatumGetNumeric(DirectFunctionCall1(float8_numeric,
+ Float8GetDatum(nval)));
+ }
+ else if (SvPOK(in))
+ {
+ out.type = jbvString;
+ out.val.string.val = sv2cstr(in);
+ out.val.string.len = strlen(out.val.string.val);
+ }
+ else
+ {
+ /*
+ * XXX It might be nice if we could include the Perl type
+ * in the error message.
+ */
ereport(ERROR,
- (errcode(ERRCODE_NUMERIC_VALUE_OUT_OF_RANGE),
- errmsg("cannot convert NaN to jsonb")));
-
- out.type = jbvNumeric;
- out.val.numeric =
- DatumGetNumeric(DirectFunctionCall1(float8_numeric,
- Float8GetDatum(nval)));
- }
- else if (SvPOK(in))
- {
- out.type = jbvString;
- out.val.string.val = sv2cstr(in);
- out.val.string.len = strlen(out.val.string.val);
- }
- else
- {
- /*
- * XXX It might be nice if we could include the Perl type in
- * the error message.
- */
- ereport(ERROR,
- (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
- errmsg("cannot transform this Perl type to jsonb")));
- return NULL;
- }
+ (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
+ errmsg("cannot transform this Perl type to jsonb")));
+ return NULL;
+ }
+ }
}
/* Push result into 'jsonb_state' unless it is a raw scalar. */
diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index 1cd69d544a8..043c97a3d81 100644
--- a/src/pl/plperl/plperl.c
+++ b/src/pl/plperl/plperl.c
@@ -1143,7 +1143,7 @@ get_perl_array_ref(SV *sv)
{
dTHX;
- if (SvOK(sv) && SvROK(sv))
+ if (sv && SvOK(sv) && SvROK(sv))
{
if (SvTYPE(SvRV(sv)) == SVt_PVAV)
return sv;
[parent: 38e933fafac4]