OBS-URL: https://build.opensuse.org/package/show/openSUSE:Factory/perl?expand=0&rev=21

perl-file_path_rmtree_chmod.diff

@@ -0,0 +1,30 @@
+A simple test case for this bug is:
+
+touch foo  # permissions 0666 & ~umask
+ln -s foo bar
+perl -e 'use File::Path rmtree; rmtree bar'
+ls -l foo  # permissions 0777
+
+The following patch fixes that and the originally reported problem.  I
+believe the other chmod() calls in the _rmtree subroutine will never be
+applied to a sym-link if either (1) no concurrent modifications of the
+directory tree or (2) the 'safe' option is used.  It would be worthwhile
+for someone else to double-check that, though.
+
+Ben.
+
+--- lib/File/Path.pm.orig
++++ lib/File/Path.pm
+@@ -351,10 +351,8 @@
+             }
+ 
+             my $nperm = $perm & 07777 | 0600;
+-            if ($nperm != $perm and not chmod $nperm, $root) {
+-                if ($Force_Writeable) {
+-                    _error($arg, "cannot make file writeable", $canon);
+-                }
++            if ($Force_Writeable && $nperm != $perm and not chmod $nperm, $root) {
++                _error($arg, "cannot make file writeable", $canon);
+             }
+             print "unlink $canon\n" if $arg->{verbose};
+             # delete all versions under VMS

perl-regexp-refoverflow.diff

@@ -0,0 +1,38 @@
+--- regcomp.c
++++ regcomp.c
+@@ -5713,7 +5713,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I
+ 
+                 ret = reganode(pRExC_state, GOSUB, num);
+                 if (!SIZE_ONLY) {
+-		    if (num > (I32)RExC_rx->nparens) {
++		    if (num < 0 || num > (I32)RExC_rx->nparens) {
+ 			RExC_parse++;
+ 			vFAIL("Reference to nonexistent group");
+ 	            }
+@@ -7132,7 +7132,7 @@ tryagain:
+                     if (num < 1)
+                         vFAIL("Reference to nonexistent or unclosed group");
+                 }
+-		if (!isg && num > 9 && num >= RExC_npar)
++		if (!isg && (num < 0 || (num > 9 && num >= RExC_npar)))
+ 		    goto defchar;
+ 		else {
+ 		    char * const parse_start = RExC_parse - 1; /* MJD */
+@@ -7146,7 +7146,7 @@ tryagain:
+                         RExC_parse++;
+                     }    
+ 		    if (!SIZE_ONLY) {
+-		        if (num > (I32)RExC_rx->nparens)
++		        if (num < 0 || num > (I32)RExC_rx->nparens)
+ 			    vFAIL("Reference to nonexistent group");
+ 		    }
+ 		    RExC_sawback = 1;
+@@ -7323,7 +7323,7 @@ tryagain:
+ 		    case '0': case '1': case '2': case '3':case '4':
+ 		    case '5': case '6': case '7': case '8':case '9':
+ 			if (*p == '0' ||
+-			  (isDIGIT(p[1]) && atoi(p) >= RExC_npar) ) {
++			  (isDIGIT(p[1]) && (U32)atoi(p) >= (U32)RExC_npar) ) {
+                             I32 flags = 0;
+ 			    STRLEN numlen = 3;
+ 			    ender = grok_oct(p, &numlen, &flags, NULL);

perl.changes

@@ -1,3 +1,20 @@
+-------------------------------------------------------------------
+Mon Jul 14 16:07:39 CEST 2008 - schwab@suse.de
+
+- Fix another regexp backref overflow crash.
+- Reenable testsuite on ppc64.
+
+-------------------------------------------------------------------
+Mon Jul 14 13:53:49 CEST 2008 - mls@suse.de
+
+- fix regexp backref overflow crash fix
+
+-------------------------------------------------------------------
+Fri Jul 11 14:23:02 CEST 2008 - mls@suse.de
+
+- fix bug File:Path that made synlink targets world-writable [bnc#402660]
+- fix regexp backref overflow crash [bnc#372331]
+
 -------------------------------------------------------------------
 Tue May  6 21:34:57 CEST 2008 - aj@suse.de
 

perl.spec

@@ -2,13 +2,19 @@
 # spec file for package perl (Version 5.10.0)
 #
 # Copyright (c) 2008 SUSE LINUX Products GmbH, Nuernberg, Germany.
-# This file and all modifications and additions to the pristine
-# package are under the same license as the package itself.
 #
+# All modifications and additions to the file contributed by third parties
+# remain the property of their copyright owners, unless otherwise agreed
+# upon. The license for this file, and modifications and additions to the
+# file, is the same license as for the pristine package itself (unless the
+# license for the pristine package is not an Open Source License, in which
+# case the license is the MIT License). An "Open Source License" is a
+# license that conforms to the Open Source Definition (Version 1.9)
+# published by the Open Source Initiative.
+
 # Please submit bugfixes or comments via http://bugs.opensuse.org/
 #
 
-# norootforbuild
 # icecream 0
 
 
@@ -16,7 +22,7 @@ Name:           perl
 Url:            http://www.perl.org/
 BuildRequires:  db-devel gdbm-devel ncurses-devel zlib-devel
 Version:        5.10.0
-Release:        32
+Release:        50
 Summary:        The Perl interpreter
 License:        Artistic License; GPL v2 or later
 Group:          Development/Languages/Perl
@@ -39,6 +45,8 @@ Patch1:         perl-gracefull-net-ftp.diff
 Patch2:         perl-5.10.0-regexp.diff
 Patch3:         perl-fix_dbmclose_call.patch
 Patch4:         perl-5.10.0-warn.diff
+Patch5:         perl-regexp-refoverflow.diff
+Patch6:         perl-file_path_rmtree_chmod.diff
 BuildRoot:      %{_tmppath}/%{name}-%{version}-build
 
 %description
@@ -107,6 +115,8 @@ Authors:
 %patch2
 %patch3
 %patch4
+%patch5
+%patch6
 
 %build
 options="-Doptimize='$RPM_OPT_FLAGS -Wall -pipe'"
@@ -128,7 +138,7 @@ mv lib/Config_heavy.pl saveConfig_heavy.pl
 make clobber
 ./configure.gnu --prefix=/usr -Dvendorprefix=/usr -Dinstallusrbinperl -Dusethreads -Di_db -Di_dbm -Di_ndbm -Di_gdbm $options
 make
-%ifnarch ppc64 %arm
+%ifnarch %arm
 
 %check
 # delete broken File::Find test
@@ -174,6 +184,8 @@ rm $RPM_BUILD_ROOT/usr/lib/perl5/*/*/CORE/libperl.a
 #touch $cpa/perllocal.pod
 # test CVE-2007-5116
 $RPM_BUILD_ROOT/usr/bin/perl -e '$r=chr(128)."\\x{100}";/$r/'
+# test perl-regexp-refoverflow.diff
+$RPM_BUILD_ROOT/usr/bin/perl -e '/\6666666666/'
 %if 1
 # remove unrelated target/os manpages
 rm $RPM_BUILD_ROOT/usr/share/man/man1/perlaix.1*
@@ -284,18 +296,17 @@ cat << EOF > perl-base-filelist
 /usr/lib/perl5/%version/*-linux-thread-multi*/lib.pm
 /usr/lib/perl5/%version/*-linux-thread-multi*/re.pm
 EOF
-cat perl-base-filelist | sed -e 's/^/%exclude /g' > perl-base-excludes
+{
-: > perl-pod-excludes
+  sed -e 's/^/%%exclude /' perl-base-filelist
-for i in $RPM_BUILD_ROOT/usr/lib/perl5/*/pod/*; do
+  (cd $RPM_BUILD_ROOT
-  echo "%exclude $i" >> perl-pod-excludes
+   for i in usr/lib/perl5/*/pod/*; do
-done
+     case $i in */perldiag.pod) ;;
-grep -v perldiag.pod perl-pod-excludes > perl-pod-excludes.new
+     *) echo "%%exclude /$i" ;;
-mv perl-pod-excludes.new perl-pod-excludes
+     esac
-sed -i -e "s,$RPM_BUILD_ROOT,," perl-pod-excludes
+   done)
-# can %files take two file lists?
+} > perl-base-excludes
-cat perl-pod-excludes >> perl-base-excludes
+#%%post
-#%post
+#%%{fillup_only -an suseconfig}
-#%{fillup_only -an suseconfig}
 
 %files base -f perl-base-filelist
 %defattr(-,root,root)
@@ -335,6 +346,14 @@ cat perl-pod-excludes >> perl-base-excludes
 %doc /usr/lib/perl5/*/unicore/*.txt
 
 %changelog
+* Mon Jul 14 2008 schwab@suse.de
+- Fix another regexp backref overflow crash.
+- Reenable testsuite on ppc64.
+* Mon Jul 14 2008 mls@suse.de
+- fix regexp backref overflow crash fix
+* Fri Jul 11 2008 mls@suse.de
+- fix bug File:Path that made synlink targets world-writable [bnc#402660]
+- fix regexp backref overflow crash [bnc#372331]
 * Tue May 06 2008 aj@suse.de
 - Fix missing return value in configure script to silence rpmlint
   checks.