perl - 带有共享符号的安全隔间会导致 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.                       

我推断调试器正在尝试通过使用其原始名称来执行共享子例程，并且由于在隔离专区中不可用，因此无法访问它。

我可以想到两种方法来解决这个问题:

重命名子引用，以便 caller等将它们视为在隔间中(例如，使用 Sub::Name::subname )

指示调试器不要将自己插入到安全隔间中的代码执行中

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

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 诡计。这也是一个非常 splinter 的模块。
简单的 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 $@;