diff options
| author | Gisle Aas <gisle@aas.no> | 2000-08-29 10:35:06 +0000 |
|---|---|---|
| committer | Jarkko Hietaniemi <jhi@iki.fi> | 2000-08-29 14:05:50 +0000 |
| commit | 9422300e7fb488dd66f89e285c39865f7a8215c8 (patch) | |
| tree | 19457d79093bba9c90707f0ee943cc4bccbc6b3e /ext/Opcode | |
| parent | 12c1803965f7642a849d153e065f67f3bf7bde3b (diff) | |
| download | perl-9422300e7fb488dd66f89e285c39865f7a8215c8.tar.gz | |
[ID 20000829.004] Sharing leak root name into safe compartment
Message-Id: <20000829103506.21538.qmail@eik.g.aas.no>
p4raw-id: //depot/perl@6882
Diffstat (limited to 'ext/Opcode')
| -rw-r--r-- | ext/Opcode/Safe.pm | 9 |
1 files changed, 5 insertions, 4 deletions
diff --git a/ext/Opcode/Safe.pm b/ext/Opcode/Safe.pm index 7e1d6a34a7..21121f5e3f 100644 --- a/ext/Opcode/Safe.pm +++ b/ext/Opcode/Safe.pm @@ -167,13 +167,14 @@ sub share_from { my ($var, $type); $type = $1 if ($var = $arg) =~ s/^(\W)//; # warn "share_from $pkg $type $var"; - *{$root."::$var"} = (!$type) ? \&{$pkg."::$var"} + my $obj_to_share = (!$type) ? \&{$pkg."::$var"} : ($type eq '&') ? \&{$pkg."::$var"} : ($type eq '$') ? \${$pkg."::$var"} : ($type eq '@') ? \@{$pkg."::$var"} : ($type eq '%') ? \%{$pkg."::$var"} : ($type eq '*') ? *{$pkg."::$var"} : croak(qq(Can't share "$type$var" of unknown type)); + Opcode::_safe_call_sv($root, $obj->{Mask}, sub { *{$var} = $obj_to_share }); } $obj->share_record($pkg, $vars) unless $no_record or !$vars; } @@ -213,11 +214,11 @@ sub reval { # 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 $evalcode = sprintf('package %s; sub { eval $expr; }', $root); my $evalsub; - if ($strict) { use strict; $evalsub = eval $evalcode; } - else { no strict; $evalsub = eval $evalcode; } + if ($strict) { use strict; $evalsub = eval $evalcode; } + else { no strict; $evalsub = eval $evalcode; } return Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub); } |