Skip to content

Commit 56adf37

Browse files
adunstanadunstan
committed
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.
1 parent 813135d commit 56adf37

File tree

7 files changed

+120
-49
lines changed

7 files changed

+120
-49
lines changed

‎src/pl/plperl/expected/plperl.out

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -577,3 +577,8 @@ CONTEXT: PL/Perl anonymous code block
577577
DO $do$ use strict; my $name = "foo"; my $ref = $$name; $do$ LANGUAGE plperl;
578578
ERROR: Can't use string ("foo") as a SCALAR ref while "strict refs" in use at line 1.
579579
CONTEXT: PL/Perl anonymous code block
580+
-- check that we can "use warnings" (in this case to turn a warn into an error)
581+
-- yields "ERROR: Useless use of length in void context"
582+
DO $do$ use warnings FATAL => qw(void) ; length "abc" ; 1; $do$ LANGUAGE plperl;
583+
ERROR: Useless use of length in void context at line 1.
584+
CONTEXT: PL/Perl anonymous code block

‎src/pl/plperl/expected/plperl_elog.out

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -20,7 +20,7 @@ create or replace function perl_warn(text) returns void language plperl as $$
2020

2121
$$;
2222
select perl_warn('implicit elog via warn');
23-
NOTICE: implicit elog via warn at line 4.
23+
WARNING: implicit elog via warn at line 4.
2424
CONTEXT: PL/Perl function "perl_warn"
2525
perl_warn
2626
-----------

‎src/pl/plperl/expected/plperlu.out

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,7 @@ LOAD 'plperl';
55
-- Test plperl.on_plperlu_init gets run
66
SET plperl.on_plperlu_init = '$_SHARED{init} = 42';
77
DO $$ warn $_SHARED{init} $$ language plperlu;
8-
NOTICE: 42 at line 1.
8+
WARNING: 42 at line 1.
99
CONTEXT: PL/Perl anonymous code block
1010
--
1111
-- Test compilation of unicode regex - regardless of locale.

‎src/pl/plperl/plc_perlboot.pl

Lines changed: 15 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -1,26 +1,30 @@
11

2-
# $PostgreSQL: pgsql/src/pl/plperl/plc_perlboot.pl,v 1.4 2010/01/30 01:46:57 adunstan Exp $
2+
# $PostgreSQL: pgsql/src/pl/plperl/plc_perlboot.pl,v 1.5 2010/02/16 21:39:52 adunstan Exp $
3+
4+
use 5.008001;
35

46
PostgreSQL::InServer::Util::bootstrap();
57

8+
package PostgreSQL::InServer;
9+
610
use strict;
711
use warnings;
812
use vars qw(%_SHARED);
913

10-
sub ::plperl_warn {
14+
sub plperl_warn {
1115
(my $msg = shift) =~ s/\(eval \d+\) //g;
1216
chomp $msg;
13-
&elog(&NOTICE, $msg);
17+
&::elog(&::WARNING, $msg);
1418
}
15-
$SIG{__WARN__} = \&::plperl_warn;
19+
$SIG{__WARN__} = \&plperl_warn;
1620

17-
sub ::plperl_die {
21+
sub plperl_die {
1822
(my $msg = shift) =~ s/\(eval \d+\) //g;
1923
die $msg;
2024
}
21-
$SIG{__DIE__} = \&::plperl_die;
25+
$SIG{__DIE__} = \&plperl_die;
2226

23-
sub ::mkfuncsrc {
27+
sub mkfuncsrc {
2428
my ($name, $imports, $prolog, $src) = @_;
2529

2630
my $BEGIN = join "\n", map {
@@ -32,13 +36,13 @@ sub ::mkfuncsrc {
3236
$name =~ s/\\/\\\\/g;
3337
$name =~ s/::|'/_/g; # avoid package delimiters
3438

35-
return qq[ undef *{'$name'}; *{'$name'} = sub { $BEGIN $prolog $src } ];
39+
return qq[ package main; undef *{'$name'}; *{'$name'} = sub { $BEGIN $prolog $src } ];
3640
}
3741

3842
# see also mksafefunc() in plc_safe_ok.pl
39-
sub ::mkunsafefunc {
43+
sub mkunsafefunc {
4044
no strict; # default to no strict for the eval
41-
my $ret = eval(::mkfuncsrc(@_));
45+
my $ret = eval(mkfuncsrc(@_));
4246
$@ =~ s/\(eval \d+\) //g if $@;
4347
return $ret;
4448
}
@@ -67,7 +71,7 @@ sub ::encode_array_literal {
6771

6872
sub ::encode_array_constructor {
6973
my $arg = shift;
70-
return quote_nullable($arg)
74+
return ::quote_nullable($arg)
7175
if ref $arg ne 'ARRAY';
7276
my $res = join ", ", map {
7377
(ref $_) ? ::encode_array_constructor($_)

‎src/pl/plperl/plc_safe_ok.pl

Lines changed: 81 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -1,43 +1,95 @@
11

22

3-
# $PostgreSQL: pgsql/src/pl/plperl/plc_safe_ok.pl,v 1.4 2010/02/12 19:35:25 adunstan Exp $
3+
# $PostgreSQL: pgsql/src/pl/plperl/plc_safe_ok.pl,v 1.5 2010/02/16 21:39:52 adunstan Exp $
44

5+
package PostgreSQL::InServer::safe;
6+
57
use strict;
6-
use vars qw($PLContainer);
8+
use warnings;
9+
use Safe;
10+
11+
# @EvalInSafe = ( [ "string to eval", "extra,opcodes,to,allow" ], ...)
12+
# @ShareIntoSafe = ( [ from_class => \@symbols ], ...)
13+
14+
# these are currently declared "my" so they can't be monkeyed with using init
15+
# code. If we later decide to change that policy, we could change one or more
16+
# to make them visible by using "use vars".
17+
my($PLContainer,$SafeClass,@EvalInSafe,@ShareIntoSafe);
18+
19+
# --- configuration ---
20+
21+
# ensure we only alter the configuration variables once to avoid any
22+
# problems if this code is run multiple times due to an exception generated
23+
# from plperl.on_trusted_init code leaving the interp_state unchanged.
24+
25+
if (not our $_init++) {
26+
27+
# Load widely useful pragmas into the container to make them available.
28+
# These must be trusted to not expose a way to execute a string eval
29+
# or any kind of unsafe action that the untrusted code could exploit.
30+
# If in ANY doubt about a module then DO NOT add it to this list.
31+
32+
unshift @EvalInSafe,
33+
[ 'require strict', 'caller' ],
34+
[ 'require Carp', 'caller,entertry' ], # load Carp before warnings
35+
[ 'require warnings', 'caller' ];
36+
push @EvalInSafe,
37+
[ 'require feature' ] if $] >= 5.010000;
38+
39+
push @ShareIntoSafe, [
40+
main => [ qw(
41+
&elog &DEBUG &LOG &INFO &NOTICE &WARNING &ERROR
42+
&spi_query &spi_fetchrow &spi_cursor_close &spi_exec_query
43+
&spi_prepare &spi_exec_prepared &spi_query_prepared &spi_freeplan
44+
&return_next &_SHARED
45+
&quote_literal &quote_nullable &quote_ident
46+
&encode_bytea &decode_bytea &looks_like_number
47+
&encode_array_literal &encode_array_constructor
48+
) ],
49+
];
50+
}
51+
52+
# --- create and initialize a new container ---
53+
54+
$SafeClass ||= 'Safe';
55+
$PLContainer = $SafeClass->new('PostgreSQL::InServer::safe_container');
756

8-
$PLContainer = new Safe('PLPerl');
957
$PLContainer->permit_only(':default');
1058
$PLContainer->permit(qw[:base_math !:base_io sort time require]);
1159

12-
$PLContainer->share(qw[&elog &return_next
13-
&spi_query &spi_fetchrow &spi_cursor_close &spi_exec_query
14-
&spi_prepare &spi_exec_prepared &spi_query_prepared &spi_freeplan
15-
&DEBUG &LOG &INFO &NOTICE &WARNING &ERROR %_SHARED
16-
&quote_literal &quote_nullable &quote_ident
17-
&encode_bytea &decode_bytea
18-
&encode_array_literal &encode_array_constructor
19-
&looks_like_number
20-
]);
21-
22-
# Load widely useful pragmas into the container to make them available.
23-
# (Temporarily enable caller here as work around for bug in perl 5.10,
24-
# which changed the way its Safe.pm works. It is quite safe, as caller is
25-
# informational only.)
26-
$PLContainer->permit(qw[caller]);
27-
::safe_eval(q{
28-
require strict;
29-
require feature if $] >= 5.010000;
30-
1;
31-
}) or die $@;
32-
$PLContainer->deny(qw[caller]);
33-
34-
# called directly for plperl.on_plperl_init
35-
sub ::safe_eval {
60+
for my $do (@EvalInSafe) {
61+
my $perform = sub { # private closure
62+
my ($container, $src, $ops) = @_;
63+
my $mask = $container->mask;
64+
$container->permit(split /\s*,\s*/, $ops);
65+
my $ok = safe_eval("$src; 1");
66+
$container->mask($mask);
67+
main::elog(main::ERROR(), "$src failed: $@") unless $ok;
68+
};
69+
70+
my $ops = $do->[1] || '';
71+
# For old perls we add entereval if entertry is listed
72+
# due to http://rt.perl.org/rt3/Ticket/Display.html?id=70970
73+
# Testing with a recent perl (>=5.11.4) ensures this doesn't
74+
# allow any use of actual entereval (eval "...") opcodes.
75+
$ops = "entereval,$ops"
76+
if $] < 5.011004 and $ops =~ /\bentertry\b/;
77+
78+
$perform->($PLContainer, $do->[0], $ops);
79+
}
80+
81+
$PLContainer->share_from(@$_) for @ShareIntoSafe;
82+
83+
84+
# --- runtime interface ---
85+
86+
# called directly for plperl.on_trusted_init and @EvalInSafe
87+
sub safe_eval {
3688
my $ret = $PLContainer->reval(shift);
3789
$@ =~ s/\(eval \d+\) //g if $@;
3890
return $ret;
3991
}
4092

41-
sub ::mksafefunc {
42-
return ::safe_eval(::mkfuncsrc(@_));
93+
sub mksafefunc {
94+
! return safe_eval(PostgreSQL::InServer::mkfuncsrc(@_));
4395
}

‎src/pl/plperl/plperl.c

Lines changed: 13 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
/**********************************************************************
22
* plperl.c - perl as a procedural language for PostgreSQL
33
*
4-
* $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.167 2010/02/15 22:23:25 alvherre Exp $
4+
* $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.168 2010/02/16 21:39:52 adunstan Exp $
55
*
66
**********************************************************************/
77

@@ -365,8 +365,6 @@ select_perl_context(bool trusted)
365365
{
366366
/* first actual use of a perl interpreter */
367367

368-
on_proc_exit(plperl_fini, 0);
369-
370368
if (trusted)
371369
{
372370
plperl_trusted_init();
@@ -379,6 +377,10 @@ select_perl_context(bool trusted)
379377
plperl_untrusted_interp = plperl_held_interp;
380378
interp_state = INTERP_UNTRUSTED;
381379
}
380+
381+
/* successfully initialized, so arrange for cleanup */
382+
on_proc_exit(plperl_fini, 0);
383+
382384
}
383385
else
384386
{
@@ -673,14 +675,16 @@ plperl_trusted_init(void)
673675
SV *safe_version_sv;
674676
IV safe_version_x100;
675677

676-
safe_version_sv = eval_pv(SAFE_MODULE, FALSE); /* TRUE = croak if failure */
678+
safe_version_sv = eval_pv(SAFE_MODULE, FALSE);/* TRUE = croak if failure */
677679
safe_version_x100 = (int)(SvNV(safe_version_sv) * 100);
678680

679681
/*
680682
* Reject too-old versions of Safe and some others:
681683
* 2.20: http://rt.perl.org/rt3/Ticket/Display.html?id=72068
684+
* 2.21: http://rt.perl.org/rt3/Ticket/Display.html?id=72700
682685
*/
683-
if (safe_version_x100 < 209 || safe_version_x100 == 220)
686+
if (safe_version_x100 < 209 || safe_version_x100 == 220 ||
687+
safe_version_x100 == 221)
684688
{
685689
/* not safe, so disallow all trusted funcs */
686690
eval_pv(PLC_SAFE_BAD, FALSE);
@@ -722,7 +726,7 @@ plperl_trusted_init(void)
722726
XPUSHs(sv_2mortal(newSVstring(plperl_on_plperl_init)));
723727
PUTBACK;
724728

725-
call_pv("::safe_eval", G_VOID);
729+
call_pv("PostgreSQL::InServer::safe::safe_eval", G_VOID);
726730
SPAGAIN;
727731

728732
if (SvTRUE(ERRSV))
@@ -1259,7 +1263,9 @@ plperl_create_sub(plperl_proc_desc *prodesc, char *s, Oid fn_oid)
12591263
* errors properly. Perhaps it's because there's another level of eval
12601264
* inside mksafefunc?
12611265
*/
1262-
compile_sub = (trusted) ? "::mksafefunc" : "::mkunsafefunc";
1266+
compile_sub = (trusted)
1267+
? "PostgreSQL::InServer::safe::mksafefunc"
1268+
: "PostgreSQL::InServer::mkunsafefunc";
12631269
count = perl_call_pv(compile_sub, G_SCALAR | G_EVAL | G_KEEPERR);
12641270
SPAGAIN;
12651271

‎src/pl/plperl/sql/plperl.sql

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -378,3 +378,7 @@ DO $$ use blib; $$ LANGUAGE plperl;
378378
-- runtime error: "Can't use string ("foo") as a SCALAR ref while "strict refs" in use
379379
DO $do$ use strict; my $name = "foo"; my $ref = $$name; $do$ LANGUAGE plperl;
380380

381+
-- check that we can "use warnings" (in this case to turn a warn into an error)
382+
-- yields "ERROR: Useless use of length in void context"
383+
DO $do$ use warnings FATAL => qw(void) ; length "abc" ; 1; $do$ LANGUAGE plperl;
384+

0 commit comments

Comments
 (0)