diff -rc perl-5.8.7/makedef.pl perl-5.8.7.patched/makedef.pl *** perl-5.8.7/makedef.pl Mon May 9 14:27:41 2005 --- perl-5.8.7.patched/makedef.pl Mon Dec 12 18:03:35 2005 *************** *** 635,646 **** )]; } - if ($define{'PERL_MALLOC_WRAP'}) { - emit_symbols [qw( - PL_memory_wrap - )]; - } - unless ($define{'USE_5005THREADS'} || $define{'USE_ITHREADS'}) { skip_symbols [qw( PL_thr_key --- 635,640 ---- diff -rc perl-5.8.7/op.c perl-5.8.7.patched/op.c *** perl-5.8.7/op.c Fri Apr 22 15:12:32 2005 --- perl-5.8.7.patched/op.c Mon Dec 12 18:03:35 2005 *************** *** 2076,2082 **** /* 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: --- 2076,2081 ---- diff -rc perl-5.8.7/opcode.h perl-5.8.7.patched/opcode.h *** perl-5.8.7/opcode.h Fri May 27 17:29:50 2005 --- perl-5.8.7.patched/opcode.h Mon Dec 12 18:03:35 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 -rc perl-5.8.7/opcode.pl perl-5.8.7.patched/opcode.pl *** perl-5.8.7/opcode.pl Wed Dec 1 13:54:30 2004 --- perl-5.8.7.patched/opcode.pl Mon Dec 12 18:03:35 2005 *************** *** 606,612 **** 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? --- 606,612 ---- 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 -rc perl-5.8.7/patchlevel.h perl-5.8.7.patched/patchlevel.h *** perl-5.8.7/patchlevel.h Mon May 30 22:32:42 2005 --- perl-5.8.7.patched/patchlevel.h Mon Dec 12 18:03:35 2005 *************** *** 123 **** ! ,NULL --- 123,124 ---- ! ,"SPRINTF0 - fixes for sprintf formatting issues - CVE-2005-3962" ! ,NULL diff -rc perl-5.8.7/perl.h perl-5.8.7.patched/perl.h *** perl-5.8.7/perl.h Sat May 7 21:11:45 2005 --- perl-5.8.7.patched/perl.h Mon Dec 12 18:03:35 2005 *************** *** 3326,3335 **** INIT("\"my\" variable %s can't be in a package"); EXTCONST char PL_no_localize_ref[] INIT("Can't localize through a reference"); - #ifdef PERL_MALLOC_WRAP EXTCONST char PL_memory_wrap[] INIT("panic: memory wrap"); - #endif EXTCONST char PL_uuemap[65] INIT("`!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_"); --- 3326,3333 ---- diff -rc perl-5.8.7/sv.c perl-5.8.7.patched/sv.c *** perl-5.8.7/sv.c Fri May 27 11:38:11 2005 --- perl-5.8.7.patched/sv.c Mon Dec 12 18:07:32 2005 *************** *** 8589,8597 **** 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; --- 8589,8600 ---- 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; *************** *** 8601,8612 **** 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; } --- 8604,8616 ---- 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; } *************** *** 8707,8715 **** if (vectorize) argsv = vecsv; ! else if (!args) ! argsv = (efix ? efix <= svmax : svix < svmax) ? ! svargs[efix ? efix-1 : svix++] : &PL_sv_undef; switch (c = *q++) { --- 8711,8725 ---- 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++) { *************** *** 8972,8977 **** --- 8982,8989 ---- *--eptr = '0'; break; case 2: + if (!uv) + alt = FALSE; do { dig = uv & 1; *--eptr = '0' + dig; *************** *** 9274,9279 **** --- 9286,9293 ---- /* 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) { *************** *** 9301,9306 **** --- 9315,9322 ---- 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 -rc perl-5.8.7/t/lib/warnings/sv perl-5.8.7.patched/t/lib/warnings/sv *** perl-5.8.7/t/lib/warnings/sv Thu Mar 18 12:51:14 2004 --- perl-5.8.7.patched/t/lib/warnings/sv Mon Dec 12 18:03:42 2005 *************** *** 301,312 **** 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' ; --- 301,312 ---- 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 -rc perl-5.8.7/t/op/sprintf.t perl-5.8.7.patched/t/op/sprintf.t *** perl-5.8.7/t/op/sprintf.t Mon Sep 1 08:41:07 2003 --- perl-5.8.7.patched/t/op/sprintf.t Mon Dec 12 18:04:18 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 -rc perl-5.8.7/t/op/sprintf2.t perl-5.8.7.patched/t/op/sprintf2.t *** perl-5.8.7/t/op/sprintf2.t Mon Feb 9 21:37:13 2004 --- perl-5.8.7.patched/t/op/sprintf2.t Mon Dec 12 18:08:10 2005 *************** *** 6,12 **** require './test.pl'; } ! plan tests => 3; is( sprintf("%.40g ",0.01), --- 6,12 ---- require './test.pl'; } ! plan tests => 7 + 256; is( sprintf("%.40g ",0.01), *************** *** 25,28 **** --- 25,70 ---- "\xe4 ", q(width calculation under utf8 upgrade) ); + } + + # 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.7/globvar.sym Mon Aug 14 16:22:14 2000 --- perl-5.8.7.patched/globvar.sym Mon Dec 12 21:04:34 2005 *************** *** 66,68 **** --- 66,69 ---- vtbl_collxfrm vtbl_amagic vtbl_amagicelem + memory_wrap