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 patch will apply cleanly over the 'Add on_trusted_init and
on_untrusted_init to plperl' patch:
https://commitfest.postgresql.org/action/patch_view?id=271
Tim.
diff --git a/src/pl/plperl/plc_perlboot.pl b/src/pl/plperl/plc_perlboot.pl
index 5f6ae91..05ed049 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,25 ----
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;
}
--- 32,46 ----
$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($_)
--- 69,75 ----
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..fcf5d54 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,56 ----
+ package PostgreSQL::InServer::safe;
+
use strict;
! use warnings;
!
! 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.
! push @EvalInSafe, 'require feature' if $] >= 5.010000;
! push @EvalInSafe, 'require strict';
!
! 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]);
# (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($_) or die $@
! for reverse @EvalInSafe;
$PLContainer->deny(qw[caller]);
+ $PLContainer->share_from(@$_) for @ShareIntoSafe;
+
+ # --- runtime interface ---
+
# 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(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;
--
Sent via pgsql-hackers mailing list (pgsql-hackers@postgresql.org)
To make changes to your subscription:
http://www.postgresql.org/mailpref/pgsql-hackers
