Abandon the use of Perl's Safe.pm to enforce restrictions in plperl, as it is

fundamentally insecure. Instead apply an opmask to the whole interpreter that
imposes restrictions on unsafe operations. These restrictions are much harder
to subvert than is Safe.pm, since there is no container to be broken out of.
Backported to release 7.4.

In releases 7.4, 8.0 and 8.1 this also includes the necessary backporting of
the two interpreters model for plperl and plperlu adopted in release 8.2.

In versions 8.0 and up, the use of Perl's POSIX module to undo its locale
mangling on Windows has become insecure with these changes, so it is
replaced by our own routine, which is also faster.

Nice side effects of the changes include that it is now possible to use perl's
"strict" pragma in a natural way in plperl, and that perl's $a and
$b variables now work as expected in sort routines, and that function
compilation is significantly faster.

Tim Bunce and Andrew Dunstan, with reviews from Alex Hunsaker and
Alexey Klyukin.

Security: CVE-2010-1169

doc/src/sgml/plperl.sgml

-<!-- $PostgreSQL: pgsql/doc/src/sgml/plperl.sgml,v 2.83 2010/04/03 07:22:55 petere Exp $ -->
+<!-- $PostgreSQL: pgsql/doc/src/sgml/plperl.sgml,v 2.84 2010/05/13 16:39:43 adunstan Exp $ -->
 
  <chapter id="plperl">
   <title>PL/Perl - Perl Procedural Language</title>
@@ -1154,8 +1154,16 @@ CREATE TRIGGER test_valid_id_trig
        into a module and loaded by the <literal>on_init</> string.
        Examples:
 <programlisting>
-plperl.on_init = '$ENV{NYTPROF}="start=no"; require Devel::NYTProf::PgPLPerl'
+plperl.on_init = 'require "plperlinit.pl"'
 plperl.on_init = 'use lib "/my/app"; use MyApp::PgInit;'
+</programlisting>
+       </para>
+       <para>
+       Any modules loaded by <literal>plperl.on_init</>, either directly or
+       indirectly, will be available for use by <literal>plperl</>.  This may
+       create a security risk. To see what modules have been loaded you can use:
+<programlisting>
+DO 'elog(WARNING, join ", ", sort keys %INC)' language plperl;
 </programlisting>
        </para>
        <para>

src/pl/plperl/GNUmakefile

 # Makefile for PL/Perl
-# $PostgreSQL: pgsql/src/pl/plperl/GNUmakefile,v 1.43 2010/02/12 19:35:25 adunstan Exp $
+# $PostgreSQL: pgsql/src/pl/plperl/GNUmakefile,v 1.44 2010/05/13 16:39:43 adunstan Exp $
 
 subdir = src/pl/plperl
 top_builddir = ../../..
@@ -36,7 +36,7 @@ NAME = plperl
 
 OBJS = plperl.o SPI.o Util.o
 
-PERLCHUNKS = plc_perlboot.pl plc_safe_bad.pl plc_safe_ok.pl
+PERLCHUNKS = plc_perlboot.pl plc_trusted.pl
 
 SHLIB_LINK = $(perl_embed_ldflags)
 
@@ -54,9 +54,12 @@ PSQLDIR = $(bindir)
 
 include $(top_srcdir)/src/Makefile.shlib
 
-plperl.o: perlchunks.h
+plperl.o: perlchunks.h plperl_opmask.h
 
-perlchunks.h: $(PERLCHUNKS)
+plperl_opmask.h: plperl_opmask.pl
+	$(PERL) $< $@
+
+perlchunks.h: $(PERLCHUNKS) 
 	$(PERL) $(srcdir)/text2macro.pl --strip='^(\#.*|\s*)$$' $^ > $@
 
 all: all-lib
@@ -81,7 +84,7 @@ submake:
 	$(MAKE) -C $(top_builddir)/src/test/regress pg_regress$(X)
 
 clean distclean maintainer-clean: clean-lib
-	rm -f SPI.c Util.c $(OBJS) perlchunks.h
+	rm -f SPI.c Util.c $(OBJS) perlchunks.h plperl_opmask.h
 	rm -rf results
 	rm -f regression.diffs regression.out
 

src/pl/plperl/expected/plperl.out

@@ -563,8 +563,23 @@ $$ LANGUAGE plperl;
 NOTICE:  This is a test
 CONTEXT:  PL/Perl anonymous code block
 -- check that restricted operations are rejected in a plperl DO block
-DO $$ eval "1+1"; $$ LANGUAGE plperl;
-ERROR:  'eval "string"' trapped by operation mask at line 1.
+DO $$ system("/nonesuch"); $$ LANGUAGE plperl;
+ERROR:  'system' trapped by operation mask at line 1.
+CONTEXT:  PL/Perl anonymous code block
+DO $$ qx("/nonesuch"); $$ LANGUAGE plperl;
+ERROR:  'quoted execution (``, qx)' trapped by operation mask at line 1.
+CONTEXT:  PL/Perl anonymous code block
+DO $$ open my $fh, "</nonesuch"; $$ LANGUAGE plperl;
+ERROR:  'open' trapped by operation mask at line 1.
+CONTEXT:  PL/Perl anonymous code block
+-- check that eval is allowed and eval'd restricted ops are caught
+DO $$ eval q{chdir '.'}; warn "Caught: $@"; $$ LANGUAGE plperl;
+WARNING:  Caught: 'chdir' trapped by operation mask at line 2.
+CONTEXT:  PL/Perl anonymous code block
+-- check that compiling do (dofile opcode) is allowed
+-- but that executing it for a file not already loaded (via require) dies
+DO $$ warn do "/dev/null"; $$ LANGUAGE plperl;
+ERROR:  Unable to load /dev/null into plperl at line 1.
 CONTEXT:  PL/Perl anonymous code block
 -- check that we can't "use" a module that's not been loaded already
 -- compile-time error: "Unable to load blib.pm into plperl"

src/pl/plperl/expected/plperl_init.out

 -- test plperl.on_plperl_init errors are fatal
 -- Avoid need for custom_variable_classes = 'plperl'
 LOAD 'plperl';
-SET SESSION plperl.on_plperl_init = ' eval "1+1" ';
+SET SESSION plperl.on_plperl_init = ' system("/nonesuch") ';
 SHOW plperl.on_plperl_init;
  plperl.on_plperl_init 
 -----------------------
-  eval "1+1" 
+  system("/nonesuch") 
 (1 row)
 
 DO $$ warn 42 $$ language plperl;
-ERROR:  'eval "string"' trapped by operation mask at line 2.
-CONTEXT:  while executing plperl.on_plperl_init
+ERROR:  'system' trapped by operation mask at line 2.
+CONTEXT:  While executing plperl.on_plperl_init.
 PL/Perl anonymous code block

src/pl/plperl/expected/plperl_plperlu.out

@@ -63,3 +63,31 @@ select bar('hey');
  hey
 (1 row)
 
+--
+-- Make sure we can't use/require things in plperl
+--
+CREATE OR REPLACE FUNCTION use_plperlu() RETURNS void LANGUAGE plperlu
+AS $$
+use Errno;
+$$;
+CREATE OR REPLACE FUNCTION use_plperl() RETURNS void LANGUAGE plperl
+AS $$
+use Errno;
+$$;
+ERROR:  Unable to load Errno.pm into plperl at line 2.
+BEGIN failed--compilation aborted at line 2.
+CONTEXT:  compilation of PL/Perl function "use_plperl"
+-- make sure our overloaded require op gets restored/set correctly
+select use_plperlu();
+ use_plperlu 
+-------------
+ 
+(1 row)
+
+CREATE OR REPLACE FUNCTION use_plperl() RETURNS void LANGUAGE plperl
+AS $$
+use Errno;
+$$;
+ERROR:  Unable to load Errno.pm into plperl at line 2.
+BEGIN failed--compilation aborted at line 2.
+CONTEXT:  compilation of PL/Perl function "use_plperl"

src/pl/plperl/plc_perlboot.pl

 
-#  $PostgreSQL: pgsql/src/pl/plperl/plc_perlboot.pl,v 1.5 2010/02/16 21:39:52 adunstan Exp $
+#  $PostgreSQL: pgsql/src/pl/plperl/plc_perlboot.pl,v 1.6 2010/05/13 16:39:43 adunstan Exp $
 
 use 5.008001;
 
@@ -33,15 +33,12 @@ sub mkfuncsrc {
 	} sort keys %$imports;
 	$BEGIN &&= "BEGIN { $BEGIN }";
 
-	$name =~ s/\\/\\\\/g;
-	$name =~ s/::|'/_/g; # avoid package delimiters
-
-	return qq[ package main; undef *{'$name'}; *{'$name'} = sub { $BEGIN $prolog $src } ];
+	return qq[ package main; sub { $BEGIN $prolog $src } ];
 }
 
-# see also mksafefunc() in plc_safe_ok.pl
-sub mkunsafefunc {
-	no strict; # default to no strict for the eval
+sub mkfunc {
+	no strict;   # default to no strict for the eval
+	no warnings; # default to no warnings for the eval
 	my $ret = eval(mkfuncsrc(@_));
 	$@ =~ s/\(eval \d+\) //g if $@;
 	return $ret;

src/pl/plperl/plc_safe_bad.pl

-
-#  $PostgreSQL: pgsql/src/pl/plperl/plc_safe_bad.pl,v 1.3 2010/01/26 23:11:56 adunstan Exp $
-
-# Minimal version of plc_safe_ok.pl
-# that's used if Safe is too old or doesn't load for any reason
-
-my $msg = 'trusted Perl functions disabled - please upgrade Perl Safe module';
-
-sub mksafefunc {
-	my ($name, $pragma, $prolog, $src) = @_;
-	# replace $src with code to generate an error
-	$src = qq{ ::elog(::ERROR,"$msg\n") };
-	my $ret = eval(::mkfuncsrc($name, $pragma, '', $src));
-	$@ =~ s/\(eval \d+\) //g if $@;
-	return $ret;
-}

src/pl/plperl/plc_safe_ok.pl

-
-
-#  $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 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
-          &quote_literal &quote_nullable &quote_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(@_));
-}

src/pl/plperl/plc_trusted.pl

+
+
+#  $PostgreSQL: pgsql/src/pl/plperl/plc_trusted.pl,v 1.1 2010/05/13 16:39:43 adunstan Exp $
+
+package PostgreSQL::InServer::safe;
+ 
+# Load widely useful pragmas into plperl to make them available.
+#
+# SECURITY RISKS:
+#
+# Since these modules are free to compile unsafe opcodes they must
+# be trusted to now allow any code containing unsafe opcodes to be abused.
+# That's much harder than it sounds.
+#
+# Be aware that perl provides a wide variety of ways to subvert
+# pre-compiled code. For some examples, see this presentation:
+# http://www.slideshare.net/cdman83/barely-legal-xxx-perl-presentation
+#
+# If in ANY doubt about a module, or ANY of the modules down the chain of
+# dependencies it loads, then DO NOT add it to this list.
+#
+# To check if any of these modules use "unsafe" opcodes you can compile
+# plperl with the PLPERL_ENABLE_OPMASK_EARLY macro defined. See plperl.c
+
+require strict;
+require Carp;
+require Carp::Heavy;
+require warnings;
+require feature if $] >= 5.010000;

src/pl/plperl/plperl_opmask.pl

+#!perl -w
+
+use strict;
+use warnings;
+
+use Opcode qw(opset opset_to_ops opdesc);
+
+my $plperl_opmask_h   = shift
+	or die "Usage: $0 <output_filename.h>\n";
+
+my $plperl_opmask_tmp = $plperl_opmask_h."tmp";
+END { unlink $plperl_opmask_tmp }
+
+open my $fh, ">", "$plperl_opmask_tmp"
+	or die "Could not write to $plperl_opmask_tmp: $!";
+
+printf $fh "#define PLPERL_SET_OPMASK(opmask) \\\n";
+printf $fh "  memset(opmask, 1, MAXO);\t/* disable all */ \\\n";
+printf $fh "  /* then allow some... */                       \\\n";
+
+my @allowed_ops = (
+	# basic set of opcodes
+	qw[:default :base_math !:base_io sort time],
+	# require is safe because we redirect the opcode
+	# entereval is safe as the opmask is now permanently set
+	# caller is safe because the entire interpreter is locked down
+	qw[require entereval caller],
+	# These are needed for utf8_heavy.pl:
+	# dofile is safe because we redirect the opcode like require above
+	# print is safe because the only writable filehandles are STDOUT & STDERR
+	# prtf (printf) is safe as it's the same as print + sprintf
+	qw[dofile print prtf],
+	# Disallow these opcodes that are in the :base_orig optag
+	# (included in :default) but aren't considered sufficiently safe
+	qw[!dbmopen !setpgrp !setpriority],
+	# custom is not deemed a likely security risk as it can't be generated from
+	# perl so would only be seen if the DBA had chosen to load a module that
+	# used it. Even then it's unlikely to be seen because it's typically
+	# generated by compiler plugins that operate after PL_op_mask checks.
+	# But we err on the side of caution and disable it
+	qw[!custom],
+);
+
+printf $fh "  /* ALLOWED: @allowed_ops */ \\\n";
+
+foreach my $opname (opset_to_ops(opset(@allowed_ops))) {
+	printf $fh qq{  opmask[OP_%-12s] = 0;\t/* %s */ \\\n},
+		uc($opname), opdesc($opname);
+}
+printf $fh "  /* end */ \n";
+
+close $fh
+	or die "Error closing $plperl_opmask_tmp: $!";
+
+rename $plperl_opmask_tmp, $plperl_opmask_h
+	or die "Error renaming $plperl_opmask_tmp to $plperl_opmask_h: $!";
+
+exit 0;

src/pl/plperl/sql/plperl.sql

@@ -368,7 +368,16 @@ DO $$
 $$ LANGUAGE plperl;
 
 -- check that restricted operations are rejected in a plperl DO block
-DO $$ eval "1+1"; $$ LANGUAGE plperl;
+DO $$ system("/nonesuch"); $$ LANGUAGE plperl;
+DO $$ qx("/nonesuch"); $$ LANGUAGE plperl;
+DO $$ open my $fh, "</nonesuch"; $$ LANGUAGE plperl;
+
+-- check that eval is allowed and eval'd restricted ops are caught
+DO $$ eval q{chdir '.'}; warn "Caught: $@"; $$ LANGUAGE plperl;
+
+-- check that compiling do (dofile opcode) is allowed
+-- but that executing it for a file not already loaded (via require) dies
+DO $$ warn do "/dev/null"; $$ LANGUAGE plperl;
 
 -- check that we can't "use" a module that's not been loaded already
 -- compile-time error: "Unable to load blib.pm into plperl"

src/pl/plperl/sql/plperl_init.sql

@@ -3,7 +3,7 @@
 -- Avoid need for custom_variable_classes = 'plperl'
 LOAD 'plperl';
 
-SET SESSION plperl.on_plperl_init = ' eval "1+1" ';
+SET SESSION plperl.on_plperl_init = ' system("/nonesuch") ';
 
 SHOW plperl.on_plperl_init;
 

src/pl/plperl/sql/plperl_plperlu.sql

@@ -35,3 +35,24 @@ select bar('hey');
 create or replace function bar(text) returns text language plperlu as 'shift';
 select bar('hey');
 
+--
+-- Make sure we can't use/require things in plperl
+--
+
+CREATE OR REPLACE FUNCTION use_plperlu() RETURNS void LANGUAGE plperlu
+AS $$
+use Errno;
+$$;
+
+CREATE OR REPLACE FUNCTION use_plperl() RETURNS void LANGUAGE plperl
+AS $$
+use Errno;
+$$;
+
+-- make sure our overloaded require op gets restored/set correctly
+select use_plperlu();
+
+CREATE OR REPLACE FUNCTION use_plperl() RETURNS void LANGUAGE plperl
+AS $$
+use Errno;
+$$;