rpms/perl
5
0
Fork 0
Code Issues Pull Requests Releases Activity

re-import sources as agreed with the maintainer

Browse Source
This commit is contained in:
Adam Samalik 2023-06-30 07:38:02 +02:00
parent 00a8196cff
commit 2569a4617b
12 changed files with 734 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
.gitignore vendored
View File

@ -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

29
STAGE2-perl Normal file
View File

@ -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

11
checkemptydirs Normal file
View File

@ -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

93
checkpackageversion Normal file
View File

@ -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ř <ppisar@redhat.com>
=head1 COPYING
Copyright (C) 2011 Petr Písař <ppisar@redhat.com>
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 <http://www.gnu.org/licenses/>.
=cut

39
clean-manifest.pl Normal file
View File

@ -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 = <PATTERN>;
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(<IN>) {
chomp;
print OUT "$_\n"
unless exists $exclude{$_}
}
close IN;
close OUT;

33
diffrpms Normal file
View File

@ -0,0 +1,33 @@
#!/bin/bash
if [ "$#" != 2 ]; then
cat<<EOM
Usage: $(basename $0) OLD_RELEASE NEW_RELEASE
Compares corresponding RPM packages produced in OLD_RELASE and NEW_RELEASE.
The same version strings are assumed.
EOM
exit 1;
fi
OLD_RELEASE="$1"
NEW_RELEASE="$2"
function process_dir() {
for F in $(ls $1/* | sed -r 's/-[0-9].*//' | sort | uniq ); do
OLD_RPM=$(echo ${F}-[0-9]*-${OLD_RELEASE}.*)
NEW_RPM=$(echo ${F}-[0-9]*-${NEW_RELEASE}.*)
test \( ! -e "$OLD_RPM" \) -a \( ! -e "$NEW_RPM" \) && continue
if [ ! -e "$OLD_RPM" ]; then echo "+ Package ${F}"; continue; fi
if [ ! -e "$NEW_RPM" ]; then echo "- Package ${F}"; continue; fi
DIFF=$(rpmdiff -i S -i 5 -i T "$OLD_RPM" "$NEW_RPM" | \
grep -vE 'REQUIRES perl = | REQUIRES rpmlib\(' )
test -n "$DIFF" && printf '* %s:\n%s\n' "$F" "$DIFF"
done
}
process_dir 'x86_64'
process_dir 'noarch'

163
generatedependencies Normal file
View File

@ -0,0 +1,163 @@
#!/usr/bin/perl
use strict;
use warnings;
# Split "A B >= 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<generatedependencies> I<BUILD_LOG>
=head1 DESCRIPTION
It opens specified RPM build log I<BUILD_LOG>. It locates a protocol about
autogenerated dependencies. It stores the reported dependencies into F<./gendep.macros> file.
The output file will define macros C<gendep_I<BINARY_PACKAGE_NAME>>. 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<perl(*)>) 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ř <ppisar@redhat.com>
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 <http://www.gnu.org/licenses/>.
=cut

306
perl-5.30.1-study_chunk-avoid-mutating-regexp-program-within-GOS.patch Normal file
View File

@ -0,0 +1,306 @@
From 783ddef8fc74b00cde72898c2c3228853dc82d91 Mon Sep 17 00:00:00 2001
From: Hugo van der Sanden <hv@crypt.org>
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ř <ppisar@redhat.com>
---
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

15
perl-5.8.0-libnet.cfg Normal file
View File

@ -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,
}

5
perl.rpmlintrc Normal file
View File

@ -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");

1
sources
View File

@ -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

7
system-owned-directories Normal file
View File

@ -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