| Subject: | Safe prevents access to base class of an object since 2.20 |
I've been working on a project which uses Safe, the attached file is a
contrived example which triggers the bug that I've come up against.
Running this script with Safe 2.19 works, but later versions fail with
the following error:
$ ./test.pl
Can't locate package Animal for @Lion::ISA at ./test.pl line 15.
Can't locate package Animal for @Lion::ISA at ./test.pl line 15.
(in cleanup) Can't locate object method "eat" via package "Lion"
(perhaps you forgot to load "Lion"?) at ./test.pl line 15.
It appears that Safe doesn't import/allow access to the Animal package
which Lion extends. Is this behaviour correct?
This is the code which changed between 2.19 and 2.20, the way this is
implemented has changed since 2.20 but the general logic is still the
same. The issue does affect 2.27.
$ diff Safe.pm.2.19 Safe.pm.2.20
4a5,7
Show quoted text
> use Scalar::Util qw(reftype);
> use Config qw(%Config);
> use constant is_usethreads => $Config{usethreads};
6c9
< $Safe::VERSION = "2.19";
---
Show quoted text> $Safe::VERSION = "2.20";
291,292c294,313
< my $evalsub = lexless_anon_sub($root,$strict, $expr);
< return Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub);
---
Show quoted text> my $evalsub = lexless_anon_sub($root, $strict, $expr);
> my @ret = (wantarray)
> ? Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub)
> : scalar Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub);
>
> # RT#60374: Safe.pm sort {} bug with -Dusethreads
> # If the Safe eval returns a code ref in a perl compiled with
usethreads
Show quoted text> # then wrap code ref with _safe_call_sv so that, when called, the
> # execution will happen with the compartment fully 'in effect'.
> # Needed to fix sort blocks that reference $a & $b and
> # possibly other subtle issues.
> if (is_usethreads()) {
> for my $ret (@ret) { # edit (via alias) any CODE refs
> next unless (reftype($ret)||'') eq 'CODE';
> my $sub = $ret; # avoid closure problems
> $ret = sub { Opcode::_safe_call_sv($root, $obj->{Mask},
$sub) };
Show quoted text> }
> }
>
> return (wantarray) ? @ret : $ret[0];
$ perl -v
This is perl, v5.8.8 built for i386-linux-thread-multi
| Subject: | test.pl |
#!/usr/bin/perl
use strict;
use warnings;
package Zoo;
my $animal;
sub set_animal {
$animal = shift;
}
sub eat {
$animal->eat(@_);
}
#############################
package Animal;
sub eat {
my $self = shift;
print "Eating...\n";
}
#############################
package Lion;
use base qw( Animal );
sub new {
my $class = shift;
return bless({}, $class)
}
#############################
package main;
import Zoo;
import Lion;
use Safe;
my $ctx = new Safe;
$ctx->share_from(
'Zoo',
[ 'eat' ]
);
my $lion = new Lion;
Zoo::set_animal($lion);
my $sub = $ctx->reval('sub { eat(); }');
$sub->();