--- loncom/xml/Safe.pm 2002/10/22 15:59:44 1.5 +++ loncom/xml/Safe.pm 2003/08/30 02:26:37 1.6 @@ -2,9 +2,8 @@ package Safe; use 5.003_11; use strict; -use vars qw($VERSION); -$VERSION = "2.062"; +$Safe::VERSION = "2.09"; use Carp; @@ -48,6 +47,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}) if($Opcode::VERSION > 1.04); return $obj; } @@ -155,7 +155,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 +190,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); @@ -208,17 +208,17 @@ sub varglob { sub reval { - my ($obj, $__SAFE_LOCAL_expr, $strict) = @_; + 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 $__SAFE_LOCAL_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); } @@ -228,7 +228,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); } @@ -380,11 +380,12 @@ respectfully. =item share (NAME, ...) This shares the variable(s) in the argument list with the compartment. -This is almost identical to exporting variables using the L +This is almost identical to exporting variables using the L module. -Each NAME must be the B of a variable, typically with the leading -type identifier included. A bareword is treated as a function name. +Each NAME must be the B of a non-lexical variable, typically +with the leading type identifier included. A bareword is treated as a +function name. Examples of legal names are '$foo' for a scalar, '@foo' for an array, '%foo' for a hash, '&foo' or 'foo' for a subroutine and '*foo' @@ -426,7 +427,7 @@ C package to the code inside the Any attempt by the code in STRING to use an operator which is not permitted by the compartment will cause an error (at run-time of the main program but at compile-time for the code in STRING). The error is of the form -"%s trapped by operation mask operation...". +"'%s' trapped by operation mask...". If an operation is trapped in this way, then the code in STRING will not be executed. If such a trapped operation occurs or any other