--- perl-5.8.3.patched/op.c Mon Dec 12 18:21:46 2005

diff -cr perl-5.8.3/op.c perl-5.8.3.patched/op.c
*** perl-5.8.3/op.c Wed Dec 31 18:13:05 2003
--- perl-5.8.3.patched/op.c Mon Dec 12 18:21:46 2005
***************
*** 1992,1998 ****
/* XXX might want a ck_negate() for this */
cUNOPo->op_first->op_private &= ~OPpCONST_STRICT;
break;
- case OP_SPRINTF:
case OP_UCFIRST:
case OP_LCFIRST:
case OP_UC:
--- 1992,1997 ----
diff -cr perl-5.8.3/opcode.h perl-5.8.3.patched/opcode.h
*** perl-5.8.3/opcode.h Wed Dec 31 18:13:06 2003
--- perl-5.8.3.patched/opcode.h Mon Dec 12 18:21:46 2005
***************
*** 1585,1591 ****
0x0022281c, /* vec */
0x0122291c, /* index */
0x0122291c, /* rindex */
! 0x0004280f, /* sprintf */
0x00042805, /* formline */
0x0001379e, /* ord */
0x0001378e, /* chr */
--- 1585,1591 ----
0x0022281c, /* vec */
0x0122291c, /* index */
0x0122291c, /* rindex */
! 0x0004280d, /* sprintf */
0x00042805, /* formline */
0x0001379e, /* ord */
0x0001378e, /* chr */
diff -cr perl-5.8.3/opcode.pl perl-5.8.3.patched/opcode.pl
*** perl-5.8.3/opcode.pl Wed Dec 31 18:13:07 2003
--- perl-5.8.3.patched/opcode.pl Mon Dec 12 18:21:46 2005
***************
*** 602,608 ****
index index ck_index isT@ S S S?
rindex rindex ck_index isT@ S S S?

! sprintf sprintf ck_fun mfst@ S L
formline formline ck_fun ms@ S L
ord ord ck_fun ifsTu% S?
chr chr ck_fun fsTu% S?
--- 602,608 ----
index index ck_index isT@ S S S?
rindex rindex ck_index isT@ S S S?

! sprintf sprintf ck_fun mst@ S L
formline formline ck_fun ms@ S L
ord ord ck_fun ifsTu% S?
chr chr ck_fun fsTu% S?
diff -cr perl-5.8.3/patchlevel.h perl-5.8.3.patched/patchlevel.h
*** perl-5.8.3/patchlevel.h Wed Jan 14 15:18:14 2004
--- perl-5.8.3.patched/patchlevel.h Mon Dec 12 18:21:46 2005
***************
*** 123 ****
! ,NULL
--- 123,124 ----
! ,"SPRINTF0 - fixes for sprintf formatting issues - CVE-2005-3962"
! ,NULL
diff -cr perl-5.8.3/perl.h perl-5.8.3.patched/perl.h
*** perl-5.8.3/perl.h Sun Dec 14 20:25:21 2003
--- perl-5.8.3.patched/perl.h Mon Dec 12 18:21:46 2005
***************
*** 3072,3077 ****
--- 3072,3079 ----
INIT("\"my\" variable %s can't be in a package");
EXTCONST char PL_no_localize_ref[]
INIT("Can't localize through a reference");
+ EXTCONST char PL_memory_wrap[]
+ INIT("panic: memory wrap");

EXTCONST char PL_uuemap[65]
INIT("`!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_");
diff -cr perl-5.8.3/sv.c perl-5.8.3.patched/sv.c
*** perl-5.8.3/sv.c Wed Jan 14 13:40:13 2004
--- perl-5.8.3.patched/sv.c Mon Dec 12 18:22:26 2005
***************
*** 8537,8545 ****
if (vectorarg) {
if (args)
vecsv = va_arg(*args, SV*);
! else
! vecsv = (evix ? evix <= svmax : svix < svmax) ?
! svargs[evix ? evix-1 : svix++] : &PL_sv_undef;
dotstr = SvPVx(vecsv, dotstrlen);
if (DO_UTF8(vecsv))
is_utf8 = TRUE;
--- 8537,8548 ----
if (vectorarg) {
if (args)
vecsv = va_arg(*args, SV*);
! else if (evix) {
! vecsv = (evix > 0 && evix <= svmax)
! ? svargs[evix-1] : &PL_sv_undef;
! } else {
! vecsv = svix < svmax ? svargs[svix++] : &PL_sv_undef;
! }
dotstr = SvPVx(vecsv, dotstrlen);
if (DO_UTF8(vecsv))
is_utf8 = TRUE;
***************
*** 8549,8560 ****
vecstr = (U8*)SvPVx(vecsv,veclen);
vec_utf8 = DO_UTF8(vecsv);
}
! else if (efix ? efix <= svmax : svix < svmax) {
vecsv = svargs[efix ? efix-1 : svix++];
vecstr = (U8*)SvPVx(vecsv,veclen);
vec_utf8 = DO_UTF8(vecsv);
}
else {
vecstr = (U8*)"";
veclen = 0;
}
--- 8552,8564 ----
vecstr = (U8*)SvPVx(vecsv,veclen);
vec_utf8 = DO_UTF8(vecsv);
}
! else if (efix ? (efix > 0 && efix <= svmax) : svix < svmax) {
vecsv = svargs[efix ? efix-1 : svix++];
vecstr = (U8*)SvPVx(vecsv,veclen);
vec_utf8 = DO_UTF8(vecsv);
}
else {
+ vecsv = &PL_sv_undef;
vecstr = (U8*)"";
veclen = 0;
}
***************
*** 8655,8663 ****

if (vectorize)
argsv = vecsv;
! else if (!args)
! argsv = (efix ? efix <= svmax : svix < svmax) ?
! svargs[efix ? efix-1 : svix++] : &PL_sv_undef;

switch (c = *q++) {

--- 8659,8673 ----

if (vectorize)
argsv = vecsv;
! else if (!args) {
! if (efix) {
! const I32 i = efix-1;
! argsv = (i >= 0 && i < svmax) ? svargs[i] : &PL_sv_undef;
! } else {
! argsv = (svix >= 0 && svix < svmax)
! ? svargs[svix++] : &PL_sv_undef;
! }
! }

switch (c = *q++) {

***************
*** 8899,8904 ****
--- 8909,8916 ----
*--eptr = '0';
break;
case 2:
+ if (!uv)
+ alt = FALSE;
do {
dig = uv & 1;
*--eptr = '0' + dig;
***************
*** 9223,9231 ****
--- 9235,9247 ----
(PL_op->op_type == OP_PRTF) ? "" : "s");

have = esignlen + zeros + elen;
+ if (have < zeros)
+ Perl_croak_nocontext(PL_memory_wrap);
need = (have > width ? have : width);
gap = need - have;

+ if (need >= (((STRLEN)~0) - SvCUR(sv) - dotstrlen - 1))
+ Perl_croak_nocontext(PL_memory_wrap);
SvGROW(sv, SvCUR(sv) + need + dotstrlen + 1);
p = SvEND(sv);
if (esignlen && fill == '0') {
diff -cr perl-5.8.3/t/lib/warnings/sv perl-5.8.3.patched/t/lib/warnings/sv
*** perl-5.8.3/t/lib/warnings/sv Thu Jun 12 23:03:18 2003
--- perl-5.8.3.patched/t/lib/warnings/sv Mon Dec 12 18:21:46 2005
***************
*** 281,292 ****
printf F "%\x02" ;
$a = sprintf "%\x02" ;
EXPECT
- Invalid conversion in sprintf: "%z" at - line 5.
- Invalid conversion in sprintf: end of string at - line 7.
- Invalid conversion in sprintf: "%\002" at - line 9.
Invalid conversion in printf: "%z" at - line 4.
Invalid conversion in printf: end of string at - line 6.
Invalid conversion in printf: "%\002" at - line 8.
########
# sv.c
use warnings 'misc' ;
--- 281,292 ----
printf F "%\x02" ;
$a = sprintf "%\x02" ;
EXPECT
Invalid conversion in printf: "%z" at - line 4.
+ Invalid conversion in sprintf: "%z" at - line 5.
Invalid conversion in printf: end of string at - line 6.
+ Invalid conversion in sprintf: end of string at - line 7.
Invalid conversion in printf: "%\002" at - line 8.
+ Invalid conversion in sprintf: "%\002" at - line 9.
########
# sv.c
use warnings 'misc' ;
diff -cr perl-5.8.3/t/op/sprintf.t perl-5.8.3.patched/t/op/sprintf.t
*** perl-5.8.3/t/op/sprintf.t Mon Sep 1 08:41:07 2003
--- perl-5.8.3.patched/t/op/sprintf.t Mon Dec 12 18:21:51 2005
***************
*** 385,387 ****
--- 385,392 ----
>%4$K %d< >[45, 67]< >%4$K 45 INVALID<
>%d %K %d< >[23, 45]< >23 %K 45 INVALID<
>%*v*999\$d %d %d< >[11, 22, 33]< >%*v*999\$d 11 22 INVALID<
+ >%#b< >0< >0<
+ >%#o< >0< >0<
+ >%#x< >0< >0<
+ >%2918905856$v2d< >''< ><
+ >%*2918905856$v2d< >''< > UNINIT<
diff -cr perl-5.8.3/t/op/sprintf2.t perl-5.8.3.patched/t/op/sprintf2.t
*** perl-5.8.3/t/op/sprintf2.t Fri Nov 28 23:53:47 2003
--- perl-5.8.3.patched/t/op/sprintf2.t Mon Dec 12 18:22:40 2005
***************
*** 6,12 ****
require './test.pl';
}

! plan tests => 2;

is(
sprintf("%.40g ",0.01),
--- 6,12 ----
require './test.pl';
}

! plan tests => 6 + 256;

is(
sprintf("%.40g ",0.01),
***************
*** 18,20 ****
--- 18,62 ----
sprintf("%.40f", 0.01)." ",
q(the sprintf "%.<number>f" optimization)
);
+
+ # Used to mangle PL_sv_undef
+ fresh_perl_is(
+ 'print sprintf "xxx%n\n"; print undef',
+ 'Modification of a read-only value attempted at - line 1.',
+ { switches => [ '-w' ] },
+ q(%n should not be able to modify read-only constants),
+ );
+
+ # check %NNN$ for range bounds, especially negative 2's complement
+
+ {
+ my ($warn, $bad) = (0,0);
+ local $SIG{__WARN__} = sub {
+ if ($_[0] =~ /uninitialized/) {
+ $warn++
+ }
+ else {
+ $bad++
+ }
+ };
+ my $result = sprintf join('', map("%$_\$s%" . ~$_ . '$s', 1..20)),
+ qw(a b c d);
+ is($result, "abcd", "only four valid values");
+ is($warn, 36, "expected warnings");
+ is($bad, 0, "unexpected warnings");
+ }
+
+ {
+ foreach my $ord (0 .. 255) {
+ my $bad = 0;
+ local $SIG{__WARN__} = sub {
+ unless ($_[0] =~ /^Invalid conversion in sprintf/ ||
+ $_[0] =~ /^Use of uninitialized value in sprintf/) {
+ warn $_[0];
+ $bad++;
+ }
+ };
+ my $r = eval {sprintf '%v' . chr $ord};
+ is ($bad, 0, "pattern '%v' . chr $ord");
+ }
+ }
*** perl-5.8.3/globvar.sym Mon Aug 14 16:22:14 2000
--- perl-5.8.3.patched/globvar.sym Mon Dec 12 21:04:34 2005
***************
*** 66,68 ****
--- 66,69 ----
vtbl_collxfrm
vtbl_amagic
vtbl_amagicelem
+ memory_wrap