> "guy@albertelli.com (via RT)" wrote:
> [snip]
> > The reval method of a Safe object bleeds the local variables into
> > the expression being evaled.
> > 
> > Example:
> > ----
> > #!/usr/bin/perl
> > use Safe;
> > $safe=new Safe;
> > print("Test 1 is ".$safe->reval('return $expr;')."\n");
> > print("Test 2 is" .$safe->reval('return $expe;')."\n");
> > ----
> > 
> > Incorrectly prints:
> > Test 1 is return $expr;
> > Test 2 is
> > 
> > Rather than the correct:
> > Test 1 is
> > Test 2 is
> > 
> > This occurs for all of the local variables in reval.
> 
> Not just those, but *all* lexicals that have been declared at that time.
> 
> Including $default_root and $default_share.  I can imagine someone
> changing $default_share to ['*main::'], and then taking advantage of that
> the next time a new safe is created.  Brr.

Dosen't seem to bleed default_root or default_share, and the bleed of
things other than expr is a perl 5.8.1 ism:

Test script:
use strict;
use Safe;
print $]."\n";
my $safe=new Safe;

foreach my $name ('default_root','default_share','expr','obj','strict','root','evalcode','evalsub') {
    print("Test $name is :".$safe->reval('return $'.$name.';').":\n");
}


5.008001
Test default_root is ::
Test default_share is ::
Test expr is :return $expr;:
Test obj is :Safe=HASH(0x9f2bd28):
Test strict is ::
Test root is :Safe::Root0:
Test evalcode is :package Safe::Root0; sub { @_ = (); eval $expr; }:
Test evalsub is :CODE(0x9f45d0c):

5.008
Test default_root is ::
Test default_share is ::
Test expr is :return $expr;:
Test obj is ::
Test strict is ::
Test root is ::
Test evalcode is ::
Test evalsub is ::

5.006001
Test default_root is ::
Test default_share is ::
Test expr is :return $expr;:
Test obj is ::
Test strict is ::
Test root is ::
Test evalcode is ::
Test evalsub is ::


In theory I agree, but in practice it doesn't look to be an issue.

(And what changed in 5.8.1 to make this "break" more?)

> 
> > I suggest modifying the reval Subroutine to be:
> > 
> > sub reval {
> >     $Safe::evalsub;
> >     {
> >         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; }', $obj->{Root});
> > 
> >         if ($strict) { use strict; $Safe::evalsub = eval $evalcode; }
> >         else         {  no strict; $Safe::evalsub = eval $evalcode; }
> >     }
> >     return Opcode::_safe_call_sv($_[0]->{Root}, $_[0]->{Mask}, $Safe::evalsub);
> > }
> 
> I don't think that changing the $evalsub variable from a lexical to a
> package variable will prevent the problem.  In fact, I don't see how it
> could possibly do so.


I understand why you say that, but it does succeed as $default_root,
$default_share are unviewable.


> 
> A correct solution would be to perform the eval at a point in time when
> there *are* no lexicals.
> 
> I would suggest that we have near the beginning of package Safe, before
> any lexicals are declared, two subs, like:
> 
>    sub _eval_no_lexicals_strict  { use strict; eval shift }
>    sub _eval_no_lexicals_nostrict { no strict; eval shift }
> 
> Then, later on, you'd have:
> 
>    my $evaler = $strict ? \&_eval_no_lexicals_strict :
>                           \&_eval_no_lexicals_nostrict;
>    my $evalsub = $evaler->($evalcode);

I tried this, I doesn't seem to get it to work.

I put the above subs in Safe.pm right about the default_root
declaration, and set reval to :

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 $evaler = $strict ? \&_eval_no_lexicals_strict :
                           \&_eval_no_lexicals_nostrict;
    my $evalsub = $evaler->($evalcode);

    return Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub);
}



With this test script:

use strict;
use lib '/home/httpd/lib/perl';
use Safe;
print $]."\n";
my $safe=new Safe;

print("Test a is :".$safe->reval('$a=1;return $a;').":\n");
print(" Eval errors :$@:\n");

I get:

5.008001
Test a is ::
 Eval errors ::


I can't get it to generate any warning or errors.


> 
> An even safer solution might be to get the code evaluated through perl's
> do EXPR mechanism, to *guarantee* that it's given a fresh clean lexical
> scope (and nothing in $^H or %^H to fiddle with).
> 
> This could be done with something like:
> 
>    unshift @INC, sub {
>       shift @INC;
>       return IO::Scalar->new(\$evalcode);
>    };
>    my $evalsub = do "(safeeval $n)";
> 
> Alas, this would probably be too much overhead... Especially when putting
> two subs, _eval_no_lexicals_(no)?strict, near the top of Safe.pm, will
> suffice for most purposes.  At least, it will until someone finds an
> exploit for the _eval_no_lexicals things.

I'll have to take your word for it.

-- 
guy@albertelli.com  LON-CAPA Developer  0-7-6-1-