r1338 - trunk/perl

archaic at linuxfromscratch.org archaic at linuxfromscratch.org
Wed Jan 11 12:12:53 PST 2006


Author: archaic
Date: 2006-01-11 13:12:52 -0700 (Wed, 11 Jan 2006)
New Revision: 1338

Added:
   trunk/perl/perl-5.8.7-sprintf_vulnerability-1.patch
Log:
Added perl-5.8.7-sprintf_vulnerability-1.patch

Added: trunk/perl/perl-5.8.7-sprintf_vulnerability-1.patch
===================================================================
--- trunk/perl/perl-5.8.7-sprintf_vulnerability-1.patch	2006-01-11 05:25:12 UTC (rev 1337)
+++ trunk/perl/perl-5.8.7-sprintf_vulnerability-1.patch	2006-01-11 20:12:52 UTC (rev 1338)
@@ -0,0 +1,340 @@
+Submitted By: Robert Connolly <robert at linuxfromscratch dot org> (ashes)
+Date: 2006-01-08
+Initial Package Version: 5.8.7
+Upstream Status: From Upstream
+Origin: http://www.perlfoundation.org/news/2005/sprintf_patch_released.html
+Description: This patches a vulnerability in sprintf.
+
+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




More information about the patches mailing list