This is an update to the final plperl patch in the series from me.
Changes in the original patch:
- Moved internal functions out of main:: namespace
into PostgreSQL::InServer and PostgreSQL::InServer::safe
- Restructured Safe compartment setup code
to generalize and separate the data from the logic.
Neither change has any user visible effects.
Additional changes in the second version:
- Further generalized the 'what to load into Safe compartment' logic.
- Added the 'warnings' pragma to the list of modules to load into Safe.
So plperl functions can now "use warnings;" - added test for that.
- Added 'use 5.008001;' to plc_perlboot.pl as a run-time check to
complement the configure-time check added by Tom Lane recently.
Additional changes in this version:
- Rebased over recent HEAD plus "on_trusted_init" patch
- Made plc_safe_ok.pl code idempotent to avoid risk of problems
from repeated initialization attempts e.g. if on_trusted_init code
throws an exception so initialization doesn't complete.
- Fixed 'require strict' to enable 'caller' opcode
(needed for Perl >=5.10)
- Ensure Safe container opmask is restored even if @EvalInSafe code
throws an exception.
- Changed errmsg("didn't get a GLOB ...") to use errmsg_internal().
Tim.
diff --git a/src/pl/plperl/expected/plperl.out b/src/pl/plperl/expected/plperl.out
index ebf9afd..0e7c65d 100644
*** a/src/pl/plperl/expected/plperl.out
--- b/src/pl/plperl/expected/plperl.out
*************** CONTEXT: PL/Perl anonymous code block
*** 577,579 ****
--- 577,584 ----
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/plc_perlboot.pl b/src/pl/plperl/plc_perlboot.pl
index 5d2e962..74b2a47 100644
*** a/src/pl/plperl/plc_perlboot.pl
--- b/src/pl/plperl/plc_perlboot.pl
***************
*** 1,26 ****
# $PostgreSQL$
PostgreSQL::InServer::Util::bootstrap();
use strict;
use warnings;
use vars qw(%_SHARED);
! sub ::plperl_warn {
(my $msg = shift) =~ s/\(eval \d+\) //g;
chomp $msg;
! &elog(&NOTICE, $msg);
}
! $SIG{__WARN__} = \&::plperl_warn;
! sub ::plperl_die {
(my $msg = shift) =~ s/\(eval \d+\) //g;
die $msg;
}
! $SIG{__DIE__} = \&::plperl_die;
! sub ::mkfuncsrc {
my ($name, $imports, $prolog, $src) = @_;
my $BEGIN = join "\n", map {
--- 1,30 ----
# $PostgreSQL$
+ use 5.008001;
+
PostgreSQL::InServer::Util::bootstrap();
+ package PostgreSQL::InServer;
+
use strict;
use warnings;
use vars qw(%_SHARED);
! sub plperl_warn {
(my $msg = shift) =~ s/\(eval \d+\) //g;
chomp $msg;
! &::elog(&::NOTICE, $msg);
}
! $SIG{__WARN__} = \&plperl_warn;
! sub plperl_die {
(my $msg = shift) =~ s/\(eval \d+\) //g;
die $msg;
}
! $SIG{__DIE__} = \&plperl_die;
! sub mkfuncsrc {
my ($name, $imports, $prolog, $src) = @_;
my $BEGIN = join "\n", map {
*************** sub ::mkfuncsrc {
*** 32,44 ****
$name =~ s/\\/\\\\/g;
$name =~ s/::|'/_/g; # avoid package delimiters
! return qq[ undef *{'$name'}; *{'$name'} = sub { $BEGIN $prolog $src } ];
}
# see also mksafefunc() in plc_safe_ok.pl
! sub ::mkunsafefunc {
no strict; # default to no strict for the eval
! my $ret = eval(::mkfuncsrc(@_));
$@ =~ s/\(eval \d+\) //g if $@;
return $ret;
}
--- 36,48 ----
$name =~ s/\\/\\\\/g;
$name =~ s/::|'/_/g; # avoid package delimiters
! return qq[ package main; undef *{'$name'}; *{'$name'} = sub { $BEGIN $prolog $src } ];
}
# see also mksafefunc() in plc_safe_ok.pl
! sub mkunsafefunc {
no strict; # default to no strict for the eval
! my $ret = eval(mkfuncsrc(@_));
$@ =~ s/\(eval \d+\) //g if $@;
return $ret;
}
*************** sub ::encode_array_literal {
*** 67,73 ****
sub ::encode_array_constructor {
my $arg = shift;
! return quote_nullable($arg)
if ref $arg ne 'ARRAY';
my $res = join ", ", map {
(ref $_) ? ::encode_array_constructor($_)
--- 71,77 ----
sub ::encode_array_constructor {
my $arg = shift;
! 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 e3666f2..b87284c 100644
*** a/src/pl/plperl/plc_safe_ok.pl
--- b/src/pl/plperl/plc_safe_ok.pl
***************
*** 1,43 ****
! # $PostgreSQL$
! use strict;
! use vars qw($PLContainer);
- $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_trusted_init
! sub ::safe_eval {
my $ret = $PLContainer->reval(shift);
$@ =~ s/\(eval \d+\) //g if $@;
return $ret;
}
! sub ::mksafefunc {
! return ::safe_eval(::mkfuncsrc(@_));
}
--- 1,88 ----
+ package PostgreSQL::InServer::safe;
+ use strict;
+ use warnings;
+ use Safe;
! # @EvalInSafe = ( [ "string to eval", "extra,opcodes,to,allow" ], ...)
! # @ShareIntoSafe = ( [ from_class => \...@symbols ], ...)
! use vars qw($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->permit_only(':default');
$PLContainer->permit(qw[:base_math !:base_io sort time require]);
! 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(PostgreSQL::InServer::mkfuncsrc(@_));
}
diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index 2b6ec2f..44cb5a3 100644
*** a/src/pl/plperl/plperl.c
--- b/src/pl/plperl/plperl.c
*************** plperl_trusted_init(void)
*** 724,730 ****
XPUSHs(sv_2mortal(newSVstring(plperl_on_trusted_init)));
PUTBACK;
! call_pv("::safe_eval", G_VOID);
SPAGAIN;
if (SvTRUE(ERRSV))
--- 724,730 ----
XPUSHs(sv_2mortal(newSVstring(plperl_on_trusted_init)));
PUTBACK;
! call_pv("PostgreSQL::InServer::safe::safe_eval", G_VOID);
SPAGAIN;
if (SvTRUE(ERRSV))
*************** plperl_create_sub(plperl_proc_desc *prod
*** 1269,1275 ****
* errors properly. Perhaps it's because there's another level of eval
* inside mksafefunc?
*/
! compile_sub = (trusted) ? "::mksafefunc" : "::mkunsafefunc";
count = perl_call_pv(compile_sub, G_SCALAR | G_EVAL | G_KEEPERR);
SPAGAIN;
--- 1269,1277 ----
* errors properly. Perhaps it's because there's another level of eval
* inside mksafefunc?
*/
! compile_sub = (trusted)
! ? "PostgreSQL::InServer::safe::mksafefunc"
! : "PostgreSQL::InServer::mkunsafefunc";
count = perl_call_pv(compile_sub, G_SCALAR | G_EVAL | G_KEEPERR);
SPAGAIN;
*************** plperl_create_sub(plperl_proc_desc *prod
*** 1297,1303 ****
{
ereport(ERROR,
(errcode(ERRCODE_INTERNAL_ERROR),
! errmsg("didn't get a GLOB from compiling %s via %s", prodesc->proname, compile_sub)));
}
prodesc->reference = newSVsv(subref);
--- 1299,1305 ----
{
ereport(ERROR,
(errcode(ERRCODE_INTERNAL_ERROR),
! errmsg_internal("didn't get a GLOB from compiling %s via %s", prodesc->proname, compile_sub)));
}
prodesc->reference = newSVsv(subref);
diff --git a/src/pl/plperl/sql/plperl.sql b/src/pl/plperl/sql/plperl.sql
index e6ef5f0..905e918 100644
*** a/src/pl/plperl/sql/plperl.sql
--- b/src/pl/plperl/sql/plperl.sql
*************** DO $$ use blib; $$ LANGUAGE plperl;
*** 378,380 ****
--- 378,384 ----
-- 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;
+
--
Sent via pgsql-hackers mailing list (pgsql-hackers@postgresql.org)
To make changes to your subscription:
http://www.postgresql.org/mailpref/pgsql-hackers
