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
formline() crashes on tainted arguments #10822
Comments
From @ntyniThis is a bug report for perl from Niko Tyni <ntyni@debian.org>, ./perl -T -e 'formline($^X.("A"x20).q{@*},"hello")' crashes on at least 5.10.1 and bleadperl. The SvPOK() test in pp_formline() fails with a tainted string, making I'm attaching three patches: - a trivial fix for this crash The last patch fixes all but one of the TODO tests. AIUI the failure is I'd appreciate it if somebody could help with getting this right. Originally reported by Roland Kuhn in http://bugs.debian.org/575318 Flags: Site configuration information for perl 5.13.6: Configured by niko at Fri Nov 12 11:36:30 EET 2010. Summary of my perl5 (revision 5 version 13 subversion 6) configuration: Locally applied patches: @INC for perl 5.13.6: Environment for perl 5.13.6: |
From @ntyni0001-Fix-a-crash-with-a-tainted-formline-picture.patchFrom 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 @ntyni0002-TODO-tests-for-A-tainting.patchFrom 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 @ntyni0003-Implement-A-tainting.patchFrom 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
|
From @cpansproutOn Fri Nov 12 23:19:13 2010, ntyni@debian.org wrote:
Thank you. Applied as 7e6078c, 99e6ea2 and 125b998.
I don’t know much about tainting, nor have I looked into that yet. But there is one thing I find suspicious about pp_formline: it’s using ./perl -T -e 'use overload q\""\=>sub{("A"x2000).q{@*}}; I think perhaps the first SvPV_force in S_doparseform needs to be moved |
The RT System itself - Status changed from 'new' to 'open' |
The oneliner
does not crash on bleadperl ( 5.31.x ). This ticket can be closed. |
Migrated from rt.perl.org#79138 (status was 'open')
Searchable as RT79138$
The text was updated successfully, but these errors were encountered: