develooper Front page | perl.perl5.porters | Postings from October 2002

Re: [perl #17744] Security-Hole in module

Thread Previous | Thread Next
Rafael Garcia-Suarez
October 4, 2002 13:59
Re: [perl #17744] Security-Hole in module
Message ID:
Andreas Jurenda (via RT) wrote:
> Well, I have found a security problem in module
> 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/ 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/ (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);

Thread Previous | Thread Next Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at | Group listing | About