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
This commit is contained in:
Tom Lane 2023-04-29 13:06:44 -04:00
parent 81eaaf65e3
commit f47004add1
3 changed files with 119 additions and 23 deletions

View File

@ -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;

View File

@ -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;

View File

@ -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;