Re: plperl & sort - Mailing list pgsql-bugs

On Tue, Nov 4, 2008 at 14:43, Andrew Dunstan <andrew@dunslane.net> wrote:
>
> We need to document that, and given that this exists I think we don't need
> to backpatch old versions.

Agreed.

> Beyond that, we need to be very careful with any "solution" that we don't
> upset the moderately fragile security of trusted plperl, and I'm going to
> look fairly skeptically at anything that changes the way we set up and call
> functions. But by all means if you can come up with a robust way of allowing
> the more traditional way of calling sort routines, send it in.

Well its not just sort its anything that uses main:: right?

>Sharing
> globals between the Safe and non-Safe worlds is not a solution - we removed
> an instance of that not long ago for security reasons.

Oh defiantly :) just tossing out ideas.  Instead of storing the sub we
could just call Safe::reval() everytime... that seems the safest way
to me.

The other idea Ive been toying this is instead of calling reval we can
just call Opcode::_safe_call_sv() something like the below:

I verified it on perl 5.10.0 only but I looked at 5.8.8 and those
routines in Safe.pm are the same so it should be relatively safe...
Note this is *exactly* what reval does except we already do our own
strict import. and it only works for CODE refs.

*** a/src/pl/plperl/plperl.c
--- b/src/pl/plperl/plperl.c
***************
*** 283,295 **** _PG_init(void)
      "&_plperl_to_pg_array " \
      "&DEBUG &LOG &INFO &NOTICE &WARNING &ERROR %_SHARED ]);" \
      "sub ::mksafefunc {" \
!     "      my $ret = $PLContainer->reval(qq[sub { $_[0] $_[1] }]); " \
!     "      $@ =~ s/\\(eval \\d+\\) //g if $@; return $ret; }" \
      "$PLContainer->permit(qw[require caller]); $PLContainer->reval('use
strict;');" \
      "$PLContainer->deny(qw[require caller]); " \
      "sub ::mk_strict_safefunc {" \
!     "      my $ret = $PLContainer->reval(qq[sub { BEGIN {
strict->import(); } $_[0] $_[1] }]); " \
!     "      $@ =~ s/\\(eval \\d+\\) //g if $@; return $ret; }"

  #define SAFE_BAD \
      "use vars qw($PLContainer); $PLContainer = new Safe('PLPerl');" \
--- 283,299 ----
      "&_plperl_to_pg_array " \
      "&DEBUG &LOG &INFO &NOTICE &WARNING &ERROR %_SHARED ]);" \
      "sub ::mksafefunc {" \
!     "      my $__ExPr__ = $PLContainer->reval(qq[sub { $_[0] $_[1] }]); " \
!     "      $@ =~ s/\\(eval \\d+\\) //g if $@; " \
!     "      my $sub = eval 'package '. $PLContainer->{Root} .'; sub {
@_=(); $__ExPr__->(); }'; " \
!     "      return sub { Opcode::_safe_call_sv($PLContainer->{Root},
$PLContainer->{Mask}, $sub); }; } "\
      "$PLContainer->permit(qw[require caller]); $PLContainer->reval('use
strict;');" \
      "$PLContainer->deny(qw[require caller]); " \
      "sub ::mk_strict_safefunc {" \
!     "      my $__ExPr__ = $PLContainer->reval(qq[sub { BEGIN {
strict->import(); } $_[0] $_[1] }]); " \
!     "      $@ =~ s/\\(eval \\d+\\) //g if $@; "\
!     "      my $sub = eval 'package '. $PLContainer->{Root} .'; sub {
@_=(); $__ExPr__->(); }'; " \
!     "      return sub { Opcode::_safe_call_sv($PLContainer->{Root},
$PLContainer->{Mask}, $sub); }; }"

  #define SAFE_BAD \
      "use vars qw($PLContainer); $PLContainer = new Safe('PLPerl');" \