From: Tom Lane <tgl@sss.pgh.pa.us>
To: pgsql-hackers@lists.postgresql.org
Subject: Residual cleanups for tied objects in PL/Perl
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="----- =_aaaaaaaaaa0"
Content-ID: <569757.1786901883.0@sss.pgh.pa.us>
Date: Sun, 16 Aug 2026 13:38:21 -0400
Message-ID: <569769.1786901901@sss.pgh.pa.us>
Archived-At: 
 <https://www.postgresql.org/message-id/569769.1786901901%40sss.pgh.pa.us>
Precedence: bulk

------- =_aaaaaaaaaa0
Content-Type: text/plain; charset="us-ascii"
Content-ID: <569757.1786901883.1@sss.pgh.pa.us>

The attached patch fixes a null pointer dereference case in
hstore_plperl, and an infinite-loop case in plperl itself.
These were left out of the recent plperl security patch because
they are not security matters according to our current rules;
but they are certainly bugs that ought to be fixed.

The test cases I have that reach these bugs require Perl "Tie"
modules that aren't present in common Perl installations,
so I'm not planning on trying to construct regression test
entries for them.  But I've attached two SQL scripts that
cause failures without the patch.

One interesting point is that Claude Opus, which constructed
these test cases, seemed to think that we ought to be able
to read out the values assigned to the tied array or hash.
But what the repaired code actually produces is SQL NULLs.
AFAICT we are getting Perl "undef" values out of hv_iternext
or av_fetch, so it's hard to see how we could do any better.

I think what is going on here is that the test functions are
failing to install enough infrastructure for the tied object
to produce any output, but maybe someone who knows more Perl
than me can correct that guess.

			regards, tom lane


------- =_aaaaaaaaaa0
Content-Type: text/x-diff;
	name*0="v1-0001-Close-up-some-more-gaps-in-plperl-and-hstore_plpe.p";
	name*1="atch"; charset="us-ascii"
Content-ID: <569757.1786901883.2@sss.pgh.pa.us>
Content-Description: 
 v1-0001-Close-up-some-more-gaps-in-plperl-and-hstore_plpe.patch
Content-Transfer-Encoding: quoted-printable

=46rom 41ffa719335d3d04c4576cfb35935d47954cd779 Mon Sep 17 00:00:00 2001
From: Tom Lane <tgl@sss.pgh.pa.us>
Date: Sun, 16 Aug 2026 13:20:07 -0400
Subject: [PATCH v1] Close up some more gaps in plperl and hstore_plperl.

plperl_to_hstore() failed to check for a null-pointer result from
HeVAL(), leading to SIGSEGV.  This is possible at least with tied
hashes.  Interpret such a result as SQL NULL, as we do elsewhere.

plperl_func_handler()'s stanza for handling an arrayref result in
a SETOF function could loop forever (or at least till OOM) when
given a tied array, since av_fetch won't necessarily ever return
a null pointer in that case.  Be consistent with the other places
where we traverse a perl array: call av_len() once and use that
value as the loop limit, silently ignoring any null pointers we
get back from that range of subscripts.

The known test cases for these errors require perl's Tie modules,
which are often not 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>
Backpatch-through: 14
---
 contrib/hstore_plperl/hstore_plperl.c |  2 +-
 src/pl/plperl/plperl.c                | 11 ++++++-----
 2 files changed, 7 insertions(+), 6 deletions(-)

diff --git a/contrib/hstore_plperl/hstore_plperl.c b/contrib/hstore_plperl=
/hstore_plperl.c
index d7f1b8ddb48..197d84141e5 100644
--- a/contrib/hstore_plperl/hstore_plperl.c
+++ b/contrib/hstore_plperl/hstore_plperl.c
@@ -150,7 +150,7 @@ plperl_to_hstore(PG_FUNCTION_ARGS)
 		pairs[i].keylen =3D hstoreCheckKeyLen(strlen(pairs[i].key));
 		pairs[i].needfree =3D true;
 =

-		if (!SvOK(value))
+		if (!value || !SvOK(value))
 		{
 			pairs[i].val =3D NULL;
 			pairs[i].vallen =3D 0;
diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index eba91f2d7d6..3d4b675762d 100644
--- a/src/pl/plperl/plperl.c
+++ b/src/pl/plperl/plperl.c
@@ -2478,14 +2478,15 @@ plperl_func_handler(PG_FUNCTION_ARGS)
 		if (sav)
 		{
 			dTHX;
-			int			i =3D 0;
-			SV		  **svp =3D 0;
 			AV		   *rav =3D (AV *) SvRV(sav);
+			int			alen =3D av_len(rav) + 1;
 =

-			while ((svp =3D av_fetch(rav, i, FALSE)) !=3D NULL)
+			for (int i =3D 0; i < alen; i++)
 			{
-				plperl_return_next_internal(*svp);
-				i++;
+				SV		  **svp =3D av_fetch(rav, i, FALSE);
+
+				if (svp)
+					plperl_return_next_internal(*svp);
 			}
 		}
 		else if (SvOK(perlret))
-- =

2.52.0


------- =_aaaaaaaaaa0
Content-Type: text/plain; name="test_tied_hstore.sql"; charset="us-ascii"
Content-ID: <569757.1786901883.3@sss.pgh.pa.us>
Content-Description: test_tied_hstore.sql

CREATE EXTENSION plperl;
CREATE EXTENSION hstore;
CREATE EXTENSION hstore_plperl;

CREATE FUNCTION tied_hstore() RETURNS hstore
LANGUAGE plperl TRANSFORM FOR TYPE hstore AS $$
  use Tie::Hash;
  my %h;
  tie %h, 'Tie::StdHash';
  $h{a} = '1';
  $h{b} = '2';
  return \%h;
$$;

SELECT tied_hstore();

------- =_aaaaaaaaaa0
Content-Type: text/plain; name="test_tied_array.sql"; charset="us-ascii"
Content-ID: <569757.1786901883.4@sss.pgh.pa.us>
Content-Description: test_tied_array.sql

CREATE EXTENSION plperlu;

CREATE FUNCTION tied_setof_text() RETURNS SETOF text
LANGUAGE plperlu AS $$
  use Tie::Array;
  my @a;
  tie @a, 'Tie::StdArray';
  @a = ('p', 'q', 'r');
  return \@a;
$$;

SELECT * FROM tied_setof_text();

------- =_aaaaaaaaaa0--