Tighten array dimensionality checks in Perl -> SQL array conversion.

plperl_array_to_datum() wasn't sufficiently careful about checking
that nested lists represent a rectangular array structure; it would
accept inputs such as "[1, []]".  This is a bit related to the
PL/Python bug fixed in commit 81eaaf65e, but it doesn't seem to
provide any direct route to a memory stomp.  Instead the likely
failure mode is for makeMdArrayResult to be passed fewer Datums than
the claimed array dimensionality requires, possibly leading to a wild
pointer dereference and SIGSEGV.

Per report from Alexander Lakhin.  It's been broken for a long
time, so back-patch to all supported branches.

Discussion: https://postgr.es/m/5ebae5e4-d401-fadf-8585-ac3eaf53219c@gmail.com

1 files changed, 37 insertions, 0 deletions

diff --git a/src/pl/plperl/sql/plperl_array.sql b/src/pl/plperl/sql/plperl_array.sql
index 66179294ce8..ca63b5db625 100644
--- a/src/pl/plperl/sql/plperl_array.sql
+++ b/src/pl/plperl/sql/plperl_array.sql
@@ -159,6 +159,43 @@ $$ LANGUAGE plperl;
 
 select plperl_arrays_inout_l('{{1}, {2}, {3}}');
 
+-- check output of multi-dimensional arrays
+CREATE FUNCTION plperl_md_array_out() RETURNS text[] AS $$
+	return [['a'], ['b'], ['c']];
+$$ LANGUAGE plperl;
+
+select plperl_md_array_out();
+
+CREATE OR REPLACE FUNCTION plperl_md_array_out() RETURNS text[] AS $$
+	return [[], []];
+$$ LANGUAGE plperl;
+
+select plperl_md_array_out();
+
+CREATE OR REPLACE FUNCTION plperl_md_array_out() RETURNS text[] AS $$
+	return [[], [1]];
+$$ LANGUAGE plperl;
+
+select plperl_md_array_out();  -- fail
+
+CREATE OR REPLACE FUNCTION plperl_md_array_out() RETURNS text[] AS $$
+	return [[], 1];
+$$ LANGUAGE plperl;
+
+select plperl_md_array_out();  -- fail
+
+CREATE OR REPLACE FUNCTION plperl_md_array_out() RETURNS text[] AS $$
+	return [1, []];
+$$ LANGUAGE plperl;
+
+select plperl_md_array_out();  -- fail
+
+CREATE OR REPLACE FUNCTION plperl_md_array_out() RETURNS text[] AS $$
+	return [[1], [[]]];
+$$ LANGUAGE plperl;
+
+select plperl_md_array_out();  -- fail
+
 -- make sure setof works
 create or replace function perl_setof_array(integer[]) returns setof integer[] language plperl as $$
 	my $arr = shift;