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) ====
Index: perl/MANIFEST
--- perl/MANIFEST#941~17966~ Wed Oct 2 07:46:52 2002
+++ perl/MANIFEST Fri Oct 4 12:44:48 2002
@@ -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) ====
Index: perl/ext/Opcode/Safe.pm
--- perl/ext/Opcode/Safe.pm#17~17973~ Thu Oct 3 13:34:13 2002
+++ perl/ext/Opcode/Safe.pm Fri Oct 4 12:44:48 2002
@@ -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);
}
==== //depot/perl/ext/Safe/safe3.t#1 (text) ====
Index: perl/ext/Safe/safe3.t
--- /dev/null Tue May 5 13:32:27 1998
+++ perl/ext/Safe/safe3.t Fri Oct 4 12:44:48 2002
@@ -0,0 +1,33 @@
+#!perl
+
+BEGIN {
+ if ($ENV{PERL_CORE}) {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ require Config; import Config;
+ if ($Config{'extensions'} !~ /\bOpcode\b/
+ && $Config{'extensions'} !~ /\bPOSIX\b/
+ && $Config{'osname'} ne 'VMS')
+ {
+ print "1..0\n";
+ exit 0;
+ }
+ }
+}
+
+use strict;
+use warnings;
+use POSIX qw(ceil);
+use Test::More tests => 1;
+use Safe;
+
+my $safe = new Safe;
+$safe->deny('add');
+
+# Attempt to change the opmask from within the safe compartment
+$safe->reval( qq{\$_[1] = q/\0/ x } . ceil( Opcode::opcodes / 8 ) );
+
+# Check that it didn't work
+$safe->reval( q{$x + $y} );
+like( $@, qr/^'?addition \(\+\)'? trapped by operation mask/,
+ 'opmask still in place' );
End of Patch.
