From f47004add16041a9cbd19aef29775ca4d9d6001e Mon Sep 17 00:00:00 2001 From: Tom Lane Date: Sat, 29 Apr 2023 13:06:44 -0400 Subject: [PATCH] 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 --- src/pl/plperl/expected/plperl_array.out | 43 +++++++++++++++++ src/pl/plperl/plperl.c | 62 ++++++++++++++++--------- src/pl/plperl/sql/plperl_array.sql | 37 +++++++++++++++ 3 files changed, 119 insertions(+), 23 deletions(-) diff --git a/src/pl/plperl/expected/plperl_array.out b/src/pl/plperl/expected/plperl_array.out index 6347b5211d..bd04a062fb 100644 --- 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 d7d9c1bee3..02b89ac5f7 100644 --- 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 66179294ce..ca63b5db62 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;