Question

我正在使用Perl 5.22.1。安全2.39

我正在调试一个程序，该程序偶然在Safe隔离专区中运行代码。代码执行从另一个包共享的子例程。我对隔间中运行的代码不感兴趣，但无法避免其执行。执行共享子例程时，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技巧。它也是一个非常破碎的模块。简单的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 $@;

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

1 个答案: