Re: Passing argument into STDIN inside safe.pm reval

[7stud]

Actually, Safe has a share() method, which you should be able to use on STDIN--but it doesn't work for me:

use strict;
use warnings;
use 5.012;

use Safe;

if($ARGV[0]) {
    my $code = $ARGV[0];

    my $compartment = Safe->new;
    $compartment->share('*STDIN');
    $compartment->permit_only(qw{ print readline });
    $compartment->reval($code);

    if ($@) {
        print "Unsafe code detected: $@";
    }

}

--output:--

$ perl 2.pl '
print "Enter some stdin: ";
my $line = readline *STDIN;
print "From STDIN: $line";
'
Unsafe code detected: 'private value' trapped by operation mask at (ev
+al 5) line 1.

I can't even get share() to work on a simple scalar variable:

use strict;
use warnings;
use 5.012;

use Safe;

our $x = 10;

if($ARGV[0]) {
    my $code = $ARGV[0];

    my $compartment = Safe->new;
    $compartment->share('$x');
    $compartment->permit_only(qw{ print readline});
    $compartment->reval($code);

    if ($@) {
        print "Unsafe code detected: $@";
    }

}

--output:--
$ perl 2.pl 'print "$x\n";'
Unsafe code detected: 'private value' trapped by operation mask at (ev
+al 5) line 1.

I'm really sick of that non-informative error message!

[gideondsouza]

Hey thanks a ton for your replies and effort!

I guess running the code in a virtual environment is the only way out!

I'm trying to sort of understand and mimic www.perltuts.com. The author says this on his blog :

Evaluator is a simple daemon that runs on a virtual machine, it accepts the code, builds the Perl package and evals it capturing the output with Capture::Tiny. It does some timeout checking and fork limiting of course. The virtual machine (qemu Debian image) allows you to run a real Perl code on a real machine. This can be used when writing advanced tutorials including IO, networking, forks etc (I tried Safe but wanted more freedom). It is reset every hour from a snaphot.

So I' playing about on Amazon EC2 and was thinking of running a new instance that will just evaluate code and return the result. I'm thinking I can use Time::Out to timeout operations, but (1) how do I do a fork limit? (2) Am I pretty safe if I allow any perl code to run but restart my VM every hour or something?

[Dallaylaen]

I've tried to replace permit_only with permit in your example, and it worked for me.

Still need to figure out what should I place into permit_only so that it allows to eval '1' (which is obviously safe).

[7stud]

That's confounding. I printed out the masks for both permit(qw(print readline)) and permit_only(qw(print readline)) using printf():

printf "%vd \n", $compartment->mask;

...and they are clearly different, which means a compartment allows some default operations that permit_only() must be erasing. Rereading the Safe docs, there is a set of default operations bundled under :default that are allowed. You have to check the Opcode docs to see which operations that :default includes. I'm not sure which ones I erased with permit_only() that are needed to reval() my sample code--but in any case it looks like if you want to use permit_only(), then you probably need a pretty good grasp of perl internals.

I did a bunch of trial and error, and to get permit_only() to work on my sample code, I need all these:

 $compartment->permit_only(qw(
        print 
        readline 
        :base_core   
        :base_mem
        :base_orig) 
);

The :default bundle of operations that a compartment allows consists of a bevy of other bundles:

:base_core 
:base_mem 
:base_loop 
:base_orig 
:base_thread

See the Opcode docs for which operations are included in each of those bundles.

[Dallaylaen]

Thanks for pointing out Opcode.

So here's my opcode hunter:

#!/usr/bin/perl -w

use strict;
use Opcode qw(opset opmask_add opset_to_ops invert_opset);

my $code = shift;
defined $code or 
    die "Usage: $0 <code> <permitted_opcode> <permitted_opcode> ...\n"
+;
# skip some masks from prev operations
my %skip;
$skip{$_}++ for @ARGV;

my @all = opset_to_ops(invert_opset(opset()));

# Try all opcodes, print error if eval failed
foreach ( @all ) {
    $skip{$_} and next;
    opmask_add(opset($_));
    eval $code and next;
    print "Eval failed on opcode: $_ with error: $@\n";
    exit 1;
};

print "Eval OK\n";

For input "my $x; 1" it requires four operators - const padany lineseq leaveeval

padany is the one responsible for the "private vatriable" error observable in this thread.

Now how come private variable is needed in "eval 1"? SIGDIE is my friend! Sooo... Let's get a stack trace:

#!/usr/bin/perl -w

use strict;
use warnings;
use 5.012;

use Safe;
use Carp;

my $code = shift;
die "Usage: $0 <code> <premitted op> <permitted op> ..." unless define
+d $code;

my @perm = @ARGV;

print "Trying: $code\n";

my $compartment = Safe->new;
$compartment->share('*STDIN');
$compartment->share('&Dumper');

$compartment->permit_only(@perm);

# Trap detailed stack trace
my $stack;
local $SIG{__DIE__} = sub { $stack = Carp::longmess(shift) };
print $compartment->reval($code);

if ($@) {
    print "Unsafe code detected: $@";
    print "At: $stack";
}

Here's my stack trace (note Carp complaining).

bash$ perl safe2.pl 1 
Trying: 1
Unsafe code detected: 'private value' trapped by operation mask at (ev
+al 5) line 1.
At: 'private value' trapped by operation mask at (eval 5) line 1.
 at (eval 5) line 1
    eval 'my $__ExPr__;1
;' called at (eval 4) line 1
    main::__ANON__(** Incomplete caller override detected; @DB::args w
+ere not set **) called at /usr/share/perl/5.14/Safe.pm line 358
    eval {...} called at /usr/share/perl/5.14/Safe.pm line 358
    Safe::reval(** Incomplete caller override detected; @DB::args were
+ not set **) called at safe2.pl line 26

Aha, so Safe has added a "my" to my code before executing it. Finally, let's enable opcodes found by first script:

bash$ perl safe2.pl 1 padany const leaveeval lineseq
Trying: 1
1

Conclusion: No sensible code will be ever executed by a compartment w/o these four opcodes.