diff --git a/.gitignore b/.gitignore index 6061e74..2956760 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,34 @@ -/perl-5.30.1-study_chunk-avoid-mutating-regexp-program-within-GOS.patch +perl-5.12.1.tar.gz +/perl-5.12.2.tar.gz +/perl-5.12.3.tar.gz +/perl-5.14.0-RC2.tar.bz2 +/perl-5.14.0.tar.bz2 +/perl-5.14.0.tar.gz +/perl-5.14.1.tar.gz +/perl-5.14.2.tar.bz2 +/perl-5.16.0-RC2.tar.gz +/perl-5.16.0.tar.gz +/perl-5.16.1-228.fc19.src.rpm +/perl-5.16.1.tar.gz +/perl-5.16.2.tar.gz +/perl-5.16.3.tar.bz2 +/perl-5.18.0.tar.bz2 +/perl-5.18.1.tar.bz2 +/perl-5.18.2.tar.bz2 +/perl-5.20.0.tar.bz2 +/perl-5.20.1.tar.bz2 +/perl-5.20.2.tar.bz2 +/perl-5.22.0.tar.bz2 +/perl-5.22.1.tar.bz2 +/perl-5.22.2.tar.bz2 +/perl-5.24.0.tar.bz2 +/perl-5.24.1.tar.bz2 +/perl-5.26.0.tar.bz2 +/perl-5.26.1.tar.bz2 +/perl-5.26.2-RC1.tar.bz2 +/perl-5.26.2.tar.bz2 +/perl-5.28.0.tar.xz +/perl-5.28.1.tar.xz +/perl-5.28.2.tar.xz +/perl-5.30.0.tar.xz /perl-5.30.1.tar.xz diff --git a/STAGE2-perl b/STAGE2-perl new file mode 100644 index 0000000..8a4676a --- /dev/null +++ b/STAGE2-perl @@ -0,0 +1,29 @@ +#requires gdbm + +mcd $BUILDDIR/perl + +GV=$(cd $SRC; echo perl-*) +SONAME_VER=`echo $GV | cut -f2- -d'-' | sed 's/^\\([^.]*\\.[^.]*\\).*/\\1/'` +PERL_VER=`echo $GV | cut -f2- -d'-'` + +cd $SRC/$GV + +sh $SRC/$GV/Configure -des -Dprefix=/usr -Dlibpth="/usr/local/lib$SUFFIX /lib$SUFFIX /usr/lib$SUFFIX" -Darchlib="/usr/lib$SUFFIX/perl5" -Dsitelib="/usr/local/share/perl5" -DDEBUGGING=-g -Dcc=gcc -Dmyhostname=localhost -Dperladmin=root@localhost -Duseshrplib -Dusethreads -Duseithreads -Uusedtrace -Duselargefiles -Dd_semctl_semun -Di_db -Ui_ndbm -Di_gdbm -Di_shadow -Di_syslog -Dman3ext=3pm -Duseperlio -Dinstallusrbinperl=n -Ubincompat5005 -Uversiononly -Dd_gethostent_r_proto -Ud_endhostent_r_proto -Ud_sethostent_r_proto -Ud_endprotoent_r_proto -Ud_setprotoent_r_proto -Ud_endservent_r_proto -Ud_setservent_r_proto + +BUILD_BZIP2=0 +BZIP2_LIB=%{_libdir} +export BUILD_BZIP2 BZIP2_LIB + +ln -sf libperl.so libperl.so.${SONAME_VER} + +make + +rm -f /usr/lib${SUFFIX}/perl5/CORE/libperl.so + +make install + +rm -f /usr/lib${SUFFIX}/libperl.so.${PERL_VER} +mv /usr/lib${SUFFIX}/perl5/CORE/libperl.so /usr/lib${SUFFIX}/libperl.so.${PERL_VER} +ln -sf libperl.so.${PERL_VER} /usr/lib${SUFFIX}/libperl.so.${SONAME_VER} +ln -sf libperl.so.${PERL_VER} /usr/lib${SUFFIX}/libperl.so +ln -sf libperl.so.${PERL_VER} /usr/lib${SUFFIX}/perl5/CORE/libperl.so diff --git a/checkemptydirs b/checkemptydirs new file mode 100644 index 0000000..a68335f --- /dev/null +++ b/checkemptydirs @@ -0,0 +1,11 @@ +#!/bin/bash +for P in "$@"; do + echo "Empty directories in RPM package $P:" + + for D in $(rpm -qlvp "$P" | \ + perl -ne \ + 'if (/\Adrwx/) {$n=${[split /\s+/]}[8]; print qq{$n\n}}' | \ + sort -f); do + test $(rpm -qlp "$P" | grep -c -F "$D/") == 0 && echo "$D"; + done +done diff --git a/checkpackageversion b/checkpackageversion new file mode 100644 index 0000000..f857253 --- /dev/null +++ b/checkpackageversion @@ -0,0 +1,93 @@ +#!/usr/bin/perl +use strict; +use warnings; +use utf8; + +use RPM2; + +for my $rpm_file (@ARGV) { + my $package = RPM2->open_package($rpm_file) + or die q{Could not open `} . $rpm_file . q{'.}; + + my $package_name = $package->tag('NAME'); + my $package_version = $package->tag('VERSION'); + + my $module_name = $package_name; + $module_name =~ s/^([^-]+)-(.*)/$1($2)/; + $module_name =~ s/-/::/g; + + my @names = $package->tag('PROVIDENAME'); + my @flags = $package->tag('PROVIDEFLAGS'); + my @versions = $package->tag('PROVIDEVERSION'); + if (!($#names == $#flags) && ($#names == $#versions)) { + die (q{Inconsistent number of provides names, flags, and versions in `} + . $rpm_file . q{'.}); + } + + my $found = 0; + for my $name (@names) { + my $flag = shift @flags; + my $version = shift @versions; + if ($name eq $module_name) { + $found = 1; + + if (($flag & 0x8) && (($flag & (0x2+0x4)) == 0)) { + if (!($package_version eq $version)) { + print $rpm_file . q{: Package version `} . + $package_version . q{' differs from `} . + $module_name . q{' module version `} . + $version . q{'.} . "\n"; + } + last; + } else { + print $rpm_file . q{: `} . $module_name . + q{' in list of provides is not qualified (}; + printf '0x%x', $flag; + print q{) as equaled.} . "\n"; + } + } + } + + if ($found == 0) { + print $rpm_file . q{: missing `} . $module_name . + q{' in list of provides.} . "\n"; + } +} + +__END__ +=encoding utf8 + +=head1 NAME + +checkpackageversion - Check a RPM package version matches main Perl module +version + +=head1 SYNOPSIS + +checkpackageversion RPM_PACKAGE... + +It opens each RPM_PACKAGE, guesses a main Perl module from package name, finds +it in list of provides (e.g. perl-Foo-Bar → perl(Foo::Bar) and compares +versions. It reports any irregularities to standard output. + +Petr Písař + +=head1 COPYING + +Copyright (C) 2011 Petr Písař + +This program is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program. If not, see . + +=cut + diff --git a/clean-manifest.pl b/clean-manifest.pl new file mode 100644 index 0000000..6b7e162 --- /dev/null +++ b/clean-manifest.pl @@ -0,0 +1,39 @@ +#!/usr/bin/perl -w +use strict; + +my ($arch, $patfile, $infile, $outfile, $libdir, $thread_arch) = @ARGV; + +if (not $arch or not $patfile or not $infile or not $outfile or not $libdir) { + die "Usage: $0 arch thread_arch pattern-file in-file out-file libdir [ threadarch ]"; +} + +$thread_arch ||= ''; + +open IN, "<$infile" + or die "Can't open $infile: $!"; +open OUT, ">$outfile" + or die "Can't open $outfile: $!"; +open PATTERN, "<$patfile" + or die "Can't open $patfile: $!"; + +my @patterns = ; +chomp @patterns; +for my $p (@patterns) { + $p =~ s/%{_libdir}/$libdir/g; + $p =~ s/%{_arch}/$arch/g; + $p =~ s/%{thread_arch}/$thread_arch/g; +} + +my %exclude = map { $_ => 1 } @patterns; + +close PATTERN; + +while() { + chomp; + + print OUT "$_\n" + unless exists $exclude{$_} +} + +close IN; +close OUT; diff --git a/diffrpms b/diffrpms new file mode 100644 index 0000000..b3a6edc --- /dev/null +++ b/diffrpms @@ -0,0 +1,33 @@ +#!/bin/bash + +if [ "$#" != 2 ]; then + cat<= 1" dependencies string into ("A", "B >= 1") list. +sub appendsymbols { + my ($array, $line) = @_; + my $qualified; + my $dependency; + for my $token (split(/\s/, $line)) { + if ($token =~ /\A[<>]?=\z/) { + $qualified = 1; + $dependency .= ' ' . $token; + next; + } + if (!$qualified) { + if (defined $dependency) { + push @$array, $dependency; + } + $dependency = $token; + next; + } + if ($qualified) { + $qualified = 0; + $dependency .= ' ' . $token; + push @$array, $dependency; + $dependency = undef; + next; + } + } + if (defined $dependency) { + push @$array, $dependency; + } +} + +# Return true if the argument is a Perl dependency. Otherwise return false. +sub is_perl_dependency { + my $dependency = shift; + return ($dependency =~ /\Aperl\(/); +} + +my $file = shift @ARGV; +if (!defined $file) { + die "Missing an argument with an RPM build log!\n" +} + +# Parse build log +open(my $log, '<', $file) or die "Could not open `$file': $!\n"; +my ($package, %packages); +while (!eof($log)) { + defined($_ = <$log>) or die "Error while reading from `$file': $!\n"; + chomp; + + if (/\AProcessing files: ([\S]+)-[^-]+-[^-]+$/) { + $package = $1; + $packages{$package}{requires} = []; + $packages{$package}{provides} = []; + } elsif ($package && /\AProvides: (.*)\z/) { + appendsymbols($packages{$package}{provides}, $1); + } elsif ($package && /\ARequires: (.*)\z/) { + appendsymbols($packages{$package}{requires}, $1); + } +} +close($log); + +# Save dependencies into file +my $filename = 'gendep.macros'; +open (my $gendep, '>', $filename) or + die "Could not open `$filename' for writing: $!\n"; +for my $package (sort keys %packages) { + # Macro name + my $macro = 'gendep_' . $package; + $macro =~ s/[+-]/_/g; + $gendep->print("%global $macro \\\n"); + # Macro value + for my $dependency (@{$packages{$package}{requires}}) { + if (is_perl_dependency($dependency)) { + $gendep->print("Requires: $dependency \\\n"); + } + } + for my $dependency (@{$packages{$package}{provides}}) { + if (is_perl_dependency($dependency)) { + $gendep->print("Provides: $dependency \\\n"); + } + } + # Macro trailer + $gendep->print("%{nil}\n"); +} +close($gendep) or die "Could not close `$filename': $!\n"; + + +__END__ +=encoding utf8 + +=head1 NAME + +generatedependencies - Distil generated Perl dependencies from a build log + +=head1 SYNOPSIS + +B I + +=head1 DESCRIPTION + +It opens specified RPM build log I. It locates a protocol about +autogenerated dependencies. It stores the reported dependencies into F<./gendep.macros> file. + +The output file will define macros C>. A macro +for each binary package. The macro name will use underscores instead of +hyphens or other SPEC language special characters. + +It will ignore non-Perl dependencies (not C) as they do not come from +Perl dependency generator. + +=head1 EXIT CODE + +Returns zero, if no error occurred. Otherwise non-zero code is returned. + +=head1 EXAMPLE + +The invocation is: + + $ generatedependencies .build-5.24.0-364.fc25.log + +The output is: + + $ grep -A5 perl_Devel_Peek gendep.macros + %global gendep_perl_Devel_Peek \ + Requires: perl(Exporter) \ + Requires: perl(XSLoader) \ + Provides: perl(Devel::Peek) = 1.23 \ + %nil{} + %global gendep_perl_Devel_SelfStubber \ + + +The output can be used in a spec file like: + + Name: perl + Source0: gendep.macros + %include %{SOURCE0} + %package Devel-Peek + %gendep_Devel_Peek + %package Devel-SelfStubber + %gendep_Devel_SelfStubber + +=head1 COPYING + +Copyright (C) 2016 Petr Písař + +This program is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program. If not, see . + +=cut diff --git a/perl-5.30.1-study_chunk-avoid-mutating-regexp-program-within-GOS.patch b/perl-5.30.1-study_chunk-avoid-mutating-regexp-program-within-GOS.patch new file mode 100644 index 0000000..70e5ed0 --- /dev/null +++ b/perl-5.30.1-study_chunk-avoid-mutating-regexp-program-within-GOS.patch @@ -0,0 +1,306 @@ +From 783ddef8fc74b00cde72898c2c3228853dc82d91 Mon Sep 17 00:00:00 2001 +From: Hugo van der Sanden +Date: Sat, 11 Apr 2020 14:10:24 +0100 +Subject: [PATCH] study_chunk: avoid mutating regexp program within GOSUB +MIME-Version: 1.0 +Content-Type: text/plain; charset=UTF-8 +Content-Transfer-Encoding: 8bit + +gh16947 and gh17743: studying GOSUB may restudy in an inner call +(via a mix of recursion and enframing) something that an outer call +is in the middle of looking at. Let the outer frame deal with it. + +(CVE-2020-12723) + +(cherry picked from commit c4033e740bd18d9fbe3456a9db2ec2053cdc5271) +Petr Písař: Ported to 5.30.1 from +66bbb51b93253a3f87d11c2695cfb7bdb782184a. +Signed-off-by: Petr Písař +--- + embed.fnc | 2 +- + embed.h | 2 +- + proto.h | 2 +- + regcomp.c | 54 +++++++++++++++++++++++++++++++++++------------------- + t/re/pat.t | 26 +++++++++++++++++++++++++- + 5 files changed, 63 insertions(+), 23 deletions(-) + +diff --git a/embed.fnc b/embed.fnc +index 1b9cf54..d0463e4 100644 +--- a/embed.fnc ++++ b/embed.fnc +@@ -2482,7 +2482,7 @@ Es |SSize_t|study_chunk |NN RExC_state_t *pRExC_state \ + |NULLOK struct scan_data_t *data \ + |I32 stopparen|U32 recursed_depth \ + |NULLOK regnode_ssc *and_withp \ +- |U32 flags|U32 depth ++ |U32 flags|U32 depth|bool was_mutate_ok + Es |void |rck_elide_nothing|NN regnode *node + EsR |SV * |get_ANYOFM_contents|NN const regnode * n + EsRn |U32 |add_data |NN RExC_state_t* const pRExC_state \ +diff --git a/embed.h b/embed.h +index cf44011..72c2a8e 100644 +--- a/embed.h ++++ b/embed.h +@@ -1239,7 +1239,7 @@ + #define ssc_is_cp_posixl_init S_ssc_is_cp_posixl_init + #define ssc_or(a,b,c) S_ssc_or(aTHX_ a,b,c) + #define ssc_union(a,b,c) S_ssc_union(aTHX_ a,b,c) +-#define study_chunk(a,b,c,d,e,f,g,h,i,j,k) S_study_chunk(aTHX_ a,b,c,d,e,f,g,h,i,j,k) ++#define study_chunk(a,b,c,d,e,f,g,h,i,j,k,l) S_study_chunk(aTHX_ a,b,c,d,e,f,g,h,i,j,k,l) + # endif + # if defined(PERL_IN_REGCOMP_C) || defined (PERL_IN_DUMP_C) + #define _invlist_dump(a,b,c,d) Perl__invlist_dump(aTHX_ a,b,c,d) +diff --git a/proto.h b/proto.h +index ee74153..9a3ce27 100644 +--- a/proto.h ++++ b/proto.h +@@ -5671,7 +5671,7 @@ PERL_STATIC_INLINE void S_ssc_union(pTHX_ regnode_ssc *ssc, SV* const invlist, c + #define PERL_ARGS_ASSERT_SSC_UNION \ + assert(ssc); assert(invlist) + #endif +-STATIC SSize_t S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, SSize_t *minlenp, SSize_t *deltap, regnode *last, struct scan_data_t *data, I32 stopparen, U32 recursed_depth, regnode_ssc *and_withp, U32 flags, U32 depth); ++STATIC SSize_t S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, SSize_t *minlenp, SSize_t *deltap, regnode *last, struct scan_data_t *data, I32 stopparen, U32 recursed_depth, regnode_ssc *and_withp, U32 flags, U32 depth, bool was_mutate_ok); + #define PERL_ARGS_ASSERT_STUDY_CHUNK \ + assert(pRExC_state); assert(scanp); assert(minlenp); assert(deltap); assert(last) + #endif +diff --git a/regcomp.c b/regcomp.c +index b101752..b9ea2a0 100644 +--- a/regcomp.c ++++ b/regcomp.c +@@ -106,6 +106,7 @@ typedef struct scan_frame { + regnode *next_regnode; /* next node to process when last is reached */ + U32 prev_recursed_depth; + I32 stopparen; /* what stopparen do we use */ ++ bool in_gosub; /* this or an outer frame is for GOSUB */ + + struct scan_frame *this_prev_frame; /* this previous frame */ + struct scan_frame *prev_frame; /* previous frame */ +@@ -4475,7 +4476,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, + I32 stopparen, + U32 recursed_depth, + regnode_ssc *and_withp, +- U32 flags, U32 depth) ++ U32 flags, U32 depth, bool was_mutate_ok) + /* scanp: Start here (read-write). */ + /* deltap: Write maxlen-minlen here. */ + /* last: Stop before this one. */ +@@ -4554,6 +4555,10 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, + node length to get a real minimum (because + the folded version may be shorter) */ + bool unfolded_multi_char = FALSE; ++ /* avoid mutating ops if we are anywhere within the recursed or ++ * enframed handling for a GOSUB: the outermost level will handle it. ++ */ ++ bool mutate_ok = was_mutate_ok && !(frame && frame->in_gosub); + /* Peephole optimizer: */ + DEBUG_STUDYDATA("Peep", data, depth, is_inf); + DEBUG_PEEP("Peep", scan, depth, flags); +@@ -4564,7 +4569,8 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, + * parsing code, as each (?:..) is handled by a different invocation of + * reg() -- Yves + */ +- JOIN_EXACT(scan,&min_subtract, &unfolded_multi_char, 0); ++ if (mutate_ok) ++ JOIN_EXACT(scan,&min_subtract, &unfolded_multi_char, 0); + + /* Follow the next-chain of the current node and optimize + away all the NOTHINGs from it. +@@ -4596,7 +4602,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, + /* DEFINEP study_chunk() recursion */ + (void)study_chunk(pRExC_state, &scan, &minlen, + &deltanext, next, &data_fake, stopparen, +- recursed_depth, NULL, f, depth+1); ++ recursed_depth, NULL, f, depth+1, mutate_ok); + + scan = next; + } else +@@ -4664,7 +4670,8 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, + /* recurse study_chunk() for each BRANCH in an alternation */ + minnext = study_chunk(pRExC_state, &scan, minlenp, + &deltanext, next, &data_fake, stopparen, +- recursed_depth, NULL, f, depth+1); ++ recursed_depth, NULL, f, depth+1, ++ mutate_ok); + + if (min1 > minnext) + min1 = minnext; +@@ -4731,9 +4738,10 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, + } + } + +- if (PERL_ENABLE_TRIE_OPTIMISATION && +- OP( startbranch ) == BRANCH ) +- { ++ if (PERL_ENABLE_TRIE_OPTIMISATION ++ && OP(startbranch) == BRANCH ++ && mutate_ok ++ ) { + /* demq. + + Assuming this was/is a branch we are dealing with: 'scan' +@@ -5188,6 +5196,9 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, + newframe->stopparen = stopparen; + newframe->prev_recursed_depth = recursed_depth; + newframe->this_prev_frame= frame; ++ newframe->in_gosub = ( ++ (frame && frame->in_gosub) || OP(scan) == GOSUB ++ ); + + DEBUG_STUDYDATA("frame-new", data, depth, is_inf); + DEBUG_PEEP("fnew", scan, depth, flags); +@@ -5345,7 +5356,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, + + /* This temporary node can now be turned into EXACTFU, and + * must, as regexec.c doesn't handle it */ +- if (OP(next) == EXACTFU_S_EDGE) { ++ if (OP(next) == EXACTFU_S_EDGE && mutate_ok) { + OP(next) = EXACTFU; + } + +@@ -5353,8 +5364,9 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, + && isALPHA_A(* STRING(next)) + && ( OP(next) == EXACTFAA + || ( OP(next) == EXACTFU +- && ! HAS_NONLATIN1_SIMPLE_FOLD_CLOSURE(* STRING(next))))) +- { ++ && ! HAS_NONLATIN1_SIMPLE_FOLD_CLOSURE(* STRING(next)))) ++ && mutate_ok ++ ) { + /* These differ in just one bit */ + U8 mask = ~ ('A' ^ 'a'); + +@@ -5441,7 +5453,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, + (mincount == 0 + ? (f & ~SCF_DO_SUBSTR) + : f) +- ,depth+1); ++ , depth+1, mutate_ok); + + if (flags & SCF_DO_STCLASS) + data->start_class = oclass; +@@ -5507,7 +5519,9 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, + if ( OP(oscan) == CURLYX && data + && data->flags & SF_IN_PAR + && !(data->flags & SF_HAS_EVAL) +- && !deltanext && minnext == 1 ) { ++ && !deltanext && minnext == 1 ++ && mutate_ok ++ ) { + /* Try to optimize to CURLYN. */ + regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; + regnode * const nxt1 = nxt; +@@ -5557,10 +5571,10 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, + && !(data->flags & SF_HAS_EVAL) + && !deltanext /* atom is fixed width */ + && minnext != 0 /* CURLYM can't handle zero width */ +- + /* Nor characters whose fold at run-time may be + * multi-character */ + && ! (RExC_seen & REG_UNFOLDED_MULTI_SEEN) ++ && mutate_ok + ) { + /* XXXX How to optimize if data == 0? */ + /* Optimize to a simpler form. */ +@@ -5613,7 +5627,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, + /* recurse study_chunk() on optimised CURLYX => CURLYM */ + study_chunk(pRExC_state, &nxt1, minlenp, &deltanext, nxt, + NULL, stopparen, recursed_depth, NULL, 0, +- depth+1); ++ depth+1, mutate_ok); + } + else + oscan->flags = 0; +@@ -6018,7 +6032,8 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", + /* recurse study_chunk() for lookahead body */ + minnext = study_chunk(pRExC_state, &nscan, minlenp, &deltanext, + last, &data_fake, stopparen, +- recursed_depth, NULL, f, depth+1); ++ recursed_depth, NULL, f, depth+1, ++ mutate_ok); + if (scan->flags) { + if ( deltanext < 0 + || deltanext > (I32) U8_MAX +@@ -6123,7 +6138,7 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", + *minnextp = study_chunk(pRExC_state, &nscan, minnextp, + &deltanext, last, &data_fake, + stopparen, recursed_depth, NULL, +- f, depth+1); ++ f, depth+1, mutate_ok); + if (scan->flags) { + assert(0); /* This code has never been tested since this + is normally not compiled */ +@@ -6291,7 +6306,8 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", + /* optimise study_chunk() for TRIE */ + minnext = study_chunk(pRExC_state, &scan, minlenp, + &deltanext, (regnode *)nextbranch, &data_fake, +- stopparen, recursed_depth, NULL, f, depth+1); ++ stopparen, recursed_depth, NULL, f, depth+1, ++ mutate_ok); + } + if (nextbranch && PL_regkind[OP(nextbranch)]==BRANCH) + nextbranch= regnext((regnode*)nextbranch); +@@ -8084,7 +8100,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, + &data, -1, 0, NULL, + SCF_DO_SUBSTR | SCF_WHILEM_VISITED_POS | stclass_flag + | (restudied ? SCF_TRIE_DOING_RESTUDY : 0), +- 0); ++ 0, TRUE); + + + CHECK_RESTUDY_GOTO_butfirst(LEAVE_with_name("study_chunk")); +@@ -8213,7 +8229,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, + SCF_DO_STCLASS_AND|SCF_WHILEM_VISITED_POS|(restudied + ? SCF_TRIE_DOING_RESTUDY + : 0), +- 0); ++ 0, TRUE); + + CHECK_RESTUDY_GOTO_butfirst(NOOP); + +diff --git a/t/re/pat.t b/t/re/pat.t +index 6a868f4..ba89a58 100644 +--- a/t/re/pat.t ++++ b/t/re/pat.t +@@ -25,7 +25,7 @@ BEGIN { + skip_all('no re module') unless defined &DynaLoader::boot_DynaLoader; + skip_all_without_unicode_tables(); + +-plan tests => 864; # Update this when adding/deleting tests. ++plan tests => 868; # Update this when adding/deleting tests. + + run_tests() unless caller; + +@@ -2115,6 +2115,30 @@ x{0c!}\;\;îçÿ /0f/!F/;îçÿù\Qxÿÿÿÿù`x{0c!};ù\Q + like(runperl(prog => "$s", stderr => 1), qr/Unmatched \(/); + } + ++ # gh16947: test regexp corruption (GOSUB) ++ { ++ fresh_perl_is(q{ ++ 'xy' =~ /x(?0)|x(?|y|y)/ && print 'ok' ++ }, 'ok', {}, 'gh16947: test regexp corruption (GOSUB)'); ++ } ++ # gh16947: test fix doesn't break SUSPEND ++ { ++ fresh_perl_is(q{ 'sx' =~ m{ss++}i; print 'ok' }, ++ 'ok', {}, "gh16947: test fix doesn't break SUSPEND"); ++ } ++ ++ # gh17743: more regexp corruption via GOSUB ++ { ++ fresh_perl_is(q{ ++ "0" =~ /((0(?0)|000(?|0000|0000)(?0))|)/; print "ok" ++ }, 'ok', {}, 'gh17743: test regexp corruption (1)'); ++ ++ fresh_perl_is(q{ ++ "000000000000" =~ /(0(())(0((?0)())|000(?|\x{ef}\x{bf}\x{bd}|\x{ef}\x{bf}\x{bd}))|)/; ++ print "ok" ++ }, 'ok', {}, 'gh17743: test regexp corruption (2)'); ++ } ++ + } # End of sub run_tests + + 1; +-- +2.25.4 + diff --git a/perl-5.8.0-libnet.cfg b/perl-5.8.0-libnet.cfg new file mode 100644 index 0000000..85d1393 --- /dev/null +++ b/perl-5.8.0-libnet.cfg @@ -0,0 +1,15 @@ +{ + 'pop3_hosts' => [], + 'ph_hosts' => [], + 'inet_domain' => undef, + 'time_hosts' => [], + 'daytime_hosts' => [], + 'smtp_hosts' => [], + 'test_exist' => 1, + 'test_hosts' => 1, + 'nntp_hosts' => [], + 'ftp_testhost' => undef, + 'snpp_hosts' => [], + 'ftp_int_passive' => 1, + 'ftp_ext_passive' => 1, +} diff --git a/perl.rpmlintrc b/perl.rpmlintrc new file mode 100644 index 0000000..df3bfce --- /dev/null +++ b/perl.rpmlintrc @@ -0,0 +1,5 @@ +from Config import * +addFilter("spelling-error .* (autoloaded|awk|gmtime|groff|libnet|localtime|Memoizing|metapackage|perlbug|perldoc|perlfunc|perlmain|perlpod|perlsub|reachability|rpmbuild|sed|splain|usr|writemain)"); +addFilter("unexpanded-macro %description .* %INC"); +# Applied with "git am" +addFilter("patch-not-applied Patch58: perl-5.30.0-PATCH-perl-134329-Use-after-free-in-regcomp.c.patch"); diff --git a/sources b/sources index d9c37ac..d7a8236 100644 --- a/sources +++ b/sources @@ -1,2 +1 @@ -SHA512 (perl-5.30.1-study_chunk-avoid-mutating-regexp-program-within-GOS.patch) = 40053baf5241860a115d53e6b8af1db3b2a70ddb87605ec38d581960b7dde946440a094d651d01bc4ed6e7e0f03b1264d15ff2c6414a8030d06c208530738ac9 SHA512 (perl-5.30.1.tar.xz) = 8f3339efdcd1bb58fa58a90042181bef86bb09e4598c737e446ed43b56d2ab23d67eced5e36fb08fc61e076acfdb572a12e46a1277f5299a3f412054df0b88bf diff --git a/system-owned-directories b/system-owned-directories new file mode 100644 index 0000000..d9cadb4 --- /dev/null +++ b/system-owned-directories @@ -0,0 +1,7 @@ +%dir /usr +%dir /usr/bin +%dir /usr/lib +%dir /usr/share +%dir /usr/share/man +%dir /usr/share/man/man1 +%dir /usr/share/man/man3