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

diff --git a/src/pl/plperl/expected/plperl_array.out b/src/pl/plperl/expected/plperl_array.out
index 6347b5211d27f8cedbec5b8cfc59be6c30eedcca..bd04a062fb9de4cb293c09972142eaf3ec282b4a 100644 (file)
--- a/src/pl/plperl/expected/plperl_array.out
+++ b/src/pl/plperl/expected/plperl_array.out
@@ -215,6 +215,49 @@ select plperl_arrays_inout_l('{{1}, {2}, {3}}');
  {{1},{2},{3}}
 (1 row)
 
+-- 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();
+ plperl_md_array_out 
+---------------------
+ {{a},{b},{c}}
+(1 row)
+
+CREATE OR REPLACE FUNCTION plperl_md_array_out() RETURNS text[] AS $$
+       return [[], []];
+$$ LANGUAGE plperl;
+select plperl_md_array_out();
+ plperl_md_array_out 
+---------------------
+ {}
+(1 row)
+
+CREATE OR REPLACE FUNCTION plperl_md_array_out() RETURNS text[] AS $$
+       return [[], [1]];
+$$ LANGUAGE plperl;
+select plperl_md_array_out();  -- fail
+ERROR:  multidimensional arrays must have array expressions with matching dimensions
+CONTEXT:  PL/Perl function "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
+ERROR:  multidimensional arrays must have array expressions with matching dimensions
+CONTEXT:  PL/Perl function "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
+ERROR:  multidimensional arrays must have array expressions with matching dimensions
+CONTEXT:  PL/Perl function "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
+ERROR:  multidimensional arrays must have array expressions with matching dimensions
+CONTEXT:  PL/Perl function "plperl_md_array_out"
 -- make sure setof works
 create or replace function perl_setof_array(integer[]) returns setof integer[] language plperl as $$
        my $arr = shift;

diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index d7d9c1bee3726e5380643028e7da922d50aef980..02b89ac5f76d75f1961e5ad6f8e3793ed5cc96c8 100644 (file)
--- a/src/pl/plperl/plperl.c
+++ b/src/pl/plperl/plperl.c
@@ -272,9 +272,9 @@ static Datum plperl_sv_to_datum(SV *sv, Oid typid, int32 typmod,
                                                                bool *isnull);
 static void _sv_to_datum_finfo(Oid typid, FmgrInfo *finfo, Oid *typioparam);
 static Datum plperl_array_to_datum(SV *src, Oid typid, int32 typmod);
-static void array_to_datum_internal(AV *av, ArrayBuildState *astate,
+static void array_to_datum_internal(AV *av, ArrayBuildState **astatep,
                                                                        int *ndims, int *dims, int cur_depth,
-                                                                       Oid arraytypid, Oid elemtypid, int32 typmod,
+                                                                       Oid elemtypid, int32 typmod,
                                                                        FmgrInfo *finfo, Oid typioparam);
 static Datum plperl_hash_to_datum(SV *src, TupleDesc td);
 
@@ -1160,11 +1160,16 @@ get_perl_array_ref(SV *sv)
 
 /*
  * helper function for plperl_array_to_datum, recurses for multi-D arrays
+ *
+ * The ArrayBuildState is created only when we first find a scalar element;
+ * if we didn't do it like that, we'd need some other convention for knowing
+ * whether we'd already found any scalars (and thus the number of dimensions
+ * is frozen).
  */
 static void
-array_to_datum_internal(AV *av, ArrayBuildState *astate,
+array_to_datum_internal(AV *av, ArrayBuildState **astatep,
                                                int *ndims, int *dims, int cur_depth,
-                                               Oid arraytypid, Oid elemtypid, int32 typmod,
+                                               Oid elemtypid, int32 typmod,
                                                FmgrInfo *finfo, Oid typioparam)
 {
        dTHX;
@@ -1184,28 +1189,34 @@ array_to_datum_internal(AV *av, ArrayBuildState *astate,
                {
                        AV                 *nav = (AV *) SvRV(sav);
 
-                       /* dimensionality checks */
-                       if (cur_depth + 1 > MAXDIM)
-                               ereport(ERROR,
-                                               (errcode(ERRCODE_PROGRAM_LIMIT_EXCEEDED),
-                                                errmsg("number of array dimensions (%d) exceeds the maximum allowed (%d)",
-                                                               cur_depth + 1, MAXDIM)));
-
                        /* set size when at first element in this level, else compare */
                        if (i == 0 && *ndims == cur_depth)
                        {
+                               /* array after some scalars at same level? */
+                               if (*astatep != NULL)
+                                       ereport(ERROR,
+                                                       (errcode(ERRCODE_INVALID_TEXT_REPRESENTATION),
+                                                        errmsg("multidimensional arrays must have array expressions with matching dimensions")));
+                               /* too many dimensions? */
+                               if (cur_depth + 1 > MAXDIM)
+                                       ereport(ERROR,
+                                                       (errcode(ERRCODE_PROGRAM_LIMIT_EXCEEDED),
+                                                        errmsg("number of array dimensions (%d) exceeds the maximum allowed (%d)",
+                                                                       cur_depth + 1, MAXDIM)));
+                               /* OK, add a dimension */
                                dims[*ndims] = av_len(nav) + 1;
                                (*ndims)++;
                        }
-                       else if (av_len(nav) + 1 != dims[cur_depth])
+                       else if (cur_depth >= *ndims ||
+                                        av_len(nav) + 1 != dims[cur_depth])
                                ereport(ERROR,
                                                (errcode(ERRCODE_INVALID_TEXT_REPRESENTATION),
                                                 errmsg("multidimensional arrays must have array expressions with matching dimensions")));
 
                        /* recurse to fetch elements of this sub-array */
-                       array_to_datum_internal(nav, astate,
+                       array_to_datum_internal(nav, astatep,
                                                                        ndims, dims, cur_depth + 1,
-                                                                       arraytypid, elemtypid, typmod,
+                                                                       elemtypid, typmod,
                                                                        finfo, typioparam);
                }
                else
@@ -1227,7 +1238,13 @@ array_to_datum_internal(AV *av, ArrayBuildState *astate,
                                                                         typioparam,
                                                                         &isnull);
 
-                       (void) accumArrayResult(astate, dat, isnull,
+                       /* Create ArrayBuildState if we didn't already */
+                       if (*astatep == NULL)
+                               *astatep = initArrayResult(elemtypid,
+                                                                                  CurrentMemoryContext, true);
+
+                       /* ... and save the element value in it */
+                       (void) accumArrayResult(*astatep, dat, isnull,
                                                                        elemtypid, CurrentMemoryContext);
                }
        }
@@ -1240,7 +1257,8 @@ static Datum
 plperl_array_to_datum(SV *src, Oid typid, int32 typmod)
 {
        dTHX;
-       ArrayBuildState *astate;
+       AV                 *nav = (AV *) SvRV(src);
+       ArrayBuildState *astate = NULL;
        Oid                     elemtypid;
        FmgrInfo        finfo;
        Oid                     typioparam;
@@ -1256,21 +1274,19 @@ plperl_array_to_datum(SV *src, Oid typid, int32 typmod)
                                 errmsg("cannot convert Perl array to non-array type %s",
                                                format_type_be(typid))));
 
-       astate = initArrayResult(elemtypid, CurrentMemoryContext, true);
-
        _sv_to_datum_finfo(elemtypid, &finfo, &typioparam);
 
        memset(dims, 0, sizeof(dims));
-       dims[0] = av_len((AV *) SvRV(src)) + 1;
+       dims[0] = av_len(nav) + 1;
 
-       array_to_datum_internal((AV *) SvRV(src), astate,
+       array_to_datum_internal(nav, &astate,
                                                        &ndims, dims, 1,
-                                                       typid, elemtypid, typmod,
+                                                       elemtypid, typmod,
                                                        &finfo, typioparam);
 
        /* ensure we get zero-D array for no inputs, as per PG convention */
-       if (dims[0] <= 0)
-               ndims = 0;
+       if (astate == NULL)
+               return PointerGetDatum(construct_empty_array(elemtypid));
 
        for (i = 0; i < ndims; i++)
                lbs[i] = 1;

diff --git a/src/pl/plperl/sql/plperl_array.sql b/src/pl/plperl/sql/plperl_array.sql
index 66179294ce8016a15198a7a4f3b02efb2ef91c05..ca63b5db62593260022f4b9efb6a1a1198f134d3 100644 (file)
--- 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;