From: Andrew Dunstan Date: Tue, 16 Feb 2010 21:39:52 +0000 (+0000) Subject: Clean up package namespace use and use of Safe in plperl. X-Git-Tag: REL9_0_ALPHA4~32 X-Git-Url: https://granicus.if.org/sourcecode?a=commitdiff_plain;h=56adf3703c77295b63a71a42e602df247132e409;p=postgresql Clean up package namespace use and use of Safe in plperl. Prevent use of another buggy version of Safe.pm. Only register the exit handler if we have successfully created an interpreter. Change log level of perl warnings from NOTICE to WARNING. The infrastructure is there if in future we decide to allow DBAs to specify extra modules that will be allowed in trusted code. However, for now the relevant variables are declared as lexicals rather than as package variables, so that they are not (or should not be) accessible. Mostly code from Tim Bunce, reviewed by Alex Hunsaker, with some tweaks by me. --- diff --git a/src/pl/plperl/expected/plperl.out b/src/pl/plperl/expected/plperl.out index ebf9afd904..0e7c65dc2b 100644 --- a/src/pl/plperl/expected/plperl.out +++ b/src/pl/plperl/expected/plperl.out @@ -577,3 +577,8 @@ CONTEXT: PL/Perl anonymous code block DO $do$ use strict; my $name = "foo"; my $ref = $$name; $do$ LANGUAGE plperl; ERROR: Can't use string ("foo") as a SCALAR ref while "strict refs" in use at line 1. CONTEXT: PL/Perl anonymous code block +-- check that we can "use warnings" (in this case to turn a warn into an error) +-- yields "ERROR: Useless use of length in void context" +DO $do$ use warnings FATAL => qw(void) ; length "abc" ; 1; $do$ LANGUAGE plperl; +ERROR: Useless use of length in void context at line 1. +CONTEXT: PL/Perl anonymous code block diff --git a/src/pl/plperl/expected/plperl_elog.out b/src/pl/plperl/expected/plperl_elog.out index 89497e3236..02497d9e02 100644 --- a/src/pl/plperl/expected/plperl_elog.out +++ b/src/pl/plperl/expected/plperl_elog.out @@ -20,7 +20,7 @@ create or replace function perl_warn(text) returns void language plperl as $$ $$; select perl_warn('implicit elog via warn'); -NOTICE: implicit elog via warn at line 4. +WARNING: implicit elog via warn at line 4. CONTEXT: PL/Perl function "perl_warn" perl_warn ----------- diff --git a/src/pl/plperl/expected/plperlu.out b/src/pl/plperl/expected/plperlu.out index a37262c1c2..25ac007b7a 100644 --- a/src/pl/plperl/expected/plperlu.out +++ b/src/pl/plperl/expected/plperlu.out @@ -5,7 +5,7 @@ LOAD 'plperl'; -- Test plperl.on_plperlu_init gets run SET plperl.on_plperlu_init = '$_SHARED{init} = 42'; DO $$ warn $_SHARED{init} $$ language plperlu; -NOTICE: 42 at line 1. +WARNING: 42 at line 1. CONTEXT: PL/Perl anonymous code block -- -- Test compilation of unicode regex - regardless of locale. diff --git a/src/pl/plperl/plc_perlboot.pl b/src/pl/plperl/plc_perlboot.pl index 9364a30ece..d3bb614a5d 100644 --- a/src/pl/plperl/plc_perlboot.pl +++ b/src/pl/plperl/plc_perlboot.pl @@ -1,26 +1,30 @@ -# $PostgreSQL: pgsql/src/pl/plperl/plc_perlboot.pl,v 1.4 2010/01/30 01:46:57 adunstan Exp $ +# $PostgreSQL: pgsql/src/pl/plperl/plc_perlboot.pl,v 1.5 2010/02/16 21:39:52 adunstan Exp $ + +use 5.008001; PostgreSQL::InServer::Util::bootstrap(); +package PostgreSQL::InServer; + use strict; use warnings; use vars qw(%_SHARED); -sub ::plperl_warn { +sub plperl_warn { (my $msg = shift) =~ s/\(eval \d+\) //g; chomp $msg; - &elog(&NOTICE, $msg); + &::elog(&::WARNING, $msg); } -$SIG{__WARN__} = \&::plperl_warn; +$SIG{__WARN__} = \&plperl_warn; -sub ::plperl_die { +sub plperl_die { (my $msg = shift) =~ s/\(eval \d+\) //g; die $msg; } -$SIG{__DIE__} = \&::plperl_die; +$SIG{__DIE__} = \&plperl_die; -sub ::mkfuncsrc { +sub mkfuncsrc { my ($name, $imports, $prolog, $src) = @_; my $BEGIN = join "\n", map { @@ -32,13 +36,13 @@ sub ::mkfuncsrc { $name =~ s/\\/\\\\/g; $name =~ s/::|'/_/g; # avoid package delimiters - return qq[ undef *{'$name'}; *{'$name'} = sub { $BEGIN $prolog $src } ]; + return qq[ package main; undef *{'$name'}; *{'$name'} = sub { $BEGIN $prolog $src } ]; } # see also mksafefunc() in plc_safe_ok.pl -sub ::mkunsafefunc { +sub mkunsafefunc { no strict; # default to no strict for the eval - my $ret = eval(::mkfuncsrc(@_)); + my $ret = eval(mkfuncsrc(@_)); $@ =~ s/\(eval \d+\) //g if $@; return $ret; } @@ -67,7 +71,7 @@ sub ::encode_array_literal { sub ::encode_array_constructor { my $arg = shift; - return quote_nullable($arg) + return ::quote_nullable($arg) if ref $arg ne 'ARRAY'; my $res = join ", ", map { (ref $_) ? ::encode_array_constructor($_) diff --git a/src/pl/plperl/plc_safe_ok.pl b/src/pl/plperl/plc_safe_ok.pl index 6e17f45e65..b76900de76 100644 --- a/src/pl/plperl/plc_safe_ok.pl +++ b/src/pl/plperl/plc_safe_ok.pl @@ -1,43 +1,95 @@ -# $PostgreSQL: pgsql/src/pl/plperl/plc_safe_ok.pl,v 1.4 2010/02/12 19:35:25 adunstan Exp $ +# $PostgreSQL: pgsql/src/pl/plperl/plc_safe_ok.pl,v 1.5 2010/02/16 21:39:52 adunstan Exp $ +package PostgreSQL::InServer::safe; + use strict; -use vars qw($PLContainer); +use warnings; +use Safe; + +# @EvalInSafe = ( [ "string to eval", "extra,opcodes,to,allow" ], ...) +# @ShareIntoSafe = ( [ from_class => \@symbols ], ...) + +# these are currently declared "my" so they can't be monkeyed with using init +# code. If we later decide to change that policy, we could change one or more +# to make them visible by using "use vars". +my($PLContainer,$SafeClass,@EvalInSafe,@ShareIntoSafe); + +# --- configuration --- + +# ensure we only alter the configuration variables once to avoid any +# problems if this code is run multiple times due to an exception generated +# from plperl.on_trusted_init code leaving the interp_state unchanged. + +if (not our $_init++) { + + # Load widely useful pragmas into the container to make them available. + # These must be trusted to not expose a way to execute a string eval + # or any kind of unsafe action that the untrusted code could exploit. + # If in ANY doubt about a module then DO NOT add it to this list. + + unshift @EvalInSafe, + [ 'require strict', 'caller' ], + [ 'require Carp', 'caller,entertry' ], # load Carp before warnings + [ 'require warnings', 'caller' ]; + push @EvalInSafe, + [ 'require feature' ] if $] >= 5.010000; + + push @ShareIntoSafe, [ + main => [ qw( + &elog &DEBUG &LOG &INFO &NOTICE &WARNING &ERROR + &spi_query &spi_fetchrow &spi_cursor_close &spi_exec_query + &spi_prepare &spi_exec_prepared &spi_query_prepared &spi_freeplan + &return_next &_SHARED + "e_literal "e_nullable "e_ident + &encode_bytea &decode_bytea &looks_like_number + &encode_array_literal &encode_array_constructor + ) ], + ]; +} + +# --- create and initialize a new container --- + +$SafeClass ||= 'Safe'; +$PLContainer = $SafeClass->new('PostgreSQL::InServer::safe_container'); -$PLContainer = new Safe('PLPerl'); $PLContainer->permit_only(':default'); $PLContainer->permit(qw[:base_math !:base_io sort time require]); -$PLContainer->share(qw[&elog &return_next - &spi_query &spi_fetchrow &spi_cursor_close &spi_exec_query - &spi_prepare &spi_exec_prepared &spi_query_prepared &spi_freeplan - &DEBUG &LOG &INFO &NOTICE &WARNING &ERROR %_SHARED - "e_literal "e_nullable "e_ident - &encode_bytea &decode_bytea - &encode_array_literal &encode_array_constructor - &looks_like_number -]); - -# Load widely useful pragmas into the container to make them available. -# (Temporarily enable caller here as work around for bug in perl 5.10, -# which changed the way its Safe.pm works. It is quite safe, as caller is -# informational only.) -$PLContainer->permit(qw[caller]); -::safe_eval(q{ - require strict; - require feature if $] >= 5.010000; - 1; -}) or die $@; -$PLContainer->deny(qw[caller]); - -# called directly for plperl.on_plperl_init -sub ::safe_eval { +for my $do (@EvalInSafe) { + my $perform = sub { # private closure + my ($container, $src, $ops) = @_; + my $mask = $container->mask; + $container->permit(split /\s*,\s*/, $ops); + my $ok = safe_eval("$src; 1"); + $container->mask($mask); + main::elog(main::ERROR(), "$src failed: $@") unless $ok; + }; + + my $ops = $do->[1] || ''; + # For old perls we add entereval if entertry is listed + # due to http://rt.perl.org/rt3/Ticket/Display.html?id=70970 + # Testing with a recent perl (>=5.11.4) ensures this doesn't + # allow any use of actual entereval (eval "...") opcodes. + $ops = "entereval,$ops" + if $] < 5.011004 and $ops =~ /\bentertry\b/; + + $perform->($PLContainer, $do->[0], $ops); +} + +$PLContainer->share_from(@$_) for @ShareIntoSafe; + + +# --- runtime interface --- + +# called directly for plperl.on_trusted_init and @EvalInSafe +sub safe_eval { my $ret = $PLContainer->reval(shift); $@ =~ s/\(eval \d+\) //g if $@; return $ret; } -sub ::mksafefunc { - return ::safe_eval(::mkfuncsrc(@_)); +sub mksafefunc { +! return safe_eval(PostgreSQL::InServer::mkfuncsrc(@_)); } diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c index f181c39610..31ff7057a0 100644 --- a/src/pl/plperl/plperl.c +++ b/src/pl/plperl/plperl.c @@ -1,7 +1,7 @@ /********************************************************************** * plperl.c - perl as a procedural language for PostgreSQL * - * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.167 2010/02/15 22:23:25 alvherre Exp $ + * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.168 2010/02/16 21:39:52 adunstan Exp $ * **********************************************************************/ @@ -365,8 +365,6 @@ select_perl_context(bool trusted) { /* first actual use of a perl interpreter */ - on_proc_exit(plperl_fini, 0); - if (trusted) { plperl_trusted_init(); @@ -379,6 +377,10 @@ select_perl_context(bool trusted) plperl_untrusted_interp = plperl_held_interp; interp_state = INTERP_UNTRUSTED; } + + /* successfully initialized, so arrange for cleanup */ + on_proc_exit(plperl_fini, 0); + } else { @@ -673,14 +675,16 @@ plperl_trusted_init(void) SV *safe_version_sv; IV safe_version_x100; - safe_version_sv = eval_pv(SAFE_MODULE, FALSE); /* TRUE = croak if failure */ + safe_version_sv = eval_pv(SAFE_MODULE, FALSE);/* TRUE = croak if failure */ safe_version_x100 = (int)(SvNV(safe_version_sv) * 100); /* * Reject too-old versions of Safe and some others: * 2.20: http://rt.perl.org/rt3/Ticket/Display.html?id=72068 + * 2.21: http://rt.perl.org/rt3/Ticket/Display.html?id=72700 */ - if (safe_version_x100 < 209 || safe_version_x100 == 220) + if (safe_version_x100 < 209 || safe_version_x100 == 220 || + safe_version_x100 == 221) { /* not safe, so disallow all trusted funcs */ eval_pv(PLC_SAFE_BAD, FALSE); @@ -722,7 +726,7 @@ plperl_trusted_init(void) XPUSHs(sv_2mortal(newSVstring(plperl_on_plperl_init))); PUTBACK; - call_pv("::safe_eval", G_VOID); + call_pv("PostgreSQL::InServer::safe::safe_eval", G_VOID); SPAGAIN; if (SvTRUE(ERRSV)) @@ -1259,7 +1263,9 @@ plperl_create_sub(plperl_proc_desc *prodesc, char *s, Oid fn_oid) * errors properly. Perhaps it's because there's another level of eval * inside mksafefunc? */ - compile_sub = (trusted) ? "::mksafefunc" : "::mkunsafefunc"; + compile_sub = (trusted) + ? "PostgreSQL::InServer::safe::mksafefunc" + : "PostgreSQL::InServer::mkunsafefunc"; count = perl_call_pv(compile_sub, G_SCALAR | G_EVAL | G_KEEPERR); SPAGAIN; diff --git a/src/pl/plperl/sql/plperl.sql b/src/pl/plperl/sql/plperl.sql index e6ef5f069e..905e9187d4 100644 --- a/src/pl/plperl/sql/plperl.sql +++ b/src/pl/plperl/sql/plperl.sql @@ -378,3 +378,7 @@ DO $$ use blib; $$ LANGUAGE plperl; -- runtime error: "Can't use string ("foo") as a SCALAR ref while "strict refs" in use DO $do$ use strict; my $name = "foo"; my $ref = $$name; $do$ LANGUAGE plperl; +-- check that we can "use warnings" (in this case to turn a warn into an error) +-- yields "ERROR: Useless use of length in void context" +DO $do$ use warnings FATAL => qw(void) ; length "abc" ; 1; $do$ LANGUAGE plperl; +