Pullup ticket #2408 - requested by he

Security patch for perl

Revisions pulled up:
- lang/perl5/Makefile		1.137
- lang/perl5/distinfo		1.48
- lang/perl5/patches/patch-ad	1.11
- lang/perl5/patches/patch-af	1.13
- lang/perl5/patches/patch-ag	1.11
- lang/perl5/patches/patch-ai	1.5
- lang/perl5/patches/patch-aj	1.9
- lang/perl5/patches/patch-ak	1.3
- lang/perl5/patches/patch-da	1.2
---
    Module Name:	pkgsrc
    Committed By:	he
    Date:		Sun Jun  1 22:04:07 UTC 2008

    Modified Files:
	pkgsrc/lang/perl5: Makefile distinfo
	pkgsrc/lang/perl5/patches: patch-da
    Added Files:
	pkgsrc/lang/perl5/patches: patch-ad patch-af patch-ag patch-ai patch-aj
	    patch-ak

    Log Message:
    Apply a patch from Debian to fix the security vulnerability identified
    by http://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2008-1927.

    Patch fetched from
    http://bugs.debian.org/cgi-bin/bugreport.cgi?msg=26;filename=27_fix_regcomp_utf8;att=1;bug=454792
    which, according to comments, is from upstream change 27688.

    Revision bumped to nb8.

9 files changed, 286 insertions, 58 deletions

diff --git a/lang/perl5/Makefile b/lang/perl5/Makefile
index eaf8c09805c..cf94f5ab960 100644
--- a/lang/perl5/Makefile
+++ b/lang/perl5/Makefile
@@ -1,7 +1,7 @@
-# $NetBSD: Makefile,v 1.136 2008/02/19 19:28:39 tnn Exp $
+# $NetBSD: Makefile,v 1.136.2.1 2008/06/02 09:15:44 tron Exp $
 
 DISTNAME=	perl-5.8.8
-PKGREVISION=	7
+PKGREVISION=	8
 CATEGORIES=	lang devel perl5
 MASTER_SITES=	${MASTER_SITE_PERL_CPAN:S,/modules/by-module/$,/src/,}
 EXTRACT_SUFX=	.tar.bz2
diff --git a/lang/perl5/distinfo b/lang/perl5/distinfo
index 7675a1f9aec..353a6049ff5 100644
--- a/lang/perl5/distinfo
+++ b/lang/perl5/distinfo
@@ -1,4 +1,4 @@
-$NetBSD: distinfo,v 1.46.2.1 2008/05/30 17:13:43 spz Exp $
+$NetBSD: distinfo,v 1.46.2.2 2008/06/02 09:15:44 tron Exp $
 
 SHA1 (perl-5.8.8.tar.bz2) = 4aab490040727ca4419098720eca2ba4367df539
 RMD160 (perl-5.8.8.tar.bz2) = e78f26d9b96e6db35f946ad4ff55e3a69385c71b
@@ -6,8 +6,14 @@ Size (perl-5.8.8.tar.bz2) = 10123359 bytes
 SHA1 (patch-aa) = 9b6844635086206dc7740103747a2b54bf987941
 SHA1 (patch-ab) = e32427327192f023477b16f29bc55fdf4f057410
 SHA1 (patch-ac) = 428e0757495b82a47ec092a71333fb3ec366f14f
+SHA1 (patch-ad) = 914e1c74555a9b6a0256992a694b2ba609f29786
 SHA1 (patch-ae) = 287ac0d97a5372c8b45457129f3e70fe42cf69e2
+SHA1 (patch-af) = b11574297e46b910f206f09702effc6cc272b0fd
+SHA1 (patch-ag) = 0122ec30b8fcd17198e068d07e95974bee0945b6
 SHA1 (patch-ah) = 25443063c26287b1b8130c53d5c9d92248d4c0d1
+SHA1 (patch-ai) = 4a07c6268a1e27b73f2f6fcde86f788fce77fcbd
+SHA1 (patch-aj) = a2fc32766ed8556455c60780fe242a034ce491a9
+SHA1 (patch-ak) = 8899f8b6d1d038b950979073cb0527c8e7afca1e
 SHA1 (patch-am) = cf1687063d0c0542e811545aaaad291bad12d75e
 SHA1 (patch-an) = 987763c3098bf4356993dd6d8741962a1ff8190d
 SHA1 (patch-ap) = 178d6909a8aa6544b849c2b63530fcf1893b77ea
@@ -23,6 +29,6 @@ SHA1 (patch-ci) = fe943f07044efa457d163eb86974ea10bb356226
 SHA1 (patch-cj) = 3f40f1b166a054d55224c3e79d74516ca608b696
 SHA1 (patch-ck) = 28207b8186c9ad194a1edc696159915bc16d1097
 SHA1 (patch-cn) = b5e56787fb9ca10025e9061d7bfd2da549ee3fa3
-SHA1 (patch-da) = b25f30544dd679d95997cafb7e427a41f98884b1
+SHA1 (patch-da) = 24c8783fcdbead35de20bc3cecf1627a64717853
 SHA1 (patch-ta) = ca0d1e4bc2dbbc4b86a087fed27cd1e7bbb2873f
 SHA1 (patch-zc) = 0c61b6028813e0f80bfe0760a1e74e3037d37cdd
diff --git a/lang/perl5/patches/patch-ad b/lang/perl5/patches/patch-ad
new file mode 100644
index 00000000000..0c0abdeeb6c
--- /dev/null
+++ b/lang/perl5/patches/patch-ad
@@ -0,0 +1,17 @@
+$NetBSD: patch-ad,v 1.10.22.1 2008/06/02 09:15:44 tron Exp $
+
+Fix for
+http://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2008-1927
+from
+http://bugs.debian.org/cgi-bin/bugreport.cgi?msg=26;filename=27_fix_regcomp_utf8;att=1;bug=454792
+
+--- embed.fnc.orig	2006-01-31 15:40:27.000000000 +0100
++++ embed.fnc
+@@ -1168,6 +1168,7 @@ Es	|void	|reguni		|NN const struct RExC_
+ Es	|regnode*|regclass	|NN struct RExC_state_t *state
+ ERs	|I32	|regcurly	|NN const char *
+ Es	|regnode*|reg_node	|NN struct RExC_state_t *state|U8 op
++Es	|UV	|reg_recode	|const char value|NULLOK SV **encp
+ Es	|regnode*|regpiece	|NN struct RExC_state_t *state|NN I32 *flagp
+ Es	|void	|reginsert	|NN struct RExC_state_t *state|U8 op|NN regnode *opnd
+ Es	|void	|regoptail	|NN struct RExC_state_t *state|NN regnode *p|NN regnode *val
diff --git a/lang/perl5/patches/patch-af b/lang/perl5/patches/patch-af
new file mode 100644
index 00000000000..c74f748d6fd
--- /dev/null
+++ b/lang/perl5/patches/patch-af
@@ -0,0 +1,25 @@
+$NetBSD: patch-af,v 1.12.22.1 2008/06/02 09:15:44 tron Exp $
+
+Fix for
+http://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2008-1927
+from
+http://bugs.debian.org/cgi-bin/bugreport.cgi?msg=26;filename=27_fix_regcomp_utf8;att=1;bug=454792
+
+--- embed.h.orig	2006-01-31 16:50:34.000000000 +0100
++++ embed.h
+@@ -1234,6 +1234,7 @@
+ #define regclass		S_regclass
+ #define regcurly		S_regcurly
+ #define reg_node		S_reg_node
++#define reg_recode		S_reg_recode
+ #define regpiece		S_regpiece
+ #define reginsert		S_reginsert
+ #define regoptail		S_regoptail
+@@ -3277,6 +3278,7 @@
+ #define regclass(a)		S_regclass(aTHX_ a)
+ #define regcurly(a)		S_regcurly(aTHX_ a)
+ #define reg_node(a,b)		S_reg_node(aTHX_ a,b)
++#define reg_recode(a,b)		S_reg_recode(aTHX_ a,b)
+ #define regpiece(a,b)		S_regpiece(aTHX_ a,b)
+ #define reginsert(a,b,c)	S_reginsert(aTHX_ a,b,c)
+ #define regoptail(a,b,c)	S_regoptail(aTHX_ a,b,c)
diff --git a/lang/perl5/patches/patch-ag b/lang/perl5/patches/patch-ag
new file mode 100644
index 00000000000..4ac05b8737f
--- /dev/null
+++ b/lang/perl5/patches/patch-ag
@@ -0,0 +1,25 @@
+$NetBSD: patch-ag,v 1.10.22.1 2008/06/02 09:15:44 tron Exp $
+
+Fix for
+http://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2008-1927
+from
+http://bugs.debian.org/cgi-bin/bugreport.cgi?msg=26;filename=27_fix_regcomp_utf8;att=1;bug=454792
+
+--- pod/perldiag.pod.orig	2006-01-07 00:16:08.000000000 +0100
++++ pod/perldiag.pod
+@@ -1900,6 +1900,15 @@ recognized by Perl or by a user-supplied
+ (W printf) Perl does not understand the given format conversion.  See
+ L<perlfunc/sprintf>.
+ 
++=item Invalid escape in the specified encoding in regex; marked by <-- HERE in m/%s/
++
++(W regexp) The numeric escape (for example C<\xHH>) of value < 256
++didn't correspond to a single character through the conversion
++from the encoding specified by the encoding pragma.
++The escape was replaced with REPLACEMENT CHARACTER (U+FFFD) instead.
++The <-- HERE shows in the regular expression about where the
++escape was discovered.
++
+ =item Invalid [] range "%s" in regex; marked by <-- HERE in m/%s/
+ 
+ (F) The range specified in a character class had a minimum character
diff --git a/lang/perl5/patches/patch-ai b/lang/perl5/patches/patch-ai
new file mode 100644
index 00000000000..2f42cfa8438
--- /dev/null
+++ b/lang/perl5/patches/patch-ai
@@ -0,0 +1,17 @@
+$NetBSD: patch-ai,v 1.4.36.1 2008/06/02 09:15:44 tron Exp $
+
+Fix for
+http://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2008-1927
+from
+http://bugs.debian.org/cgi-bin/bugreport.cgi?msg=26;filename=27_fix_regcomp_utf8;att=1;bug=454792
+
+--- proto.h.orig	2006-01-31 16:50:34.000000000 +0100
++++ proto.h
+@@ -1748,6 +1748,7 @@ STATIC I32	S_regcurly(pTHX_ const char *
+ 			__attribute__warn_unused_result__;
+ 
+ STATIC regnode*	S_reg_node(pTHX_ struct RExC_state_t *state, U8 op);
++STATIC UV	S_reg_recode(pTHX_ const char value, SV **encp);
+ STATIC regnode*	S_regpiece(pTHX_ struct RExC_state_t *state, I32 *flagp);
+ STATIC void	S_reginsert(pTHX_ struct RExC_state_t *state, U8 op, regnode *opnd);
+ STATIC void	S_regoptail(pTHX_ struct RExC_state_t *state, regnode *p, regnode *val);
diff --git a/lang/perl5/patches/patch-aj b/lang/perl5/patches/patch-aj
new file mode 100644
index 00000000000..b2716f0c397
--- /dev/null
+++ b/lang/perl5/patches/patch-aj
@@ -0,0 +1,31 @@
+$NetBSD: patch-aj,v 1.8.22.1 2008/06/02 09:15:44 tron Exp $
+
+Fix for
+http://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2008-1927
+from
+http://bugs.debian.org/cgi-bin/bugreport.cgi?msg=26;filename=27_fix_regcomp_utf8;att=1;bug=454792
+
+--- t/uni/tr_utf8.t.orig	2004-06-25 10:53:16.000000000 +0200
++++ t/uni/tr_utf8.t
+@@ -31,7 +31,7 @@ BEGIN {
+ }
+ 
+ use strict;
+-use Test::More tests => 7;
++use Test::More tests => 8;
+ 
+ use encoding 'utf8';
+ 
+@@ -67,4 +67,12 @@ is($str, $hiragana, "s/// # hiragana -> 
+   $line =~ tr/bcdeghijklmnprstvwxyz$02578/בצדעגהיײקלמנפּרסטװשכיזשױתײחא/;
+   is($line, "aבצדעfגהיײקלמנoפqּרסuטװשכיזש1ױ34ת6ײח9", "[perl #16843]");
+ }
++
++{
++  # [perl #40641]
++  my $str = qq/Gebääääääääääääääääääääude/;
++  my $reg = qr/Gebääääääääääääääääääääude/;
++  ok($str =~ /$reg/, "[perl #40641]");
++}
++
+ __END__
diff --git a/lang/perl5/patches/patch-ak b/lang/perl5/patches/patch-ak
new file mode 100644
index 00000000000..2ddd60a9519
--- /dev/null
+++ b/lang/perl5/patches/patch-ak
@@ -0,0 +1,18 @@
+$NetBSD: patch-ak,v 1.2.36.1 2008/06/02 09:15:44 tron Exp $
+
+Fix for
+http://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2008-1927
+from
+http://bugs.debian.org/cgi-bin/bugreport.cgi?msg=26;filename=27_fix_regcomp_utf8;att=1;bug=454792
+
+--- utf8.h.orig	2006-01-08 22:11:27.000000000 +0100
++++ utf8.h
+@@ -198,6 +198,8 @@ encoded character.
+ 					 UTF8_ALLOW_SURROGATE|UTF8_ALLOW_FFFF)
+ #define UTF8_ALLOW_ANY			0x00FF
+ #define UTF8_CHECK_ONLY			0x0200
++#define UTF8_ALLOW_DEFAULT             (ckWARN(WARN_UTF8) ? 0 : \
++                                        UTF8_ALLOW_ANYUV)
+ 
+ #define UNICODE_SURROGATE_FIRST		0xD800
+ #define UNICODE_SURROGATE_LAST		0xDFFF
diff --git a/lang/perl5/patches/patch-da b/lang/perl5/patches/patch-da
index dd3765cb09f..ef6f941a3de 100644
--- a/lang/perl5/patches/patch-da
+++ b/lang/perl5/patches/patch-da
@@ -1,61 +1,150 @@
-$NetBSD: patch-da,v 1.1 2007/11/06 19:54:53 drochner Exp $
+$NetBSD: patch-da,v 1.1.6.1 2008/06/02 09:15:44 tron Exp $
 
---- regcomp.c.orig	2006-01-08 21:59:27.000000000 +0100
+Fix for
+http://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2008-1927
+from
+http://bugs.debian.org/cgi-bin/bugreport.cgi?msg=26;filename=27_fix_regcomp_utf8;att=1;bug=454792
+
+--- regcomp.c.orig	2008-06-01 22:04:17.000000000 +0200
 +++ regcomp.c
-@@ -135,7 +135,8 @@ typedef struct RExC_state_t {
-     I32		extralen;
-     I32		seen_zerolen;
-     I32		seen_evals;
--    I32		utf8;
-+    I32		utf8;			/* pattern is utf8 or not */
-+    I32		orig_utf8;		/* pattern was originally utf8 */
- #if ADD_TO_REGEXEC
-     char 	*starttry;		/* -Dr: where regtry was called. */
- #define RExC_starttry	(pRExC_state->starttry)
-@@ -161,6 +162,7 @@ typedef struct RExC_state_t {
- #define RExC_seen_zerolen	(pRExC_state->seen_zerolen)
- #define RExC_seen_evals	(pRExC_state->seen_evals)
- #define RExC_utf8	(pRExC_state->utf8)
-+#define RExC_orig_utf8	(pRExC_state->orig_utf8)
- 
- #define	ISMULT1(c)	((c) == '*' || (c) == '+' || (c) == '?')
- #define	ISMULT2(s)	((*s) == '*' || (*s) == '+' || (*s) == '?' || \
-@@ -1749,15 +1751,17 @@ Perl_pregcomp(pTHX_ char *exp, char *xen
-     if (exp == NULL)
- 	FAIL("NULL regexp argument");
+@@ -2790,6 +2790,39 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_sta
+ }
  
--    RExC_utf8 = pm->op_pmdynflags & PMdf_CMP_UTF8;
-+    RExC_orig_utf8 = RExC_utf8 = pm->op_pmdynflags & PMdf_CMP_UTF8;
- 
--    RExC_precomp = exp;
-     DEBUG_r({
- 	 if (!PL_colorset) reginitcolors();
- 	 PerlIO_printf(Perl_debug_log, "%sCompiling REx%s `%s%*s%s'\n",
- 		       PL_colors[4],PL_colors[5],PL_colors[0],
--		       (int)(xend - exp), RExC_precomp, PL_colors[1]);
-+		       (int)(xend - exp), exp, PL_colors[1]);
-     });
+ /*
++ * reg_recode
++ *
++ * It returns the code point in utf8 for the value in *encp.
++ *    value: a code value in the source encoding
++ *    encp:  a pointer to an Encode object
++ *
++ * If the result from Encode is not a single character,
++ * it returns U+FFFD (Replacement character) and sets *encp to NULL.
++ */
++STATIC UV
++S_reg_recode(pTHX_ const char value, SV **encp)
++{
++    STRLEN numlen = 1;
++    SV * const sv = sv_2mortal(newSVpvn(&value, numlen));
++    const char * const s = encp && *encp ? sv_recode_to_utf8(sv, *encp)
++					 : SvPVX(sv);
++    const STRLEN newlen = SvCUR(sv);
++    UV uv = UNICODE_REPLACEMENT;
 +
-+redo_first_pass:
-+    RExC_precomp = exp;
-     RExC_flags = pm->op_pmflags;
-     RExC_sawback = 0;
- 
-@@ -1783,6 +1787,17 @@ Perl_pregcomp(pTHX_ char *exp, char *xen
- 	RExC_precomp = Nullch;
- 	return(NULL);
-     }
-+    if (RExC_utf8 && !RExC_orig_utf8) {
-+        STRLEN len = xend-exp;
-+        DEBUG_r(PerlIO_printf(Perl_debug_log,
-+                    "UTF8 mismatch! Converting to utf8 for resizing and compile\n"));
-+        exp = (char*)Perl_bytes_to_utf8(aTHX_ (U8*)exp, &len);
-+        xend = exp + len;
-+        RExC_orig_utf8 = RExC_utf8;
-+        SAVEFREEPV(exp);
-+        goto redo_first_pass;
++    if (newlen)
++	uv = SvUTF8(sv)
++	     ? utf8n_to_uvchr((U8*)s, newlen, &numlen, UTF8_ALLOW_DEFAULT)
++	     : *(U8*)s;
++
++    if (!newlen || numlen != newlen) {
++	uv = UNICODE_REPLACEMENT;
++	if (encp)
++	    *encp = NULL;
 +    }
++    return uv;
++}
 +
-     DEBUG_r(PerlIO_printf(Perl_debug_log, "size %"IVdf" ", (IV)RExC_size));
++/*
+  - regatom - the lowest level
+  *
+  * Optimization:  gobbles an entire sequence of ordinary characters so that
+@@ -3181,6 +3214,8 @@ tryagain:
+ 			    ender = grok_hex(p, &numlen, &flags, NULL);
+ 			    p += numlen;
+ 			}
++			if (PL_encoding && ender < 0x100)
++			    goto recode_encoding;
+ 			break;
+ 		    case 'c':
+ 			p++;
+@@ -3200,6 +3235,17 @@ tryagain:
+ 			    --p;
+ 			    goto loopdone;
+ 			}
++			if (PL_encoding && ender < 0x100)
++			    goto recode_encoding;
++			break;
++		    recode_encoding:
++			{
++			    SV* enc = PL_encoding;
++			    ender = reg_recode((const char)(U8)ender, &enc);
++			    if (!enc && SIZE_ONLY && ckWARN(WARN_REGEXP))
++				vWARN(p, "Invalid escape in the specified encoding");
++			    RExC_utf8 = 1;
++			}
+ 			break;
+ 		    case '\0':
+ 			if (p >= RExC_end)
+@@ -3330,32 +3376,6 @@ tryagain:
+ 	break;
+     }
+ 
+-    /* If the encoding pragma is in effect recode the text of
+-     * any EXACT-kind nodes. */
+-    if (PL_encoding && PL_regkind[(U8)OP(ret)] == EXACT) {
+-	STRLEN oldlen = STR_LEN(ret);
+-	SV *sv        = sv_2mortal(newSVpvn(STRING(ret), oldlen));
+-
+-	if (RExC_utf8)
+-	    SvUTF8_on(sv);
+-	if (sv_utf8_downgrade(sv, TRUE)) {
+-	    const char * const s = sv_recode_to_utf8(sv, PL_encoding);
+-	    const STRLEN newlen = SvCUR(sv);
+-
+-	    if (SvUTF8(sv))
+-		RExC_utf8 = 1;
+-	    if (!SIZE_ONLY) {
+-		DEBUG_r(PerlIO_printf(Perl_debug_log, "recode %*s to %*s\n",
+-				      (int)oldlen, STRING(ret),
+-				      (int)newlen, s));
+-		Copy(s, STRING(ret), newlen, char);
+-		STR_LEN(ret) += newlen - oldlen;
+-		RExC_emit += STR_SZ(newlen) - STR_SZ(oldlen);
+-	    } else
+-		RExC_size += STR_SZ(newlen) - STR_SZ(oldlen);
+-	}
+-    }
+-
+     return(ret);
+ }
  
-     /* Small enough for pointer-storage convention?
+@@ -3733,6 +3753,8 @@ S_regclass(pTHX_ RExC_state_t *pRExC_sta
+ 		    value = grok_hex(RExC_parse, &numlen, &flags, NULL);
+ 		    RExC_parse += numlen;
+ 		}
++		if (PL_encoding && value < 0x100)
++		    goto recode_encoding;
+ 		break;
+ 	    case 'c':
+ 		value = UCHARAT(RExC_parse++);
+@@ -3740,13 +3762,24 @@ S_regclass(pTHX_ RExC_state_t *pRExC_sta
+ 		break;
+ 	    case '0': case '1': case '2': case '3': case '4':
+ 	    case '5': case '6': case '7': case '8': case '9':
+-            {
+-                I32 flags = 0;
+-		numlen = 3;
+-		value = grok_oct(--RExC_parse, &numlen, &flags, NULL);
+-		RExC_parse += numlen;
+-		break;
+-            }
++		{
++		    I32 flags = 0;
++		    numlen = 3;
++		    value = grok_oct(--RExC_parse, &numlen, &flags, NULL);
++		    RExC_parse += numlen;
++		    if (PL_encoding && value < 0x100)
++			goto recode_encoding;
++		    break;
++		}
++	    recode_encoding:
++		{
++		    SV* enc = PL_encoding;
++		    value = reg_recode((const char)(U8)value, &enc);
++		    if (!enc && SIZE_ONLY && ckWARN(WARN_REGEXP))
++			vWARN(RExC_parse,
++			      "Invalid escape in the specified encoding");
++		    break;
++		}
+ 	    default:
+ 		if (!SIZE_ONLY && isALPHA(value) && ckWARN(WARN_REGEXP))
+ 		    vWARN2(RExC_parse,