X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FOpcode%2FSafe.pm;h=5036943cd72c0edda276198c9eea12ea8c93af36;hb=76df5e8f6f9a368c3b6f3dcca177104be7f3fc8c;hp=8d875ef5b2df8f1fcd03eb7a593562e11432ef5d;hpb=33f7e1aa9bf0173d92dc0c0b35d57754dbf6c87e;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/ext/Opcode/Safe.pm b/ext/Opcode/Safe.pm
index 8d875ef..5036943 100644
--- a/ext/Opcode/Safe.pm
+++ b/ext/Opcode/Safe.pm
@@ -3,7 +3,27 @@ package Safe;
 use 5.003_11;
 use strict;
 
-our $VERSION = "2.07";
+$Safe::VERSION = "2.10";
+
+# *** Don't declare any lexicals above this point ***
+#
+# This function should return a closure which contains an eval that can't
+# see any lexicals in scope (apart from __ExPr__ which is unavoidable)
+
+sub lexless_anon_sub {
+		 # $_[0] is package;
+		 # $_[1] is strict flag;
+    my $__ExPr__ = $_[2];   # must be a lexical to create the closure that
+			    # can be used to pass the value into the safe
+			    # world
+
+    # Create anon sub ref in root of compartment.
+    # Uses a closure (on $__ExPr__) to pass in the code to be executed.
+    # (eval on one line to keep line numbers as expected by caller)
+    eval sprintf
+    'package %s; %s strict; sub { @_=(); eval q[my $__ExPr__;] . $__ExPr__; }',
+		$_[0], $_[1] ? 'use' : 'no';
+}
 
 use Carp;
 
@@ -47,7 +67,7 @@ sub new {
     # the whole glob *_ rather than $_ and @_ separately, otherwise
     # @_ in non default packages within the compartment don't work.
     $obj->share_from('main', $default_share);
-    Opcode::_safe_pkg_prep($obj->{Root});
+    Opcode::_safe_pkg_prep($obj->{Root}) if($Opcode::VERSION > 1.04);
     return $obj;
 }
 
@@ -155,7 +175,7 @@ sub share_from {
     my $no_record = shift || 0;
     my $root = $obj->root();
     croak("vars not an array ref") unless ref $vars eq 'ARRAY';
-	no strict 'refs';
+    no strict 'refs';
     # Check that 'from' package actually exists
     croak("Package \"$pkg\" does not exist")
 	unless keys %{"$pkg\::"};
@@ -190,7 +210,7 @@ sub share_record {
 sub share_redo {
     my $obj = shift;
     my $shares = \%{$obj->{Shares} ||= {}};
-	my($var, $pkg);
+    my($var, $pkg);
     while(($var, $pkg) = each %$shares) {
 	# warn "share_redo $pkg\:: $var";
 	$obj->share_from($pkg,  [ $var ], 1);
@@ -211,15 +231,7 @@ sub reval {
     my ($obj, $expr, $strict) = @_;
     my $root = $obj->{Root};
 
-    # Create anon sub ref in root of compartment.
-    # Uses a closure (on $expr) to pass in the code to be executed.
-    # (eval on one line to keep line numbers as expected by caller)
-    my $evalcode = sprintf('package %s; sub { @_ = (); eval $expr; }', $root);
-    my $evalsub;
-
-    if ($strict) { use strict; $evalsub = eval $evalcode; }
-    else         {  no strict; $evalsub = eval $evalcode; }
-
+    my $evalsub = lexless_anon_sub($root,$strict, $expr);
     return Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub);
 }
 
@@ -228,7 +240,7 @@ sub rdo {
     my $root = $obj->{Root};
 
     my $evalsub = eval
-	    sprintf('package %s; sub { do $file }', $root);
+	    sprintf('package %s; sub { @_ = (); do $file }', $root);
     return Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub);
 }