Skip to content
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

Closed
p5pRT opened this issue Nov 13, 2010 · 7 comments
Closed

formline() crashes on tainted arguments #10822

p5pRT opened this issue Nov 13, 2010 · 7 comments

Comments

@p5pRT
Copy link
Collaborator

@p5pRT p5pRT commented Nov 13, 2010

Migrated from rt.perl.org#79138 (status was 'open')

Searchable as RT79138$

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Nov 13, 2010

From @ntyni

This is a bug report for perl from Niko Tyni <ntyni@​debian.org>,
generated with the help of perlbug 1.39 running under perl 5.13.6.


./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
the destination string too small and causing a write out of bounds.

I'm attaching three patches​:

- a trivial fix for this crash
- TODO tests for proper taint handling of $^A
- an incomplete attempt at implementing the taint handling

The last patch fixes all but one of the TODO tests. AIUI the failure is
because the get magic is handled too late. A second identical test for
$^A taintedness succeeds.

I'd appreciate it if somebody could help with getting this right.

Originally reported by Roland Kuhn in http​://bugs.debian.org/575318



Flags​:
  category=core
  severity=low


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​:
  Commit id​: ca60ecf
  Platform​:
  osname=linux, osvers=2.6.32-5-amd64, archname=x86_64-linux-gnu-thread-multi
  uname='linux madeleine 2.6.32-5-amd64 #1 smp sat oct 30 14​:18​:21 utc 2010 x86_64 gnulinux '
  config_args='-Dusethreads -Duselargefiles -Dccflags=-DDEBIAN -Dcccdlflags=-fPIC -Darchname=x86_64-linux-gnu -Dprefix=/usr -Dprivlib=/usr/share/perl/5.13 -Darchlib=/usr/lib/perl/5.13 -Dvendorprefix=/usr -Dvendorlib=/usr/share/perl5 -Dvendorarch=/usr/lib/perl5 -Dsiteprefix=/usr/local -Dsitelib=/usr/local/share/perl/5.13.6 -Dsitearch=/usr/local/lib/perl/5.13.6 -Dman1dir=/usr/share/man/man1 -Dman3dir=/usr/share/man/man3 -Dsiteman1dir=/usr/local/man/man1 -Dsiteman3dir=/usr/local/man/man3 -Dman1ext=1 -Dman3ext=3perl -Dpager=/usr/bin/sensible-pager -Uafs -Ud_csh -Ud_ualarm -Uusesfio -Uusenm -DDEBUGGING=both -Doptimize=-O0 -Dusedevel -Uuseshrplib -des'
  hint=recommended, useposix=true, d_sigaction=define
  useithreads=define, usemultiplicity=define
  useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
  use64bitint=define, use64bitall=define, uselongdouble=undef
  usemymalloc=n, bincompat5005=undef
  Compiler​:
  cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN -DDEBUGGING -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
  optimize='-O0 -g',
  cppflags='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN -DDEBUGGING -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include'
  ccversion='', gccversion='4.4.5', gccosandvers=''
  intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678
  d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
  ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
  alignbytes=8, prototype=define
  Linker and Libraries​:
  ld='cc', ldflags =' -fstack-protector -L/usr/local/lib'
  libpth=/usr/local/lib /lib /usr/lib /lib64 /usr/lib64
  libs=-lnsl -lgdbm -ldb -ldl -lm -lcrypt -lutil -lpthread -lc -lgdbm_compat
  perllibs=-lnsl -ldl -lm -lcrypt -lutil -lpthread -lc
  libc=/lib/libc-2.11.2.so, so=so, useshrplib=false, libperl=libperl.a
  gnulibc_version='2.11.2'
  Dynamic Linking​:
  dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
  cccdlflags='-fPIC', lddlflags='-shared -O0 -g -L/usr/local/lib -fstack-protector'

Locally applied patches​:
 


@​INC for perl 5.13.6​:
  lib
  /usr/local/lib/perl/5.13.6
  /usr/local/share/perl/5.13.6
  /usr/lib/perl5
  /usr/share/perl5
  /usr/lib/perl/5.13
  /usr/share/perl/5.13
  /usr/local/share/perl
  /usr/share/perl5
  .


Environment for perl 5.13.6​:
  HOME=/home/niko
  LANG=en_US.UTF-8
  LANGUAGE (unset)
  LC_CTYPE=fi_FI.UTF-8
  LD_LIBRARY_PATH (unset)
  LOGDIR (unset)
  PATH=/home/niko/bin​:/home/niko/bin​:/home/niko/bin​:/usr/local/bin​:/usr/bin​:/bin​:/usr/local/games​:/usr/games​:/sbin​:/usr/sbin​:/sbin​:/usr/sbin
  PERL_BADLANG (unset)
  SHELL=/bin/zsh

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Nov 13, 2010

From @ntyni

0001-Fix-a-crash-with-a-tainted-formline-picture.patch
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

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Nov 13, 2010

From @ntyni

0002-TODO-tests-for-A-tainting.patch
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

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Nov 13, 2010

From @ntyni

0003-Implement-A-tainting.patch
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

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Nov 15, 2010

From @cpansprout

On Fri Nov 12 23​:19​:13 2010, ntyni@​debian.org wrote​:

./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
the destination string too small and causing a write out of bounds.

I'm attaching three patches​:

- a trivial fix for this crash
- TODO tests for proper taint handling of $^A
- an incomplete attempt at implementing the taint handling

Thank you. Applied as 7e6078c, 99e6ea2 and 125b998.

The last patch fixes all but one of the TODO tests. AIUI the failure
is
because the get magic is handled too late. A second identical test for
$^A taintedness succeeds.

I'd appreciate it if somebody could help with getting this right.

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
SvPOK (now SvPOKp) without calling magic first. In fact, I think that’s
what makes this crash (haven’t checked)​:

./perl -T -e 'use overload q\""\=>sub{("A"x2000).q{@​*}};
formline(bless([]),"hello")'

I think perhaps the first SvPV_force in S_doparseform needs to be moved
up into pp_formline, before that SvPOK(p) check, but I have not actually
tried it.

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Nov 15, 2010

The RT System itself - Status changed from 'new' to 'open'

@Corion
Copy link

@Corion Corion commented Nov 3, 2019

The oneliner

    ./perl -T -e 'use overload q\""\=>sub{("A"x2000).q{@​*}};formline(bless([]),"hello")'

does not crash on bleadperl ( 5.31.x ). This ticket can be closed.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Linked pull requests

Successfully merging a pull request may close this issue.

None yet
3 participants
You can’t perform that action at this time.