# New Ticket Created by willem (AT) lunatech (DOT) com
# Please include the string: [perl #39126]
# in the subject line of all future correspondence about this issue.
# <URL: >
This is a bug report for perl from willem (AT) lunatech (DOT) com,
generated with the help of perlbug 1.35 running under perl v5.8.8.
Dear maintainers,
For a project I'm working on, I've run into a difficult to understand issue.
The code I'm working on translates edi messages that may have various encodings
In some cases we run into a perl crash when formatting a translated string, which in
the general case works normally. The error messages returned is:
glibc detected realloc(): invalid next size: 0x081fac98
Aborted
I've tried to pin down the root cause of the problem and managed to write two
simple scripts which only a slight variation. of them crashes as above, while
the other runs normally.
Some extra testing with valgrind of the crashing test script shows the following:
Invalid write of size 1
at 0x80D33E2: Perl_sv_vcatpvfn (in /usr/bin/perl)
by 0x8107EB2: Perl_do_sprintf (in /usr/bin/perl)
Address 0x651FBB4 is 0 bytes after a block of size 52 alloc'd
Which in my eyes looks like a buffer overrun.
I'm not sure if I can attach files with 'perlbug' and I certainly do not know how, so
you'll find the two mentioned test scripts below. The first one crashes, the secod one not.
The first test script is:
sprintf-bug.pl
use strict;
use warnings;
use Encode;
my $format = decode("utf-8", encode('utf-8', "%5s%-10s%-35s%-35s"));
my @records = ('', '', "\344\345", "\326");
my $line = sprintf($format, @records);
print STDUT "$line\n";
/sprintf-bug.pl
And the second test script is:
sprintf-nonbug.pl
use strict;
use warnings;
use Encode;
my $format = decode("utf-8", encode('utf-8', "%5s%-35s%-35s"));
my @records = ('', "\344\345", "\326");
my $line = sprintf($format, @records);
print STDUT "$line\n";
/sprintf-nonbug.pl
I hope this provides you with enough information to identify the actual
bug and write a fix for it. I know that the code may seem funny by having
the format string in utf-8, but I don't think that it should result in
a crash.
In any event, thanks for your time to look into it. If you need any assistance,
then please, just let me know.
Kindest regards,
Willem-Jan Veen
The Netherlands
Flags:
category=core
severity=high
Site configuration information for perl v5.8.8:
Configured by Debian Project at Tue Apr 4 22:34:25 UTC 2006.
Summary of my perl5 (revision 5 version 8 subversion 8) configuration:
Platform:
osname=linux, osvers=2.6.15.4,
uname='linux ninsei 2.6.15.4 #1 smp preempt mon feb 20 09:48:53 pst 2006 i686 gnulinux '
config_args='-Dusethreads -Duselargefiles -Dccflags=-DDEBIAN -Dcccdlflags=-fPIC -Darchname=i486-linux-gnu -Dprefix=/usr -Dprivlib=/usr/share/perl/5.8 -Darchlib=/usr/lib/perl/5.8 -Dvendorprefix=/usr -Dvendorlib=/usr/share/perl5 -Dvendorarch=/usr/lib/perl5 -Dsiteprefix=/usr/local -Dman1dir=/usr/share/man/man1 -Dman3dir=/usr/share/man/man3 -Dman1ext=1 -Dman3ext=3perl -Uafs -Ud_csh -Uusesfio -Uusenm -Duseshrplib -Dlibperl=libperl.so.5.8.8 -Dd_dosuid -des'
hint=recommended, useposix=true, d_sigaction=define
usethreads=define use5005threads=undef useithreads=define usemultiplicity=define
useperlio=define d_sfio=undef uselargefiles=define usesocks=undef
use64bitint=undef use64bitall=undef uselongdouble=undef
usemymalloc=n, bincompat5005=undef
Compiler:
cc='cc', ccflags ='-D_REENTRANT -D_GNU_SURCE -DTHREADS_HAVE_PIDS -DDEBIAN -fno-strict-aliasing -pipe -I/usr/local/include -D_LARGEFILE_SURCE -D_FILEFFSET_BITS=64',
optimize='',
cppflags='-D_REENTRANT -D_GNU_SURCE -DTHREADS_HAVE_PIDS -DDEBIAN -fno-strict-aliasing -pipe -I/usr/local/include'
ccversion='', gccversion='4.0.3 (Debian 4.0.3-1)', gccosandvers=''
intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
ivtype='long', ivsize=4, nvtype='double', nvsize=8, ='off_t', lseeksize=8
alignbytes=4, prototype=define
Linker and Libraries:
ld='cc', ldflags =' -L/usr/local/lib'
libpth=/usr/local/lib /lib /usr/lib
libs=-lgdbm -lgdbm_compat -ldb -ldl -lm -lpthread -lc -lcrypt
perllibs=-ldl -lm -lpthread -lc -lcrypt
libc=/lib/libc-2.3.6.so, so=so, useshrplib=true, libperl=libperl.so.5.8.8
gnulibc_version='2.3.6'
Dynamic Linking:
dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
cccdlflags='-fPIC', lddlflags='-shared -L/usr/local/lib'
Locally applied patches:
@INC for perl v5.8.8:
/etc/perl
/usr/local/lib/perl/5.8.8
/usr/local/share/perl/5.8.8
/usr/lib/perl5
/usr/share/perl5
/usr/lib/perl/5.8
/usr/share/perl/5.8
/usr/local/lib/site_perl
.
Environment for perl v5.8.8:
HME=/home/willem
LANG (unset)
LANGUAGE (unset)
LC_CTYPE=en_US
LD_LIBRARY_PATH (unset)
LGDIR (unset)
PERL_BADLANG (unset)
SHELL=/bin/bash

Thu, 11 May 2006 02:58:48 -0700, "willem (AT) lunatech (DOT) com (via RT)" <perlbug-followup (AT) perl (DOT) orgwrote

# New Ticket Created by willem (AT) lunatech (DOT) com
# Please include the string: [perl #39126]
# in the subject line of all future correspondence about this issue.
# <URL: >

Dear maintainers,

Some extra testing with valgrind of the crashing test script shows the following:
Invalid write of size 1
at 0x80D33E2: Perl_sv_vcatpvfn (in /usr/bin/perl)
by 0x8107EB2: Perl_do_sprintf (in /usr/bin/perl)
Address 0x651FBB4 is 0 bytes after a block of size 52 alloc'd

Which in my eyes looks like a buffer overrun.

I hope this provides you with enough information to identify the actual
bug and write a fix for it. I know that the code may seem funny by having
the format string in utf-8, but I don't think that it should result in
a crash.

I think the following is more reproducible in perl-current:

for my $i (100) {
my $format = "%-". ($i * 7). "s";
utf8::upgrade($format);
my @records = ("\344\345" x $i);
my $line = sprintf($format, @records);
}

The problem occurs near the end of Perl_sv_vcatpvfn:

STRLEN width = 7*$i
STRLEN have = 2*$i
STRLEN need = 7*$i
STRLEN gap = 5*$i = need - have
STRLEN elen = 4*$i (after sv_utf8_upgrade)
SvCUR(sv) at last = gap + elen = need + (elen - have) = 9*$i
SvLEN(sv) at last = PERL_STRLEN_RUNDUP(need + dotstrlen + 1)
= PERL_STRLEN_RUNDUP(7*$i+2)

! elen gets doubled by sv_utf8_upgrade()
but need on SvGRW(sv, SvCUR(sv) + need + dotstrlen + 1) doesn't care it!

#sv.c 9341-9367
/* calculate width before utf8_upgrade changes it */
have = esignlen + zeros + elen;
if (have < zeros)
Perl_croak_nocontext(PL_memory_wrap);

if (is_utf8 != has_utf8) {
if (is_utf8) {
if (SvCUR(sv))
sv_utf8_upgrade(sv);
}
else {
SV * const nsv = sv_2mortal(newSVpvn(eptr, elen));
sv_utf8_upgrade(nsv);
eptr = SvPVX_const(nsv);
elen = SvCUR(nsv);
}
SvGRW(sv, SvCUR(sv) + elen + 1);
p = SvEND(sv);
*p = '\0';
}

need = (have width ? have : width);
gap = need - have;

if (need >= (((STRLEN)~0) - SvCUR(sv) - dotstrlen - 1))
Perl_croak_nocontext(PL_memory_wrap);
SvGRW(sv, SvCUR(sv) + need + dotstrlen + 1);

SvGRW(sv, SvCUR(sv) + elen + 1) doesn't help it
since SvGRW(sv, SvCUR(sv) + need + dotstrlen + 1) makes too short.
To fix this, perhaps what are in bytes and what are in characters
should be rethought.

Regards,
SADAHIR Tomoyuki

Fri, 19 May 2006 01:29:36 +0900, SADAHIR Tomoyuki <bqw10602 (AT) nifty (DOT) comwrote

Thu, 11 May 2006 02:58:48 -0700, "willem (AT) lunatech (DOT) com (via RT)" <perlbug-followup (AT) perl (DOT) orgwrote

Some extra testing with valgrind of the crashing test script shows the following:
Invalid write of size 1
at 0x80D33E2: Perl_sv_vcatpvfn (in /usr/bin/perl)
by 0x8107EB2: Perl_do_sprintf (in /usr/bin/perl)
Address 0x651FBB4 is 0 bytes after a block of size 52 alloc'd

Which in my eyes looks like a buffer overrun.

The problem occurs near the end of Perl_sv_vcatpvfn:

Here is a patch; the test suite in t/op/sprintf2.t used \xe4 but
in EBCDIC this byte is U then must have no change on utf8_upgraded.
\xb4 is upgraded into two octets even ifdef EBCDIC, hence it's
appropriate for the test.

Regards,
SADAHIR Tomoyuki

diff -urN perl-current@28232/sv.c perl/sv.c
perl-current@28232/sv.cThu May 18 05:54:33 2006
perl/sv.cSun May 21 18:24:45 2006
@@ -9338,26 +9338,28 @@
continue;/* not "break" */
}
-/* calculate width before utf8_upgrade changes it */
+if (is_utf8 != has_utf8) {
+ if (is_utf8) {
+if (SvCUR(sv))
+ sv_utf8_upgrade(sv);
+ }
+ else {
+const STRLEN old_elen = elen;
+SV * const nsv = sv_2mortal(newSVpvn(eptr, elen));
+sv_utf8_upgrade(nsv);
+eptr = SvPVX_const(nsv);
+elen = SvCUR(nsv);
+
+if (width) { /* fudge width (can't fudge elen) */
+ width += elen - old_elen;
+}
+is_utf8 = TRUE;
+ }
+}
+
have = esignlen + zeros + elen;
if (have < zeros)
Perl_croak_nocontext(PL_memory_wrap);
-
-if (is_utf8 != has_utf8) {
- if (is_utf8) {
- if (SvCUR(sv))
- sv_utf8_upgrade(sv);
- }
- else {
- SV * const nsv = sv_2mortal(newSVpvn(eptr, elen));
- sv_utf8_upgrade(nsv);
- eptr = SvPVX_const(nsv);
- elen = SvCUR(nsv);
- }
- SvGRW(sv, SvCUR(sv) + elen + 1);
- p = SvEND(sv);
- *p = '\0';
-}

need = (have width ? have : width);
gap = need - have;
diff -urN perl-current@28232/t/op/sprintf2.t perl/t/op/sprintf2.t
perl-current@28232/t/op/sprintf2.tTue Dec 13 22:58:10 2005
perl/t/op/sprintf2.tSun May 21 18:34:34 2006
@@ -6,7 +6,7 @@
require './test.pl';
}
-plan tests =275;
+plan tests =280;

is(
sprintf("%.40g ",0.01),
@@ -18,13 +18,14 @@
sprintf("%.40f", 0.01)." ",
q(the sprintf "%.<number>f" optimization)
);
-{
-chop(my $utf8_format = "%-3s\x{100}");
-is(
-sprintf($utf8_format, "\xe4"),
-"\xe4 ",
-q(width calculation under utf8 upgrade)
-);
+
+# cases of $i 1 are against [perl #39126]
+for my $i (1, 5, 10, 20, 50, 100) {
+ chop(my $utf8_format = "%-". 3*$i ."s\x{100}");
+ my $string = "\xB4"x$i; # latin1 ACUTE or ebcdic CPYRIGHT
+ my $expect = $string." "x$i; # followed by 2*$i spaces
+ is(sprintf($utf8_format, $string), $expect,
+ "width calculation under utf8 upgrade, length=$i");
}

# Used to mangle PL_sv_undef
End of patch

Here is a tweak of the test suite.
The width can be replaced with an asterisk.

diff -urN perl-current@28232/t/op/sprintf2.t perl/t/op/sprintf2.t
perl-current@28232/t/op/sprintf2.tTue Dec 13 22:58:10 2005
perl/t/op/sprintf2.tSun May 21 18:34:34 2006

+# cases of $i 1 are against [perl #39126]
+for my $i (1, 5, 10, 20, 50, 100) {
+ chop(my $utf8_format = "%-". 3*$i ."s\x{100}");

+ chop(my $utf8_format = "%-*s\x{100}");

+ my $string = "\xB4"x$i; # latin1 ACUTE or ebcdic CPYRIGHT
+ my $expect = $string." "x$i; # followed by 2*$i spaces
+ is(sprintf($utf8_format, $string), $expect,

+ is(sprintf($utf8_format, 3*$i, $string), $expect,

+ "width calculation under utf8 upgrade, length=$i");

Regards,
SADAHIR Tomoyuki

# New Ticket Created by willem (AT) lunatech (DOT) com
# Please include the string: [perl #39126]
# in the subject line of all future correspondence about this issue.
# <URL: >

Some extra testing with valgrind of the crashing test script shows the following:
Invalid write of size 1
at 0x80D33E2: Perl_sv_vcatpvfn (in /usr/bin/perl)
by 0x8107EB2: Perl_do_sprintf (in /usr/bin/perl)
Address 0x651FBB4 is 0 bytes after a block of size 52 alloc'd

The problem occurs near the end of Perl_sv_vcatpvfn:

To fix this, perhaps what are in bytes and what are in characters
should be rethought.

Currently the width and the precision for %s are in characters;
for example:
sprintf("%03s", "\x{100}") returns "00\x{100}".
sprintf("%.3s", "\x{abcd}12345") returns "\x{abcd}12".

But the width and the precision for %c and in bytes;
for example:
sprintf("%03c", 0x100) returns "0\x{100}".
sprintf("%.2c", 0xabcd) returns "\352\257" (malformed UTF8).

Then %n sets the number of characters output in bytes;
for example:
after sprintf("%s%n", "\x{beef}", $a), $a is set to 3.

Regards,
SADAHIR Tomoyuki

SADAHIR Tomoyuki wrote:
Here is a patch; the test suite in t/op/sprintf2.t used \xe4 but
in EBCDIC this byte is U then must have no change on utf8_upgraded.
\xb4 is upgraded into two octets even ifdef EBCDIC, hence it's
appropriate for the test.

Thanks, applied as change #28328 (with further test suite tweaks).

Sun, 28 May 2006 20:42:25 +0900, SADAHIR Tomoyuki <bqw10602 (AT) nifty (DOT) comwrote

Currently the width and the precision for %s are in characters;
for example:
sprintf("%03s", "\x{100}") returns "00\x{100}".
sprintf("%.3s", "\x{abcd}12345") returns "\x{abcd}12".

But the width and the precision for %c and in bytes;
for example:
sprintf("%03c", 0x100) returns "0\x{100}".
sprintf("%.2c", 0xabcd) returns "\352\257" (malformed UTF8).

Then %n sets the number of characters output in bytes;
for example:
after sprintf("%s%n", "\x{beef}", $a), $a is set to 3.

In my opinion these numbers for Unicode should be regarded as those
in characters.

First, as well as printf() can take I layers, sprintf() can set
the flag SVf_UTF8 of the return value. Hence the format string for
them should cope with the character semantics.

Second, a character in the right-hand part of latin1, say U+00DF, is
represented by a two-byte sequence in UTF-8.
Currently printf("%s%n", pack('U', 0xDF), $a) sets $a to 2 though
the output is actually a single byte, since doio.c#Perl_do_print
converts it from utf8 to bytes (from UTF-8 to Latin1 ifndef EBCDIC).
To me, this result is inconsistent.

Third, the output encoding can be freely changed through I layers.
The number of bytes mapped to a Unicode character varies depending
on the encoding, while the number of characters mapped to a Unicode
character is almost always 1 in most encodings.
If the numbers are in characters, the results coincide better.

Regards,
SADAHIR Tomoyuki