Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Security-Hole in module Safe.pm #5975

Closed
p5pRT opened this issue Oct 4, 2002 · 12 comments
Closed

Security-Hole in module Safe.pm #5975

p5pRT opened this issue Oct 4, 2002 · 12 comments
Labels

Comments

@p5pRT
Copy link
Collaborator

@p5pRT p5pRT commented Oct 4, 2002

Migrated from rt.perl.org#17744 (status was 'resolved')

Searchable as RT17744$

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Oct 4, 2002

From andreas.jurenda@chello.at

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 :-})

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Oct 4, 2002

From goldbb2@earthlink.net

Andreas Jurenda (via RT) wrote​:
[snip]

my $temp\_mask = $obj\->\{Mask\};
\# JURENDA&#8203;: put opmask in temporary scalar
return Opcode&#8203;::\_safe\_call\_sv\($root\, $temp\_mask\, $evalsub\);
\# JURENDA&#8203;: 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?

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Oct 4, 2002

From @rgs

Benjamin Goldberg wrote​:

Andreas Jurenda (via RT) wrote​:
[snip]

my $temp\_mask = $obj\->\{Mask\};
\# JURENDA&#8203;: put opmask in temporary scalar
return Opcode&#8203;::\_safe\_call\_sv\($root\, $temp\_mask\, $evalsub\);
\# JURENDA&#8203;: call with this temp var

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

return Opcode&#8203;::\_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.

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Oct 4, 2002

From @rgs

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; }

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

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Oct 4, 2002

From @rgs

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().

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.)

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Oct 5, 2002

arthur@contiller.se - Status changed from 'new' to 'open'

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Oct 5, 2002

From arthur@contiller.se

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

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().

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.)

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

Arthur

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Oct 5, 2002

From arthur@contiller.se

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

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().

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.)

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

Arthur

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Oct 5, 2002

@rgs - Status changed from 'open' to 'resolved'

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Oct 5, 2002

From @rgs

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.

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Oct 5, 2002

From arthur@contiller.se

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

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.

Consider it done.

Arthur

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Oct 5, 2002

arthur@contiller.se - Status changed from 'open' to 'resolved'

@p5pRT p5pRT closed this Oct 5, 2002
@p5pRT p5pRT added the Severity Low label Oct 18, 2019
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Linked pull requests

Successfully merging a pull request may close this issue.

None yet
1 participant
You can’t perform that action at this time.