diff --git a/doc/src/sgml/plperl.sgml b/doc/src/sgml/plperl.sgml
index 25b1077ad7..8007261d02 100644
--- a/doc/src/sgml/plperl.sgml
+++ b/doc/src/sgml/plperl.sgml
@@ -1093,6 +1093,19 @@ $$ LANGUAGE plperl;
be permitted to use this language.
</para>
+ <warning>
+ <para>
+ Trusted PL/Perl relies on the Perl <literal>Opcode</literal> module to
+ preserve security.
+ Perl
+ <ulink url="https://perldoc.perl.org/Opcode#WARNING">documents</ulink>
+ that the module is not effective for the trusted PL/Perl use case. If
+ your security needs are incompatible with the uncertainty in that warning,
+ consider executing <literal>REVOKE USAGE ON LANGUAGE plperl FROM
+ PUBLIC</literal>.
+ </para>
+ </warning>
+
<para>
Here is an example of a function that will not work because file
system operations are not allowed for security reasons:
diff --git a/src/pl/plperl/GNUmakefile b/src/pl/plperl/GNUmakefile
index 3a6954ce60..01588d016a 100644
--- a/src/pl/plperl/GNUmakefile
+++ b/src/pl/plperl/GNUmakefile
@@ -55,10 +55,10 @@ endif # win32
SHLIB_LINK = $(perl_embed_ldflags)
-REGRESS_OPTS = --dbname=$(PL_TESTDB)
+REGRESS_OPTS = --dbname=$(PL_TESTDB) --dlpath=$(top_builddir)/src/test/regress
REGRESS = plperl_setup plperl plperl_lc plperl_trigger plperl_shared \
plperl_elog plperl_util plperl_init plperlu plperl_array \
- plperl_call plperl_transaction
+ plperl_call plperl_transaction plperl_env
# if Perl can support two interpreters in one backend,
# test plperl-and-plperlu cases
ifneq ($(PERL),)
diff --git a/src/pl/plperl/expected/plperl_env.out b/src/pl/plperl/expected/plperl_env.out
new file mode 100644
index 0000000000..328a536342
--- /dev/null
+++ b/src/pl/plperl/expected/plperl_env.out
@@ -0,0 +1,53 @@
+--
+-- Test the environment setting
+--
+-- directory path and dlsuffix are passed to us in environment variables
+\getenv libdir PG_LIBDIR
+\getenv dlsuffix PG_DLSUFFIX
+\set regresslib :libdir '/regress' :dlsuffix
+CREATE FUNCTION get_environ()
+ RETURNS text[]
+ AS :'regresslib', 'get_environ'
+ LANGUAGE C STRICT;
+-- fetch the process environment
+CREATE FUNCTION process_env () RETURNS text[]
+LANGUAGE plpgsql AS
+$$
+
+declare
+ res text[];
+ tmp text[];
+ f record;
+begin
+ for f in select unnest(get_environ()) as t loop
+ tmp := regexp_split_to_array(f.t, '=');
+ if array_length(tmp, 1) = 2 then
+ res := res || tmp;
+ end if;
+ end loop;
+ return res;
+end
+
+$$;
+-- plperl should not be able to affect the process environment
+DO
+$$
+ $ENV{TEST_PLPERL_ENV_FOO} = "shouldfail";
+ untie %ENV;
+ $ENV{TEST_PLPERL_ENV_FOO} = "testval";
+ my $penv = spi_exec_query("select unnest(process_env()) as pe");
+ my %received;
+ for (my $f = 0; $f < $penv->{processed}; $f += 2)
+ {
+ my $k = $penv->{rows}[$f]->{pe};
+ my $v = $penv->{rows}[$f+1]->{pe};
+ $received{$k} = $v;
+ }
+ unless (exists $received{TEST_PLPERL_ENV_FOO})
+ {
+ elog(NOTICE, "environ unaffected")
+ }
+
+$$ LANGUAGE plperl;
+WARNING: attempted alteration of $ENV{TEST_PLPERL_ENV_FOO} at line 12.
+NOTICE: environ unaffected
diff --git a/src/pl/plperl/plc_trusted.pl b/src/pl/plperl/plc_trusted.pl
index 41b9b6a353..cf7b4d9cea 100644
--- a/src/pl/plperl/plc_trusted.pl
+++ b/src/pl/plperl/plc_trusted.pl
@@ -30,3 +30,27 @@ require Carp;
require Carp::Heavy;
require warnings;
require feature if $] >= 5.010000;
+
+#<<< protect next line from perltidy so perlcritic annotation works
+package PostgreSQL::InServer::WarnEnv; ## no critic (RequireFilenameMatchesPackage)
+#>>>
+
+use strict;
+use warnings;
+use Tie::Hash;
+our @ISA = qw(Tie::StdHash);
+
+sub STORE { warn "attempted alteration of \$ENV{$_[1]}"; }
+sub DELETE { warn "attempted deletion of \$ENV{$_[1]}"; }
+sub CLEAR { warn "attempted clearance of ENV hash"; }
+
+# Remove magic property of %ENV. Changes to this will now not be reflected in
+# the process environment.
+*main::ENV = {%ENV};
+
+# Block %ENV changes from trusted PL/Perl, and warn. We changed %ENV to just a
+# normal hash, yet the application may be expecting the usual Perl %ENV
+# magic. Blocking and warning avoids silent application breakage. The user can
+# untie or otherwise disable this, e.g. if the lost mutation is unimportant
+# and modifying the code to stop that mutation would be onerous.
+tie %main::ENV, 'PostgreSQL::InServer::WarnEnv', %ENV or die $!;
diff --git a/src/pl/plperl/sql/plperl_env.sql b/src/pl/plperl/sql/plperl_env.sql
new file mode 100644
index 0000000000..4108f392d1
--- /dev/null
+++ b/src/pl/plperl/sql/plperl_env.sql
@@ -0,0 +1,58 @@
+--
+-- Test the environment setting
+--
+
+-- directory path and dlsuffix are passed to us in environment variables
+\getenv libdir PG_LIBDIR
+\getenv dlsuffix PG_DLSUFFIX
+
+\set regresslib :libdir '/regress' :dlsuffix
+
+CREATE FUNCTION get_environ()
+ RETURNS text[]
+ AS :'regresslib', 'get_environ'
+ LANGUAGE C STRICT;
+
+-- fetch the process environment
+
+CREATE FUNCTION process_env () RETURNS text[]
+LANGUAGE plpgsql AS
+$$
+
+declare
+ res text[];
+ tmp text[];
+ f record;
+begin
+ for f in select unnest(get_environ()) as t loop
+ tmp := regexp_split_to_array(f.t, '=');
+ if array_length(tmp, 1) = 2 then
+ res := res || tmp;
+ end if;
+ end loop;
+ return res;
+end
+
+$$;
+
+-- plperl should not be able to affect the process environment
+
+DO
+$$
+ $ENV{TEST_PLPERL_ENV_FOO} = "shouldfail";
+ untie %ENV;
+ $ENV{TEST_PLPERL_ENV_FOO} = "testval";
+ my $penv = spi_exec_query("select unnest(process_env()) as pe");
+ my %received;
+ for (my $f = 0; $f < $penv->{processed}; $f += 2)
+ {
+ my $k = $penv->{rows}[$f]->{pe};
+ my $v = $penv->{rows}[$f+1]->{pe};
+ $received{$k} = $v;
+ }
+ unless (exists $received{TEST_PLPERL_ENV_FOO})
+ {
+ elog(NOTICE, "environ unaffected")
+ }
+
+$$ LANGUAGE plperl;
diff --git a/src/test/regress/regress.c b/src/test/regress/regress.c
index ba3532a51e..6764589418 100644
--- a/src/test/regress/regress.c
+++ b/src/test/regress/regress.c
@@ -639,6 +639,29 @@ make_tuple_indirect(PG_FUNCTION_ARGS)
PG_RETURN_POINTER(newtup->t_data);
}
+PG_FUNCTION_INFO_V1(get_environ);
+
+Datum
+get_environ(PG_FUNCTION_ARGS)
+{
+ extern char **environ;
+ int nvals = 0;
+ ArrayType *result;
+ Datum *env;
+
+ for (char **s = environ; *s; s++)
+ nvals++;
+
+ env = palloc(nvals * sizeof(Datum));
+
+ for (int i = 0; i < nvals; i++)
+ env[i] = CStringGetTextDatum(environ[i]);
+
+ result = construct_array(env, nvals, TEXTOID, -1, false, TYPALIGN_INT);
+
+ PG_RETURN_POINTER(result);
+}
+
PG_FUNCTION_INFO_V1(regress_setenv);
Datum