Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

[perl #17744] Security-Hole in module Safe.pm

11 views
Skip to first unread message

Andreas Jurenda

unread,
Oct 4, 2002, 3:24:48 AM10/4/02
to bugs-bi...@netlabs.develooper.com
# New Ticket Created by Andreas Jurenda
# Please include the string: [perl #17744]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt2/Ticket/Display.html?id=17744 >


Well, I have found a security problem in module Safe.pm

Sorry at may english, but my tongues are Pascal, Basic, C, C++,... maybe Perl but neither german nor english, but I will do my best ;-)

The problem belongs to these two versions of Safe.pm:
Safe.pm Version 2.06 at Perl 5.6.1 and
Safe.pm Version 2.07 at Perl 5.8.0

In both versions there is the same code for Safe::reval()

Safe::reval() execute a given code in a safe compartment.

But this routine has a one-time safeness.
If you call reval() a second (or more) time with the same compartment, you are potential unsafe.

These depends on the values of @_ at the entrypoint of the safe compartment.

Have a look at the source code of Safe::reval()

Source:
=======

sub reval {
my ($obj, $expr, $strict) = @_;
my $root = $obj->{Root};

# Create anon sub ref in root of compartment.
# Uses a closure (on $expr) to pass in the code to be executed.
# (eval on one line to keep line numbers as expected by caller)
my $evalcode = sprintf('package %s; sub { eval $expr; }', $root);
my $evalsub;

if ($strict) { use strict; $evalsub = eval $evalcode; }
else { no strict; $evalsub = eval $evalcode; }

return Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub);
}


In the last line there is the call for the execution of our $expr.
Inside $expr at runtime there are @_ set with ($root, $obj->{Mask}, $evalsub).

And thats the hole, because $_[1] is directly linked to $obj->{Mask}.

Modifying of $_[1] manipulate directly the operationmask of the safe compartment!

At the first time calling reval() and manipulation $_[1] has no effect.
But after that the second (and more) call you get the (un-)"safe" compartment with the manipulatet operation mask!

Example:
========

$codefullopmask = '$_[1] = chr(0x00) x 44;'; # at Perl 5.6.1 and 5.8.0 there are 352 built in opcodes (352/8=44)

$codewithtrape = <<'EOC';
opendir(DIR,"."); @d=readdir(DIR); closedir(DIR);
foreach my $dt (@d) { print "$dt\n"; }
EOC

use Safe;
$safe=new Safe;
$safe->deny(qw(opendir)); # deny opendir: You can't use opendir() inside the safe compartment

$safe->reval($codefullopmask); # this manipulate the operation mask to full capability of all opcodes
$safe->reval($codewithtrap); # now there is NO trap for opendir, and you get the directory!


The solution of this problem is very simple.

You have only put the operation-mask into a temporary variable for execution of $expr.
Here the source code of the solution. You have only modify the two commented lines.

Solution:
=========

sub reval {
my ($obj, $expr, $strict) = @_;
my $root = $obj->{Root};

# Create anon sub ref in root of compartment.
# Uses a closure (on $expr) to pass in the code to be executed.
# (eval on one line to keep line numbers as expected by caller)
my $evalcode = sprintf('package %s; sub { eval $expr; }', $root);
my $evalsub;

if ($strict) { use strict; $evalsub = eval $evalcode; }
else { no strict; $evalsub = eval $evalcode; }

my $temp_mask = $obj->{Mask}; # JURENDA: put opmask in temporary scalar
return Opcode::_safe_call_sv($root, $temp_mask, $evalsub); # JURENDA: call with this temp var
}


Now you can't modify the operationmask within the safe compartment.

Herzliche Grüße von Andreas Jurenda :-})

Benjamin Goldberg

unread,
Oct 4, 2002, 1:23:18 PM10/4/02
to perl5-...@perl.org, bugs-bi...@netlabs.develooper.com
Andreas Jurenda (via RT) wrote:
[snip]

> my $temp_mask = $obj->{Mask};
> # JURENDA: put opmask in temporary scalar
> return Opcode::_safe_call_sv($root, $temp_mask, $evalsub);
> # JURENDA: call with this temp var

Personally, I would prefer that we should prevent user code from even
*trying* to alter these...

return Opcode::_safe_call_sv("$root", "$obj->{Mask}", $evalsub);

This way, trying to change $_[1] in the evaled sub produces death due to
modification of read-only scalar.


--
How many Monks would a Chipmonk chip,
if a Chipmonk could chip Monks?

Rafael Garcia-Suarez

unread,
Oct 4, 2002, 4:44:48 PM10/4/02
to Benjamin Goldberg, perl5-...@perl.org, bugs-bi...@netlabs.develooper.com
Benjamin Goldberg wrote:
> Andreas Jurenda (via RT) wrote:
> [snip]
> > my $temp_mask = $obj->{Mask};
> > # JURENDA: put opmask in temporary scalar
> > return Opcode::_safe_call_sv($root, $temp_mask, $evalsub);
> > # JURENDA: call with this temp var
>
> Personally, I would prefer that we should prevent user code from even
> *trying* to alter these...
>
> return Opcode::_safe_call_sv("$root", "$obj->{Mask}", $evalsub);
>
> This way, trying to change $_[1] in the evaled sub produces death due to
> modification of read-only scalar.

This won't produce death. _safe_call_sv executes the closure in
the caller's context, i.e. in _safe_call_sv context (hence the access of
the closure to its parent @_).

Your proposed fix is equivalent to Andreas' one : it prevents that
changing the 2nd slot of @_ also replaces also the $obj->{Mask}
it's aliased to. Just like with any normal subroutine call ;-

My preferred fix would be to empty @_ in the closure before eval'ing
the code.

Rafael Garcia-Suarez

unread,
Oct 4, 2002, 5:03:40 PM10/4/02
to perl5-...@perl.org, per...@perl.org, bugs-bi...@netlabs.develooper.com
Andreas Jurenda (via RT) wrote:
> Well, I have found a security problem in module Safe.pm
....

> Safe::reval() execute a given code in a safe compartment.
>
> But this routine has a one-time safeness.
> If you call reval() a second (or more) time with the same compartment, you are potential unsafe.
>
> These depends on the values of @_ at the entrypoint of the safe compartment.
....

> The solution of this problem is very simple.
>
> You have only put the operation-mask into a temporary variable for execution of $expr.

Thanks. I've applied the following patch to the current development version
of Perl, which includes a fix based on yours, but a bit different.

The included regression test is backportable to 5.8.0. (The number of opcodes
and the diagnostic message emitted by perl have changed since then.)

Change 17976 by rgs@rgs-home on 2002/10/04 19:44:48

Fix bug #17744, suggested by Andreas Jurenda,
tweaked by rgs (security hole in Safe).

Affected files ...

.... //depot/perl/MANIFEST#942 edit
.... //depot/perl/ext/Opcode/Safe.pm#18 edit
.... //depot/perl/ext/Safe/safe3.t#1 add

Differences ...

==== //depot/perl/MANIFEST#942 (text) ====

@@ -570,6 +570,7 @@
ext/re/re.xs re extension external subroutines
ext/Safe/safe1.t See if Safe works
ext/Safe/safe2.t See if Safe works
+ext/Safe/safe3.t See if Safe works
ext/SDBM_File/Makefile.PL SDBM extension makefile writer
ext/SDBM_File/sdbm.t See if SDBM_File works
ext/SDBM_File/sdbm/biblio SDBM kit

==== //depot/perl/ext/Opcode/Safe.pm#18 (text) ====

@@ -214,11 +214,11 @@


# Create anon sub ref in root of compartment.
# Uses a closure (on $expr) to pass in the code to be executed.
# (eval on one line to keep line numbers as expected by caller)

- my $evalcode = sprintf('package %s; sub { eval $expr; }', $root);
+ my $evalcode = sprintf('package %s; sub { @_ = (); eval $expr; }', $root);
my $evalsub;

- if ($strict) { use strict; $evalsub = eval $evalcode; }
- else { no strict; $evalsub = eval $evalcode; }
+ if ($strict) { use strict; $evalsub = eval $evalcode; }
+ else { no strict; $evalsub = eval $evalcode; }

Rafael Garcia-Suarez

unread,
Oct 4, 2002, 5:19:33 PM10/4/02
to perl5-...@perl.org, per...@perl.org, bugs-bi...@netlabs.develooper.com
Rafael Garcia-Suarez wrote:
> Thanks. I've applied the following patch to the current development version
> of Perl, which includes a fix based on yours, but a bit different.

This has been enhanced by change #17977 : a similar bug was affecting Safe::rdo().

Arthur Bergman

unread,
Oct 5, 2002, 2:18:45 AM10/5/02
to Rafael Garcia-Suarez, perl5-...@perl.org, per...@perl.org, bugs-bi...@netlabs.develooper.com

On fredag, okt 4, 2002, at 23:19 Europe/Stockholm, Rafael Garcia-Suarez
wrote:


Should I release a new Safe.pm onto CPAN which has the included
security fix?

Arthur

Arthur Bergman

unread,
Oct 5, 2002, 2:46:06 AM10/5/02
to Rafael Garcia-Suarez, perl5-...@perl.org, per...@perl.org, bugs-bi...@netlabs.develooper.com

On fredag, okt 4, 2002, at 23:19 Europe/Stockholm, Rafael Garcia-Suarez
wrote:

> Rafael Garcia-Suarez wrote:

Should this be released as a CPAN release of Safe.pm? If so I can
volunteer to do it.

Arthur

Rafael Garcia-Suarez

unread,
Oct 5, 2002, 5:00:04 AM10/5/02
to Arthur Bergman, perl5-...@perl.org, per...@perl.org, bugs-bi...@netlabs.develooper.com
Arthur Bergman wrote:
>
> Should this be released as a CPAN release of Safe.pm? If so I can
> volunteer to do it.

This is a good idea. The new regression test is designed to work on
older Perls.

I don't think the CPAN backport needs to include the Opcode module.
I've tried various ways to break the Opcode module but I didn't succeed.

Arthur Bergman

unread,
Oct 5, 2002, 5:51:07 AM10/5/02
to Rafael Garcia-Suarez, perl5-...@perl.org, per...@perl.org, bugs-bi...@netlabs.develooper.com

On lördag, okt 5, 2002, at 11:00 Europe/Stockholm, Rafael Garcia-Suarez
wrote:

Consider it done.

Arthur

0 new messages