From: Tom Lane <tgl@sss.pgh.pa.us>
Date: Mon, 18 Jun 2018 19:55:06 +0000 (-0400)
Subject: Fix contrib/hstore_plperl to look through scalar refs.
X-Git-Tag: REL9_5_14~51
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=645929c545efd06805eda9c9cce5701983915c7f;p=thirdparty%2Fpostgresql.git

Fix contrib/hstore_plperl to look through scalar refs.

Bring this transform function into sync with the policy established
by commit 3a382983d.

Also, fix it to make sure that what it drills down to is indeed a
hash, and not some other kind of Perl SV.  Previously, the test
cases added here provoked crashes.

Because of the crash hazard, back-patch to 9.5 where this module
was introduced.

Discussion: https://postgr.es/m/28336.1528393969@sss.pgh.pa.us
---

diff --git a/contrib/hstore_plperl/expected/hstore_plperl.out b/contrib/hstore_plperl/expected/hstore_plperl.out
index cf384eba647..83556680b47 100644
--- a/contrib/hstore_plperl/expected/hstore_plperl.out
+++ b/contrib/hstore_plperl/expected/hstore_plperl.out
@@ -41,6 +41,25 @@ SELECT test2arr();
  {"\"a\"=>\"1\", \"b\"=>\"boo\", \"c\"=>NULL","\"d\"=>\"2\""}
 (1 row)
 
+-- check error cases
+CREATE OR REPLACE FUNCTION test2() RETURNS hstore
+LANGUAGE plperl
+TRANSFORM FOR TYPE hstore
+AS $$
+return 42;
+$$;
+SELECT test2();
+ERROR:  cannot transform non-hash Perl value to hstore
+CONTEXT:  PL/Perl function "test2"
+CREATE OR REPLACE FUNCTION test2() RETURNS hstore
+LANGUAGE plperl
+TRANSFORM FOR TYPE hstore
+AS $$
+return [1, 2];
+$$;
+SELECT test2();
+ERROR:  cannot transform non-hash Perl value to hstore
+CONTEXT:  PL/Perl function "test2"
 DROP FUNCTION test2();
 DROP FUNCTION test2arr();
 DROP EXTENSION hstore_plperl;
diff --git a/contrib/hstore_plperl/hstore_plperl.c b/contrib/hstore_plperl/hstore_plperl.c
index e5303b3b92a..7983426f49b 100644
--- a/contrib/hstore_plperl/hstore_plperl.c
+++ b/contrib/hstore_plperl/hstore_plperl.c
@@ -47,7 +47,8 @@ Datum
 plperl_to_hstore(PG_FUNCTION_ARGS)
 {
 	dTHX;
-	HV		   *hv = (HV *) SvRV((SV *) PG_GETARG_POINTER(0));
+	SV		   *in = (SV *) PG_GETARG_POINTER(0);
+	HV		   *hv;
 	HE		   *he;
 	int32		buflen;
 	int32		i;
@@ -55,6 +56,17 @@ plperl_to_hstore(PG_FUNCTION_ARGS)
 	HStore	   *out;
 	Pairs	   *pairs;
 
+	/* Dereference references recursively. */
+	while (SvROK(in))
+		in = SvRV(in);
+
+	/* Now we must have a hash. */
+	if (SvTYPE(in) != SVt_PVHV)
+		ereport(ERROR,
+				(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
+				 (errmsg("cannot transform non-hash Perl value to hstore"))));
+	hv = (HV *) in;
+
 	pcount = hv_iterinit(hv);
 
 	pairs = palloc(pcount * sizeof(Pairs));
diff --git a/contrib/hstore_plperl/sql/hstore_plperl.sql b/contrib/hstore_plperl/sql/hstore_plperl.sql
index 0f70f149f50..8853f4ab6a6 100644
--- a/contrib/hstore_plperl/sql/hstore_plperl.sql
+++ b/contrib/hstore_plperl/sql/hstore_plperl.sql
@@ -33,6 +33,25 @@ $$;
 
 SELECT test2arr();
 
+-- check error cases
+CREATE OR REPLACE FUNCTION test2() RETURNS hstore
+LANGUAGE plperl
+TRANSFORM FOR TYPE hstore
+AS $$
+return 42;
+$$;
+
+SELECT test2();
+
+CREATE OR REPLACE FUNCTION test2() RETURNS hstore
+LANGUAGE plperl
+TRANSFORM FOR TYPE hstore
+AS $$
+return [1, 2];
+$$;
+
+SELECT test2();
+
 
 DROP FUNCTION test2();
 DROP FUNCTION test2arr();