mirror of
https://github.com/postgres/postgres.git
synced 2026-07-11 18:45:31 -04:00
4015abe14b
In get_perl_array_ref(), for a PostgreSQL::InServer::ARRAY object, we look up its "array" key with hv_fetch_string() and then inspect the returned SV. However, hv_fetch_string() returns a NULL pointer when the key is absent, and the code dereferenced that result without first checking whether the pointer itself was NULL. As a result, a plperl function returning a forged PostgreSQL::InServer::ARRAY object that lacks the "array" key would crash the backend with a segmentation fault. Fix this by checking the pointer returned by hv_fetch_string() before dereferencing it, matching how other callers in this file already guard the result. With the check in place, such an object falls through to the existing error report instead of crashing. Author: Xing Guo <higuoxing@gmail.com> Reviewed-by: Richard Guo <guofenglinux@gmail.com> Discussion: https://postgr.es/m/CACpMh+DYgcnqZwQLXXuxQcehJTd7T8UmKWSLsK4mFBEp9G2ajA@mail.gmail.com Backpatch-through: 14
283 lines
9.6 KiB
Text
283 lines
9.6 KiB
Text
CREATE OR REPLACE FUNCTION plperl_sum_array(INTEGER[]) RETURNS text AS $$
|
|
my $array_arg = shift;
|
|
my $result = 0;
|
|
my @arrays;
|
|
|
|
push @arrays, @$array_arg;
|
|
|
|
while (@arrays > 0) {
|
|
my $el = shift @arrays;
|
|
if (is_array_ref($el)) {
|
|
push @arrays, @$el;
|
|
} else {
|
|
$result += $el;
|
|
}
|
|
}
|
|
return $result.' '.$array_arg;
|
|
$$ LANGUAGE plperl;
|
|
select plperl_sum_array('{1,2,NULL}');
|
|
plperl_sum_array
|
|
------------------
|
|
3 {1,2,NULL}
|
|
(1 row)
|
|
|
|
select plperl_sum_array('{}');
|
|
plperl_sum_array
|
|
------------------
|
|
0 {}
|
|
(1 row)
|
|
|
|
select plperl_sum_array('{{1,2,3}, {4,5,6}}');
|
|
plperl_sum_array
|
|
----------------------
|
|
21 {{1,2,3},{4,5,6}}
|
|
(1 row)
|
|
|
|
select plperl_sum_array('{{{1,2,3}, {4,5,6}}, {{7,8,9}, {10,11,12}}}');
|
|
plperl_sum_array
|
|
---------------------------------------------
|
|
78 {{{1,2,3},{4,5,6}},{{7,8,9},{10,11,12}}}
|
|
(1 row)
|
|
|
|
-- check whether we can handle arrays of maximum dimension (6)
|
|
select plperl_sum_array(ARRAY[[[[[[1,2],[3,4]],[[5,6],[7,8]]],[[[9,10],[11,12]],
|
|
[[13,14],[15,16]]]],
|
|
[[[[17,18],[19,20]],[[21,22],[23,24]]],[[[25,26],[27,28]],[[29,30],[31,32]]]]],
|
|
[[[[[1,2],[3,4]],[[5,6],[7,8]]],[[[9,10],[11,12]],[[13,14],[15,16]]]],
|
|
[[[[17,18],[19,20]],[[21,22],[23,24]]],[[[25,26],[27,28]],[[29,30],[31,32]]]]]]);
|
|
plperl_sum_array
|
|
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
|
|
1056 {{{{{{1,2},{3,4}},{{5,6},{7,8}}},{{{9,10},{11,12}},{{13,14},{15,16}}}},{{{{17,18},{19,20}},{{21,22},{23,24}}},{{{25,26},{27,28}},{{29,30},{31,32}}}}},{{{{{1,2},{3,4}},{{5,6},{7,8}}},{{{9,10},{11,12}},{{13,14},{15,16}}}},{{{{17,18},{19,20}},{{21,22},{23,24}}},{{{25,26},{27,28}},{{29,30},{31,32}}}}}}
|
|
(1 row)
|
|
|
|
-- what would we do with the arrays exceeding maximum dimension (7)
|
|
select plperl_sum_array('{{{{{{{1,2},{3,4}},{{5,6},{7,8}}},{{{9,10},{11,12}},
|
|
{{13,14},{15,16}}}},
|
|
{{{{17,18},{19,20}},{{21,22},{23,24}}},{{{25,26},{27,28}},{{29,30},{31,32}}}}},
|
|
{{{{{1,2},{3,4}},{{5,6},{7,8}}},{{{9,10},{11,12}},{{13,14},{15,16}}}},
|
|
{{{{17,18},{19,20}},{{21,22},{23,24}}},{{{25,26},{27,28}},{{29,30},{31,32}}}}}},
|
|
{{{{{{1,2},{3,4}},{{5,6},{7,8}}},{{{9,10},{11,12}},{{13,14},{15,16}}}},
|
|
{{{{17,18},{19,20}},{{21,22},{23,24}}},{{{25,26},{27,28}},{{29,30},{31,32}}}}},
|
|
{{{{{1,2},{3,4}},{{5,6},{7,8}}},{{{9,10},{11,12}},{{13,14},{15,16}}}},
|
|
{{{{17,18},{19,20}},{{21,22},{23,24}}},{{{25,26},{27,28}},{{29,30},{31,32}}}}}}}'
|
|
);
|
|
ERROR: number of array dimensions exceeds the maximum allowed (6)
|
|
LINE 1: select plperl_sum_array('{{{{{{{1,2},{3,4}},{{5,6},{7,8}}},{...
|
|
^
|
|
select plperl_sum_array('{{{1,2,3}, {4,5,6,7}}, {{7,8,9}, {10, 11, 12}}}');
|
|
ERROR: malformed array literal: "{{{1,2,3}, {4,5,6,7}}, {{7,8,9}, {10, 11, 12}}}"
|
|
LINE 1: select plperl_sum_array('{{{1,2,3}, {4,5,6,7}}, {{7,8,9}, {1...
|
|
^
|
|
DETAIL: Multidimensional arrays must have sub-arrays with matching dimensions.
|
|
CREATE OR REPLACE FUNCTION plperl_concat(TEXT[]) RETURNS TEXT AS $$
|
|
my $array_arg = shift;
|
|
my $result = "";
|
|
my @arrays;
|
|
|
|
push @arrays, @$array_arg;
|
|
while (@arrays > 0) {
|
|
my $el = shift @arrays;
|
|
if (is_array_ref($el)) {
|
|
push @arrays, @$el;
|
|
} else {
|
|
$result .= $el;
|
|
}
|
|
}
|
|
return $result.' '.$array_arg;
|
|
$$ LANGUAGE plperl;
|
|
select plperl_concat('{"NULL","NULL","NULL''"}');
|
|
plperl_concat
|
|
-------------------------------------
|
|
NULLNULLNULL' {"NULL","NULL",NULL'}
|
|
(1 row)
|
|
|
|
select plperl_concat('{{NULL,NULL,NULL}}');
|
|
plperl_concat
|
|
---------------------
|
|
{{NULL,NULL,NULL}}
|
|
(1 row)
|
|
|
|
select plperl_concat('{"hello"," ","world!"}');
|
|
plperl_concat
|
|
---------------------------------
|
|
hello world! {hello," ",world!}
|
|
(1 row)
|
|
|
|
-- array of rows --
|
|
CREATE TYPE foo AS (bar INTEGER, baz TEXT);
|
|
CREATE OR REPLACE FUNCTION plperl_array_of_rows(foo[]) RETURNS TEXT AS $$
|
|
my $array_arg = shift;
|
|
my $result = "";
|
|
|
|
for my $row_ref (@$array_arg) {
|
|
die "not a hash reference" unless (ref $row_ref eq "HASH");
|
|
$result .= $row_ref->{bar}." items of ".$row_ref->{baz}.";";
|
|
}
|
|
return $result .' '. $array_arg;
|
|
$$ LANGUAGE plperl;
|
|
select plperl_array_of_rows(ARRAY[ ROW(2, 'coffee'), ROW(0, 'sugar')]::foo[]);
|
|
plperl_array_of_rows
|
|
----------------------------------------------------------------
|
|
2 items of coffee;0 items of sugar; {"(2,coffee)","(0,sugar)"}
|
|
(1 row)
|
|
|
|
-- composite type containing arrays
|
|
CREATE TYPE rowfoo AS (bar INTEGER, baz INTEGER[]);
|
|
CREATE OR REPLACE FUNCTION plperl_sum_row_elements(rowfoo) RETURNS TEXT AS $$
|
|
my $row_ref = shift;
|
|
my $result;
|
|
|
|
if (ref $row_ref ne 'HASH') {
|
|
$result = 0;
|
|
}
|
|
else {
|
|
$result = $row_ref->{bar};
|
|
die "not an array reference".ref ($row_ref->{baz})
|
|
unless (is_array_ref($row_ref->{baz}));
|
|
# process a single-dimensional array
|
|
foreach my $elem (@{$row_ref->{baz}}) {
|
|
$result += $elem unless ref $elem;
|
|
}
|
|
}
|
|
return $result;
|
|
$$ LANGUAGE plperl;
|
|
select plperl_sum_row_elements(ROW(1, ARRAY[2,3,4,5,6,7,8,9,10])::rowfoo);
|
|
plperl_sum_row_elements
|
|
-------------------------
|
|
55
|
|
(1 row)
|
|
|
|
-- composite type containing array of another composite type, which, in order,
|
|
-- contains an array of integers.
|
|
CREATE TYPE rowbar AS (foo rowfoo[]);
|
|
CREATE OR REPLACE FUNCTION plperl_sum_array_of_rows(rowbar) RETURNS TEXT AS $$
|
|
my $rowfoo_ref = shift;
|
|
my $result = 0;
|
|
|
|
if (ref $rowfoo_ref eq 'HASH') {
|
|
my $row_array_ref = $rowfoo_ref->{foo};
|
|
if (is_array_ref($row_array_ref)) {
|
|
foreach my $row_ref (@{$row_array_ref}) {
|
|
if (ref $row_ref eq 'HASH') {
|
|
$result += $row_ref->{bar};
|
|
die "not an array reference".ref ($row_ref->{baz})
|
|
unless (is_array_ref($row_ref->{baz}));
|
|
foreach my $elem (@{$row_ref->{baz}}) {
|
|
$result += $elem unless ref $elem;
|
|
}
|
|
}
|
|
else {
|
|
die "element baz is not a reference to a rowfoo";
|
|
}
|
|
}
|
|
} else {
|
|
die "not a reference to an array of rowfoo elements"
|
|
}
|
|
} else {
|
|
die "not a reference to type rowbar";
|
|
}
|
|
return $result;
|
|
$$ LANGUAGE plperl;
|
|
select plperl_sum_array_of_rows(ROW(ARRAY[ROW(1, ARRAY[2,3,4,5,6,7,8,9,10])::rowfoo,
|
|
ROW(11, ARRAY[12,13,14,15,16,17,18,19,20])::rowfoo])::rowbar);
|
|
plperl_sum_array_of_rows
|
|
--------------------------
|
|
210
|
|
(1 row)
|
|
|
|
-- check arrays as out parameters
|
|
CREATE OR REPLACE FUNCTION plperl_arrays_out(OUT INTEGER[]) AS $$
|
|
return [[1,2,3],[4,5,6]];
|
|
$$ LANGUAGE plperl;
|
|
select plperl_arrays_out();
|
|
plperl_arrays_out
|
|
-------------------
|
|
{{1,2,3},{4,5,6}}
|
|
(1 row)
|
|
|
|
-- check that we can return the array we passed in
|
|
CREATE OR REPLACE FUNCTION plperl_arrays_inout(INTEGER[]) returns INTEGER[] AS $$
|
|
return shift;
|
|
$$ LANGUAGE plperl;
|
|
select plperl_arrays_inout('{{1}, {2}, {3}}');
|
|
plperl_arrays_inout
|
|
---------------------
|
|
{{1},{2},{3}}
|
|
(1 row)
|
|
|
|
-- check that we can return an array literal
|
|
CREATE OR REPLACE FUNCTION plperl_arrays_inout_l(INTEGER[]) returns INTEGER[] AS $$
|
|
return shift.''; # stringify it
|
|
$$ LANGUAGE plperl;
|
|
select plperl_arrays_inout_l('{{1}, {2}, {3}}');
|
|
plperl_arrays_inout_l
|
|
-----------------------
|
|
{{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;
|
|
for my $r (@$arr) {
|
|
return_next $r;
|
|
}
|
|
return undef;
|
|
$$;
|
|
select perl_setof_array('{{1}, {2}, {3}}');
|
|
perl_setof_array
|
|
------------------
|
|
{1}
|
|
{2}
|
|
{3}
|
|
(3 rows)
|
|
|
|
-- Test a forged PostgreSQL::InServer::ARRAY object lacking the 'array' key
|
|
CREATE OR REPLACE FUNCTION perl_forged_array() RETURNS integer[] AS $$
|
|
return bless {}, "PostgreSQL::InServer::ARRAY";
|
|
$$ LANGUAGE plperl;
|
|
SELECT perl_forged_array();
|
|
ERROR: could not get array reference from PostgreSQL::InServer::ARRAY object
|
|
CONTEXT: PL/Perl function "perl_forged_array"
|