perl-Safe.patch

   1 --- perl-5.6.1.orig/ext/Opcode/Safe.pm
   2 +++ perl-5.6.1/ext/Opcode/Safe.pm
   3 @@ -3,7 +3,7 @@
   4  use 5.003_11;
   5  use strict;
   6
   7 -our $VERSION = "2.06";
   8 +$Safe::VERSION = "2.09";
   9
  10  use Carp;
  11
  12 @@ -47,6 +47,7 @@
  13      # the whole glob *_ rather than $_ and @_ separately, otherwise
  14      # @_ in non default packages within the compartment don't work.
  15      $obj->share_from('main', $default_share);
  16 +    Opcode::_safe_pkg_prep($obj->{Root}) if($Opcode::VERSION > 1.04);
  17      return $obj;
  18  }
  19
  20 @@ -154,7 +155,7 @@
  21      my $no_record = shift || 0;
  22      my $root = $obj->root();
  23      croak("vars not an array ref") unless ref $vars eq 'ARRAY';
  24 -       no strict 'refs';
  25 +    no strict 'refs';
  26      # Check that 'from' package actually exists
  27      croak("Package \"$pkg\" does not exist")
  28         unless keys %{"$pkg\::"};
  29 @@ -189,7 +190,7 @@
  30  sub share_redo {
  31      my $obj = shift;
  32      my $shares = \%{$obj->{Shares} ||= {}};
  33 -       my($var, $pkg);
  34 +    my($var, $pkg);
  35      while(($var, $pkg) = each %$shares) {
  36         # warn "share_redo $pkg\:: $var";
  37         $obj->share_from($pkg,  [ $var ], 1);
  38 @@ -213,11 +214,11 @@
  39      # Create anon sub ref in root of compartment.
  40      # Uses a closure (on $expr) to pass in the code to be executed.
  41      # (eval on one line to keep line numbers as expected by caller)
  42 -       my $evalcode = sprintf('package %s; sub { eval $expr; }', $root);
  43 +    my $evalcode = sprintf('package %s; sub { @_ = (); eval $expr; }', $root);
  44      my $evalsub;
  45
  46 -       if ($strict) { use strict; $evalsub = eval $evalcode; }
  47 -       else         {  no strict; $evalsub = eval $evalcode; }
  48 +    if ($strict) { use strict; $evalsub = eval $evalcode; }
  49 +    else         {  no strict; $evalsub = eval $evalcode; }
  50
  51      return Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub);
  52  }
  53 @@ -227,7 +228,7 @@
  54      my $root = $obj->{Root};
  55
  56      my $evalsub = eval
  57 -           sprintf('package %s; sub { do $file }', $root);
  58 +           sprintf('package %s; sub { @_ = (); do $file }', $root);
  59      return Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub);
  60  }
  61
  62 @@ -379,11 +380,12 @@
  63  =item share (NAME, ...)
  64
  65  This shares the variable(s) in the argument list with the compartment.
  66 -This is almost identical to exporting variables using the L<Exporter(3)>
  67 +This is almost identical to exporting variables using the L<Exporter>
  68  module.
  69
  70 -Each NAME must be the B<name> of a variable, typically with the leading
  71 -type identifier included. A bareword is treated as a function name.
  72 +Each NAME must be the B<name> of a non-lexical variable, typically
  73 +with the leading type identifier included. A bareword is treated as a
  74 +function name.
  75
  76  Examples of legal names are '$foo' for a scalar, '@foo' for an
  77  array, '%foo' for a hash, '&foo' or 'foo' for a subroutine and '*foo'
  78 @@ -425,7 +427,7 @@
  79  Any attempt by the code in STRING to use an operator which is not permitted
  80  by the compartment will cause an error (at run-time of the main program
  81  but at compile-time for the code in STRING).  The error is of the form
  82 -"%s trapped by operation mask operation...".
  83 +"'%s' trapped by operation mask...".
  84
  85  If an operation is trapped in this way, then the code in STRING will
  86  not be executed. If such a trapped operation occurs or any other