On Fri, Jan 15, 2010 at 04:02:02AM +0000, Tim Bunce wrote:
> This is the final plperl patch in the series from me.
>
> Changes in this 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.
This is a revised version of the patch with the following additional
changes:
- 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.
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 5f6ae91..239456c 100644
*** a/src/pl/plperl/plc_perlboot.pl
--- b/src/pl/plperl/plc_perlboot.pl
***************
*** 1,23 ****
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,27 ----
+ 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 {
*** 30,44 ****
$name =~ s/::|'/_/g; # avoid package delimiters
my $funcsrc;
! $funcsrc .= qq[ undef *{'$name'}; *{'$name'} = sub { $BEGIN $prolog $src } ];
#warn "plperl mkfuncsrc: $funcsrc\n";
return $funcsrc;
}
# 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;
}
--- 34,48 ----
$name =~ s/::|'/_/g; # avoid package delimiters
my $funcsrc;
! $funcsrc .= qq[ package main; undef *{'$name'}; *{'$name'} = sub { $BEGIN $prolog $src } ];
#warn "plperl mkfuncsrc: $funcsrc\n";
return $funcsrc;
}
# 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 7b36e33..7dc330e 100644
*** a/src/pl/plperl/plc_safe_ok.pl
--- b/src/pl/plperl/plc_safe_ok.pl
***************
*** 1,39 ****
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,77 ----
+ 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);
!
! # 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' ],
! [ '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
! ) ],
! ];
!
! # --- initialization ---
!
! $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);
! safe_eval("$src; 1")
! or main::elog(main::ERROR(), "$src failed: $@");
! $container->mask($mask);
! };
! 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 2eef4a7..2111936 100644
*** a/src/pl/plperl/plperl.c
--- b/src/pl/plperl/plperl.c
*************** plperl_trusted_init(void)
*** 682,688 ****
XPUSHs(sv_2mortal(newSVstring(plperl_on_trusted_init)));
PUTBACK;
! call_pv("::safe_eval", G_VOID);
SPAGAIN;
if (SvTRUE(ERRSV))
--- 682,688 ----
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
*** 1227,1233 ****
* 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;
--- 1227,1235 ----
* 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;
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 ([email protected])
To make changes to your subscription:
http://www.postgresql.org/mailpref/pgsql-hackers
