带有共享符号的安全隔离专区会导致Perl调试器出现问题

Question

我正在使用Perl 5.22.1.安全2.39

我正在调试一个程序,它偶然在一个安全隔间中运行代码.代码执行从另一个包共享的子例程.我对隔间中运行的代码不感兴趣,但无法避免其执行.执行共享子例程时,Perl调试器在隔离专区内晃动.

这是测试代码:

use warnings;
use strict;

use Safe;

sub MyPkg::foo { 33; }

my $safe= Safe->new;
$safe->share_from( 'MyPkg', [ '&foo' ] );
print $safe->reval(q[foo]), "\n";
print STDERR $@ if $@;

直接运行时,我得到预期的输出:

% perl tdebug.pl
33

但是,在Perl调试器下运行时,调试器非常不满意:

% perl -d tdebug.pl

Loading DB routines from perl5db.pl version 1.49
Editor support available.

Enter h or 'h h' for help, or 'man perldebug' for more help.

main::(tdebug.pl:8):    my $safe= Safe->new;
                                                                                                                                                                   DB<1> c

Undefined subroutine &MyPkg::foo called at [...]/lib/5.22.1/perl5db.pl line 4183.
Debugged program terminated.                       

我推断调试器试图通过使用其原始名称来执行共享子例程,并且因为在隔离专区中不可用,所以无法访问它.

我可以想到两种方法:

1. 重命名subrefs,以便将caller它们视为在隔离专区中(例如使用Sub :: Name :: subname)
2. 指示调试器不要将自身插入到Safe隔离专区中的代码执行中

我试图实现第一种方法,如下所示,

use warnings;
use strict;

use Safe;

{ package MyPkg;
  sub foo { 33; }
}

use Sub::Name;
use Opcode 'empty_opset';

my $safe= Safe->new;
$safe->mask( empty_opset() );
$safe->share_from( 'MyPkg', [ '&foo' ] );
$safe->reval( q[use Sub::Name;]) or die "use Sub::Name: ", $@;
$safe->reval( q[subname foo => \&foo; 1;]) or die "subname call", $@;
$safe->permit_only( ':default' );
print $safe->reval( q[ foo ] ), "\n";
print STDERR $@ if $@;

但是由于以下运行时错误而受到阻碍:

use Sub::Name: Can't load module Sub::Name, dynamic loading not available in this perl.
  (You may need to build a new perl executable which either supports
  dynamic loading or has the Sub::Name module statically linked into it.)
 at (eval 6) line 1.
Compilation failed in require at (eval 6) line 1.
BEGIN failed--compilation aborted at (eval 6) line 1.

至于方法2,有人会对如何实现这一点有任何想法吗？

Answer 1

忘掉调试器的 Sub::Name 欺骗吧。这也是一个非常损坏的模块。简单的 glob 分配（核心别名）或 coderef 分配总是更容易。

正如 @ThisSuitIsBlackNot 已经发现的那样，您需要添加更多共享，即从 main:: stash 到加载模块的共享，并且需要使用安全隔间中的全名。

use warnings;
use strict;

use Safe;

sub MyPkg::foo { 33; }

my $safe= Safe->new;
$safe->share_from( 'MyPkg', [ '&foo' ] );
$safe->share_from( 'main', [ 'MyPkg::foo' ] );
print $safe->reval(q[MyPkg::foo]);
print STDERR $@ if $@;