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:
SHLIB_LINK = $(perl_embed_ldflags)
-REGRESS_OPTS = --dbname=$(PL_TESTDB) --load-extension=plperl --load-extension=plperlu
-REGRESS = plperl plperl_lc plperl_trigger plperl_shared plperl_elog plperl_util plperl_init plperlu plperl_array plperl_call plperl_transaction
+REGRESS_OPTS = --dbname=$(PL_TESTDB) --dlpath=$(top_builddir)/src/test/regress --load-extension=plperl --load-extension=plperlu
+REGRESS = plperl plperl_lc plperl_trigger plperl_shared plperl_elog plperl_util plperl_init plperlu plperl_array plperl_call plperl_transaction plperl_env
# if Perl can support two interpreters in one backend,
# test plperl-and-plperlu cases
ifneq ($(PERL),)
--- /dev/null
+--
+-- Test the environment setting
+--
+
+CREATE FUNCTION get_environ()
+ RETURNS text[]
+ AS '@libdir@/regress@DLSUFFIX@', '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;
--- /dev/null
+--
+-- Test the environment setting
+--
+CREATE FUNCTION get_environ()
+ RETURNS text[]
+ AS '@libdir@/regress@DLSUFFIX@', '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
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 $!;
#include "optimizer/plancat.h"
#include "port/atomics.h"
#include "storage/spin.h"
+#include "utils/array.h"
#include "utils/builtins.h"
#include "utils/geo_decls.h"
#include "utils/rel.h"
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, 'i');
+
+ PG_RETURN_POINTER(result);
+}
+
PG_FUNCTION_INFO_V1(regress_putenv);
Datum
projects / postgresql.git / commitdiff