From 4a5c1f486a2c1df9cef4368646c3f24a406a79d6 Mon Sep 17 00:00:00 2001
From: Niko Tyni <ntyni@debian.org>
Date: Mon, 1 Nov 2010 09:19:07 +0200
Subject: [PATCH 1/3] Fix a crash with a tainted formline() picture

A private (tainted) string did not get its share of space
in the destination string, causing a buffer overflow later.

Originally reported by Roland Kuhn as http://bugs.debian.org/575318
---
 pp_ctl.c     |    2 +-
 t/op/taint.t |    9 ++++++++-
 2 files changed, 9 insertions(+), 2 deletions(-)

diff --git a/pp_ctl.c b/pp_ctl.c
index 2d4d6dd..4c3ffaf 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -504,7 +504,7 @@ PP(pp_formline)
     NV value;
     bool gotsome = FALSE;
     STRLEN len;
-    const STRLEN fudge = SvPOK(tmpForm)
+    const STRLEN fudge = SvPOKp(tmpForm)
 			? (SvCUR(tmpForm) * (IN_BYTES ? 1 : 3) + 1) : 0;
     bool item_is_utf8 = FALSE;
     bool targ_is_utf8 = FALSE;
diff --git a/t/op/taint.t b/t/op/taint.t
index 83fcef7..fc90871 100644
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -17,7 +17,7 @@ use Config;
 use File::Spec::Functions;
 
 BEGIN { require './test.pl'; }
-plan tests => 325;
+plan tests => 326;
 
 $| = 1;
 
@@ -1396,6 +1396,13 @@ foreach my $ord (78, 163, 256) {
     ok(!tainted($untainted), '$untainted should yet still be untainted');
 }
 
+{
+    fresh_perl_is(<<'end', "ok", { switches => [ '-T' ] },
+    $TAINT = substr($^X, 0, 0);
+    formline('@'.('<'x("21".$TAINT)).' | @*', 'hallo', 'welt'); print "ok";
+end
+    "formline survives a tainted dynamic picture");
+}
 
 # This may bomb out with the alarm signal so keep it last
 SKIP: {
-- 
1.7.2.3

From bca3a0ab27db1d82fb0010d0aa595c063a692a0f Mon Sep 17 00:00:00 2001
From: Niko Tyni <ntyni@debian.org>
Date: Fri, 12 Nov 2010 19:35:34 +0200
Subject: [PATCH 2/3] TODO tests for $^A tainting

The format accumulator $^A should become tainted when formline() is
called with tainted data.
---
 t/op/taint.t |   23 ++++++++++++++++++++++-
 1 files changed, 22 insertions(+), 1 deletions(-)

diff --git a/t/op/taint.t b/t/op/taint.t
index fc90871..e4554a6 100644
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -17,7 +17,7 @@ use Config;
 use File::Spec::Functions;
 
 BEGIN { require './test.pl'; }
-plan tests => 326;
+plan tests => 335;
 
 $| = 1;
 
@@ -1404,6 +1404,27 @@ end
     "formline survives a tainted dynamic picture");
 }
 
+TODO: {
+    local $::TODO = '$^A tainting unimplemented';
+    ok(!tainted($^A), "format accumulator not tainted yet");
+    formline('@ | @*', 'hallo' . $TAINT, 'welt');
+    ok(tainted($^A), "tainted formline argument makes a tainted accumulator");
+    $^A = "";
+    ok(!tainted($^A), "accumulator can be explicitly untainted");
+    formline('@' .('<'*5) . ' | @*', 'hallo', 'welt');
+    ok(!tainted($^A), "accumulator still untainted");
+    $^A = "" . $TAINT;
+    ok(tainted($^A), "accumulator can be explicitly tainted");
+    formline('@' .('<'*5) . ' | @*', 'hallo', 'welt');
+    ok(tainted($^A), "accumulator still tainted");
+    $^A = "";
+    ok(!tainted($^A), "accumulator untainted again");
+    formline('@' .('<'*5) . ' | @*', 'hallo', 'welt');
+    ok(!tainted($^A), "accumulator still untainted");
+    formline('@' .('<'*(5+$TAINT0)) . ' | @*', 'hallo', 'welt');
+    ok(tainted($^A), "tainted formline picture makes a tainted accumulator");
+}
+
 # This may bomb out with the alarm signal so keep it last
 SKIP: {
     skip "No alarm()"  unless $Config{d_alarm};
-- 
1.7.2.3

From 869fa3cd231f4f9350a481e5b31870597d4dfe57 Mon Sep 17 00:00:00 2001
From: Niko Tyni <ntyni@debian.org>
Date: Sat, 13 Nov 2010 00:02:07 +0200
Subject: [PATCH 3/3] Implement $^A tainting

The format accumulator $^A now becomes tainted when formline() is
called with tainted data.

There is still one failing test from the TODO set; it seems
that the $^A get magic is handled too late for the taintedness
to show up.
---
 mg.c         |   10 ++++++++++
 pp_ctl.c     |    4 ++++
 t/op/taint.t |    9 ++++++---
 3 files changed, 20 insertions(+), 3 deletions(-)

diff --git a/mg.c b/mg.c
index abd4a9d..5302bd4 100644
--- a/mg.c
+++ b/mg.c
@@ -809,6 +809,8 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
     switch (*mg->mg_ptr) {
     case '\001':		/* ^A */
 	sv_setsv(sv, PL_bodytarget);
+	if (SvTAINTED(PL_bodytarget))
+	    SvTAINTED_on(sv);
 	break;
     case '\003':		/* ^C, ^CHILD_ERROR_NATIVE */
 	if (nextchar == '\0') {
@@ -2383,6 +2385,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
     const char * const remaining = mg->mg_ptr + 1;
     I32 i;
     STRLEN len;
+    MAGIC *tmg;
 
     PERL_ARGS_ASSERT_MAGIC_SET;
 
@@ -2419,6 +2422,13 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
         break;
     case '\001':	/* ^A */
 	sv_setsv(PL_bodytarget, sv);
+	/* mg_set() has temporarily made sv non-magical */
+	if (PL_tainting) {
+	    if ((tmg = mg_find(sv,PERL_MAGIC_taint)) && tmg->mg_len & 1)
+		SvTAINTED_on(PL_bodytarget);
+	    else
+		SvTAINTED_off(PL_bodytarget);
+	}
 	break;
     case '\003':	/* ^C */
 	PL_minus_c = cBOOL(SvIV(sv));
diff --git a/pp_ctl.c b/pp_ctl.c
index 4c3ffaf..3e6e46c 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -524,6 +524,8 @@ PP(pp_formline)
 	    return parseres;
     }
     SvPV_force(PL_formtarget, len);
+    if (SvTAINTED(tmpForm))
+	SvTAINTED_on(PL_formtarget);
     if (DO_UTF8(PL_formtarget))
 	targ_is_utf8 = TRUE;
     t = SvGROW(PL_formtarget, len + fudge + 1);  /* XXX SvCUR bad */
@@ -605,6 +607,8 @@ PP(pp_formline)
 		sv = &PL_sv_no;
 		Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), "Not enough format arguments");
 	    }
+	    if (SvTAINTED(sv))
+		SvTAINTED_on(PL_formtarget);
 	    break;
 
 	case FF_CHECKNL:
diff --git a/t/op/taint.t b/t/op/taint.t
index e4554a6..0367e0c 100644
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -17,7 +17,7 @@ use Config;
 use File::Spec::Functions;
 
 BEGIN { require './test.pl'; }
-plan tests => 335;
+plan tests => 336;
 
 $| = 1;
 
@@ -1404,8 +1404,7 @@ end
     "formline survives a tainted dynamic picture");
 }
 
-TODO: {
-    local $::TODO = '$^A tainting unimplemented';
+{
     ok(!tainted($^A), "format accumulator not tainted yet");
     formline('@ | @*', 'hallo' . $TAINT, 'welt');
     ok(tainted($^A), "tainted formline argument makes a tainted accumulator");
@@ -1422,6 +1421,10 @@ TODO: {
     formline('@' .('<'*5) . ' | @*', 'hallo', 'welt');
     ok(!tainted($^A), "accumulator still untainted");
     formline('@' .('<'*(5+$TAINT0)) . ' | @*', 'hallo', 'welt');
+    TODO: {
+        local $::TODO = "get magic handled too late?";
+        ok(tainted($^A), "the accumulator should be tainted already");
+    }
     ok(tainted($^A), "tainted formline picture makes a tainted accumulator");
 }
 
-- 
1.7.2.3