Change 23209: eval_sv() failing a taint test could corrupt the stack

[Dave Mitchell]

Change 23209 by [EMAIL PROTECTED] on 2004/08/09 19:48:57

        eval_sv() failing a taint test could corrupt the stack

Affected files ...

... //depot/perl/ext/XS/APItest/t/call.t#2 edit
... //depot/perl/perl.c#555 edit

Differences ...

==== //depot/perl/ext/XS/APItest/t/call.t#2 (text) ====
Index: perl/ext/XS/APItest/t/call.t
--- perl/ext/XS/APItest/t/call.t#1~23203~       Sat Aug  7 08:10:40 2004
+++ perl/ext/XS/APItest/t/call.t        Mon Aug  9 12:48:57 2004
@@ -19,9 +19,14 @@
 use warnings;
 use strict;
 
-use Test::More tests => 239;
+# Test::MJore doesn't have fresh_perl_is() yet
+# use Test::More tests => 240;
 
-BEGIN { use_ok('XS::APItest') };
+BEGIN {
+    require './test.pl';
+    plan(240);
+    use_ok('XS::APItest')
+};
 
 #########################
 
@@ -132,9 +137,12 @@
     ok(eq_array( [ eval { call_pv('d', $flags, @$args) }, $@ ],
        [ "its_dead_jim\n" ]), "$description eval { call_pv('d') }");
 
+    #use Data::Dumper; print Dumper([ eval { eval_sv('d', $flags), $@ }, $@ ]);
+#    print Dumper([ ($flags & (G_ARRAY|G_DISCARD)) ? (0) : (undef, 1),
+#              "its_dead_jim\n", undef ]);
     ok(eq_array( [ eval { eval_sv('d', $flags), $@ }, $@ ],
        [ ($flags & (G_ARRAY|G_DISCARD)) ? (0) : (undef, 1),
-               "its_dead_jim\n", undef ]),
+               "its_dead_jim\n", '' ]),
        "$description eval { eval_sv('d') }");
 
     ok(eq_array( [ eval { call_method('d', $flags, $obj, @$args) }, $@ ],
@@ -148,3 +156,22 @@
 is($@, "its_dead_jim\n", "eval_pv('d()', 0) - \$@");
 is(eval { eval_pv('d()', 1) } , undef, "eval { eval_pv('d()', 1) }");
 is($@, "its_dead_jim\n", "eval { eval_pv('d()', 1) } - \$@");
+
+# DAPM 9-Aug-04. A taint test in eval_sv() could die after setting up
+# a new jump level but before pushing an eval context, leading to
+# stack corruption
+
+fresh_perl_is(<<'EOF', "x=2", { switches => ['-T'] }, 'eval_sv() taint');
+use XS::APItest;
+
+my $x = 0;
+sub f {
+    eval { my @a = ($^X . "x" , eval_sv(q(die "inner\n"), 0)) ; };
+    $x++;
+    $a <=> $b;
+}
+
+eval { my @a = sort f 2, 1;  $x++};
+print "x=$x\n";
+EOF
+

==== //depot/perl/perl.c#555 (text) ====
Index: perl/perl.c
--- perl/perl.c#554~23190~      Tue Aug  3 23:19:27 2004
+++ perl/perl.c Mon Aug  9 12:48:57 2004
@@ -2200,6 +2200,10 @@
     CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_vcall_body),
                (OP*)&myop, TRUE);
 #else
+    /* fail now; otherwise we could fail after the JMPENV_PUSH but
+     * before a PUSHEVAL, which corrupts the stack after a croak */
+    TAINT_PROPER("eval_sv()");
+
     JMPENV_PUSH(ret);
 #endif
     switch (ret) {
End of Patch.