diff --git a/doc/src/sgml/plperl.sgml b/doc/src/sgml/plperl.sgml index 25b1077ad73..8007261d022 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. + + + Trusted PL/Perl relies on the Perl Opcode module to + preserve security. + Perl + documents + 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 REVOKE USAGE ON LANGUAGE plperl FROM + PUBLIC. + + + 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 3a6954ce60e..01588d016a0 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 00000000000..328a5363421 --- /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 41b9b6a3530..cf7b4d9cea9 100644 --- a/src/pl/plperl/plc_trusted.pl +++ b/src/pl/plperl/plc_trusted.pl @@ -30,3 +30,27 @@ package PostgreSQL::InServer::safe; ## no critic (RequireFilenameMatchesPackage) 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 00000000000..4108f392d1d --- /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 ba3532a51e8..6764589418e 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