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

Fix string overrun in Perl_gv_fetchmethod_pvn_flags

Browse Source
This commit is contained in:
Petr Písař 2016-11-03 10:33:05 +01:00
parent e947d78f10
commit 50a3de5ad0
6 changed files with 362 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

94
perl-5.24.0-clean-up-gv_fetchmethod_pvn_flags-introduce-name_end.patch Normal file
View File

@ -0,0 +1,94 @@
From af04cb4d2503c5c75d2229e232b8a0bd5c210084 Mon Sep 17 00:00:00 2001
From: Yves Orton <demerphq@gmail.com>
Date: Tue, 13 Sep 2016 23:06:07 +0200
Subject: [PATCH] clean up gv_fetchmethod_pvn_flags: introduce name_end
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Ported to 5.24.0:
commit 65308f87d02a1900e59f0002fa94c855d4d4c5df
Author: Yves Orton <demerphq@gmail.com>
Date: Tue Sep 13 23:06:07 2016 +0200
clean up gv_fetchmethod_pvn_flags: introduce name_end
nend is used for too many things, this replaces various
uses of nend with name_end, which is constant.
this is a first step to fixing [perl #129267], which shouldnt
change any behavior
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
gv.c | 14 ++++++++------
1 file changed, 8 insertions(+), 6 deletions(-)
diff --git a/gv.c b/gv.c
index 28396de..d738bf0 100644
--- a/gv.c
+++ b/gv.c
@@ -1014,6 +1014,8 @@ Perl_gv_fetchmethod_pv_flags(pTHX_ HV *stash, const char *name, U32 flags)
GV *
Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN len, U32 flags)
{
+ const char * const origname = name;
+ const char * const name_end = name + len;
const char *nend;
const char *nsplit = NULL;
GV* gv;
@@ -1034,7 +1036,7 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
the error reporting code. */
}
- for (nend = name; *nend || nend != (origname + len); nend++) {
+ for (nend = name; *nend || nend != name_end; nend++) {
if (*nend == '\'') {
nsplit = nend;
name = nend + 1;
@@ -1065,13 +1067,13 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
ostash = stash;
}
- gv = gv_fetchmeth_pvn(stash, name, nend - name, 0, flags);
+ gv = gv_fetchmeth_pvn(stash, name, name_end - name, 0, flags);
if (!gv) {
if (strEQ(name,"import") || strEQ(name,"unimport"))
gv = MUTABLE_GV(&PL_sv_yes);
else if (autoload)
gv = gv_autoload_pvn(
- ostash, name, nend - name, GV_AUTOLOAD_ISMETHOD|flags
+ ostash, name, name_end - name, GV_AUTOLOAD_ISMETHOD|flags
);
if (!gv && do_croak) {
/* Right now this is exclusively for the benefit of S_method_common
@@ -1087,14 +1089,14 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
HV_FETCH_ISEXISTS, NULL, 0)
) {
require_pv("IO/File.pm");
- gv = gv_fetchmeth_pvn(stash, name, nend - name, 0, flags);
+ gv = gv_fetchmeth_pvn(stash, name, name_end - name, 0, flags);
if (gv)
return gv;
}
Perl_croak(aTHX_
"Can't locate object method \"%"UTF8f
"\" via package \"%"HEKf"\"",
- UTF8fARG(is_utf8, nend - name, name),
+ UTF8fARG(is_utf8, name_end - name, name),
HEKfARG(HvNAME_HEK(stash)));
}
else {
@@ -1111,7 +1113,7 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
"Can't locate object method \"%"UTF8f
"\" via package \"%"SVf"\""
" (perhaps you forgot to load \"%"SVf"\"?)",
- UTF8fARG(is_utf8, nend - name, name),
+ UTF8fARG(is_utf8, name_end - name, name),
SVfARG(packnamesv), SVfARG(packnamesv));
}
}
--
2.7.4

32
perl-5.25.4-clean-up-gv_fetchmethod_pvn_flags-move-origname-init.patch Normal file
View File

@ -0,0 +1,32 @@
From d5ea0ef8623c7d7ba5f42d239787aa71393e2054 Mon Sep 17 00:00:00 2001
From: Yves Orton <demerphq@gmail.com>
Date: Tue, 13 Sep 2016 23:06:58 +0200
Subject: [PATCH 2/5] clean up gv_fetchmethod_pvn_flags: move origname init to
function start
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
so it is more obvious that it is a constant copy of the
original name.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
gv.c | 1 -
1 file changed, 1 deletion(-)
diff --git a/gv.c b/gv.c
index b0221e0..fe38d44 100644
--- a/gv.c
+++ b/gv.c
@@ -1014,7 +1014,6 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
const char *nsplit = NULL;
GV* gv;
HV* ostash = stash;
- const char * const origname = name;
SV *const error_report = MUTABLE_SV(stash);
const U32 autoload = flags & GV_AUTOLOAD;
const U32 do_croak = flags & GV_CROAK;
--
2.7.4

92
perl-5.25.4-clean-up-gv_fetchmethod_pvn_flags-rename-nsplit-to-l.patch Normal file
View File

@ -0,0 +1,92 @@
From e2cace1e9e89525afbca257742ddb36630b7fbc3 Mon Sep 17 00:00:00 2001
From: Yves Orton <demerphq@gmail.com>
Date: Tue, 13 Sep 2016 23:10:48 +0200
Subject: [PATCH 3/5] clean up gv_fetchmethod_pvn_flags: rename nsplit to
last_separator
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
nsplit if set points at the first char of the last separator
in name, so rename it so it is more comprehensible what it means.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
gv.c | 24 ++++++++++++------------
1 file changed, 12 insertions(+), 12 deletions(-)
diff --git a/gv.c b/gv.c
index fe38d44..07709a0 100644
--- a/gv.c
+++ b/gv.c
@@ -1011,7 +1011,7 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
const char * const origname = name;
const char * const name_end = name + len;
const char *nend;
- const char *nsplit = NULL;
+ const char *last_separator = NULL;
GV* gv;
HV* ostash = stash;
SV *const error_report = MUTABLE_SV(stash);
@@ -1024,38 +1024,38 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
if (SvTYPE(stash) < SVt_PVHV)
stash = NULL;
else {
- /* The only way stash can become NULL later on is if nsplit is set,
+ /* The only way stash can become NULL later on is if last_separator is set,
which in turn means that there is no need for a SVt_PVHV case
the error reporting code. */
}
for (nend = name; *nend || nend != name_end; nend++) {
if (*nend == '\'') {
- nsplit = nend;
+ last_separator = nend;
name = nend + 1;
}
else if (*nend == ':' && *(nend + 1) == ':') {
- nsplit = nend++;
+ last_separator = nend++;
name = nend + 1;
}
}
- if (nsplit) {
- if ((nsplit - origname) == 5 && memEQ(origname, "SUPER", 5)) {
+ if (last_separator) {
+ if ((last_separator - origname) == 5 && memEQ(origname, "SUPER", 5)) {
/* ->SUPER::method should really be looked up in original stash */
stash = CopSTASH(PL_curcop);
flags |= GV_SUPER;
DEBUG_o( Perl_deb(aTHX_ "Treating %s as %s::%s\n",
origname, HvENAME_get(stash), name) );
}
- else if ((nsplit - origname) >= 7 &&
- strnEQ(nsplit - 7, "::SUPER", 7)) {
+ else if ((last_separator - origname) >= 7 &&
+ strnEQ(last_separator - 7, "::SUPER", 7)) {
/* don't autovifify if ->NoSuchStash::SUPER::method */
- stash = gv_stashpvn(origname, nsplit - origname - 7, is_utf8);
+ stash = gv_stashpvn(origname, last_separator - origname - 7, is_utf8);
if (stash) flags |= GV_SUPER;
}
else {
/* don't autovifify if ->NoSuchStash::method */
- stash = gv_stashpvn(origname, nsplit - origname, is_utf8);
+ stash = gv_stashpvn(origname, last_separator - origname, is_utf8);
}
ostash = stash;
}
@@ -1098,8 +1098,8 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
else {
SV* packnamesv;
- if (nsplit) {
- packnamesv = newSVpvn_flags(origname, nsplit - origname,
+ if (last_separator) {
+ packnamesv = newSVpvn_flags(origname, last_separator - origname,
SVs_TEMP | is_utf8);
} else {
packnamesv = error_report;
--
2.7.4

81
perl-5.25.4-fix-129267-rework-gv_fetchmethod_pvn_flags-separator.patch Normal file
View File

@ -0,0 +1,81 @@
From cfb736762c1becf344ce6beaa701ff2e1abd5f9c Mon Sep 17 00:00:00 2001
From: Yves Orton <demerphq@gmail.com>
Date: Tue, 13 Sep 2016 23:14:49 +0200
Subject: [PATCH 4/5] fix #129267: rework gv_fetchmethod_pvn_flags separator
parsing
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
With previous code we could overrun the end of the name when
the last char in the string was a colon. This reworks the code
so it is more clear what is going on, and so it more similar
to other code that also parses out package separaters in gv.c.
This is a rework of the reverted patches:
243ca72 rename "nend" name_cursor in Perl_gv_fetchmethod_pvn_flags
b053c93 fix: [perl #129267] Possible string overrun with invalid len in gv.c
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
gv.c | 36 ++++++++++++++++++++++++++----------
1 file changed, 26 insertions(+), 10 deletions(-)
diff --git a/gv.c b/gv.c
index 07709a0..3237c53 100644
--- a/gv.c
+++ b/gv.c
@@ -1010,7 +1010,6 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
{
const char * const origname = name;
const char * const name_end = name + len;
- const char *nend;
const char *last_separator = NULL;
GV* gv;
HV* ostash = stash;
@@ -1029,16 +1028,33 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
the error reporting code. */
}
- for (nend = name; *nend || nend != name_end; nend++) {
- if (*nend == '\'') {
- last_separator = nend;
- name = nend + 1;
- }
- else if (*nend == ':' && *(nend + 1) == ':') {
- last_separator = nend++;
- name = nend + 1;
- }
+ {
+ /* check if the method name is fully qualified or
+ * not, and separate the package name from the actual
+ * method name.
+ *
+ * leaves last_separator pointing to the beginning of the
+ * last package separator (either ' or ::) or 0
+ * if none was found.
+ *
+ * leaves name pointing at the beginning of the
+ * method name.
+ */
+ const char *name_cursor = name;
+ const char * const name_em1 = name_end - 1; /* name_end minus 1 */
+ for (name_cursor = name; name_cursor < name_end ; name_cursor++) {
+ if (*name_cursor == '\'') {
+ last_separator = name_cursor;
+ name = name_cursor + 1;
+ }
+ else if (name_cursor < name_em1 && *name_cursor == ':' && name_cursor[1] == ':') {
+ last_separator = name_cursor++;
+ name = name_cursor + 1;
+ }
+ }
}
+
+ /* did we find a separator? */
if (last_separator) {
if ((last_separator - origname) == 5 && memEQ(origname, "SUPER", 5)) {
/* ->SUPER::method should really be looked up in original stash */
--
2.7.4

44
perl-5.25.4-perl-129267-Test-for-gv_fetchmethod-buffer-overrun.patch Normal file
View File

@ -0,0 +1,44 @@
From 1665b718d8fbd58705dbe6376fa51f8c1a02d887 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Tue, 13 Sep 2016 22:38:59 -0700
Subject: [PATCH 5/5] [perl #129267] Test for gv_fetchmethod buffer overrun
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
ext/XS-APItest/APItest.xs | 3 +++
ext/XS-APItest/t/gv_fetchmethod_flags.t | 5 +++++
2 files changed, 8 insertions(+)
diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index 992b6a5..4602cee 100644
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -2571,6 +2571,9 @@ gv_fetchmethod_flags_type(stash, methname, type, flags)
gv = gv_fetchmethod_pvn_flags(stash, name, len, flags | SvUTF8(methname));
break;
}
+ case 4:
+ gv = gv_fetchmethod_pvn_flags(stash, SvPV_nolen(methname),
+ flags, SvUTF8(methname));
}
XPUSHs( gv ? (SV*)gv : &PL_sv_undef);
diff --git a/ext/XS-APItest/t/gv_fetchmethod_flags.t b/ext/XS-APItest/t/gv_fetchmethod_flags.t
index 15d1c41..2da3b70 100644
--- a/ext/XS-APItest/t/gv_fetchmethod_flags.t
+++ b/ext/XS-APItest/t/gv_fetchmethod_flags.t
@@ -49,3 +49,8 @@ is XS::APItest::gv_fetchmethod_flags_type(\%::, "method\0not quite!", 2, 0), "*m
}
}
}
+
+# [perl #129267] Buffer overrun when argument name ends with colon and
+# there is a colon past the end. This used to segv.
+XS::APItest::gv_fetchmethod_flags_type(\%::, "method:::::", 4, 7);
+ # With type 4, 7 is the length
--
2.7.4

19
perl.spec
View File

@ -191,6 +191,14 @@ Patch47: perl-5.25.4-toke.c-fix-mswin32-builds.patch
# Fix crash in splice, RT#129164, RT#129166, RT#129167, in upstream after 5.25.4
Patch48: perl-5.24.0-perl-129164-Crash-with-splice.patch
# Fix string overrun in Perl_gv_fetchmethod_pvn_flags, RT#129267,
# in upstream after 5.25.4
Patch49: perl-5.24.0-clean-up-gv_fetchmethod_pvn_flags-introduce-name_end.patch
Patch50: perl-5.25.4-clean-up-gv_fetchmethod_pvn_flags-move-origname-init.patch
Patch51: perl-5.25.4-clean-up-gv_fetchmethod_pvn_flags-rename-nsplit-to-l.patch
Patch52: perl-5.25.4-fix-129267-rework-gv_fetchmethod_pvn_flags-separator.patch
Patch53: perl-5.25.4-perl-129267-Test-for-gv_fetchmethod-buffer-overrun.patch
# Link XS modules to libperl.so with EU::CBuilder on Linux, bug #960048
Patch200: perl-5.16.3-Link-XS-modules-to-libperl.so-with-EU-CBuilder-on-Li.patch
@ -2862,6 +2870,11 @@ Perl extension for Version Objects
%patch46 -p1
%patch47 -p1
%patch48 -p1
%patch49 -p1
%patch50 -p1
%patch51 -p1
%patch52 -p1
%patch53 -p1
%patch200 -p1
%patch201 -p1
@ -2901,6 +2914,11 @@ perl -x patchlevel.h \
'Fedora Patch46: Fix crash in "evalbytes S" (RT#129196)' \
'Fedora Patch47: Fix crash in "evalbytes S" (RT#129196)' \
'Fedora Petch48: Fix crash in splice (RT#129164, RT#129166, RT#129167)' \
'Fedora Patch49: Fix string overrun in Perl_gv_fetchmethod_pvn_flags (RT#129267)' \
'Fedora Patch50: Fix string overrun in Perl_gv_fetchmethod_pvn_flags (RT#129267)' \
'Fedora Patch51: Fix string overrun in Perl_gv_fetchmethod_pvn_flags (RT#129267)' \
'Fedora Patch52: Fix string overrun in Perl_gv_fetchmethod_pvn_flags (RT#129267)' \
'Fedora Patch53: Fix string overrun in Perl_gv_fetchmethod_pvn_flags (RT#129267)' \
'Fedora Patch200: Link XS modules to libperl.so with EU::CBuilder on Linux' \
'Fedora Patch201: Link XS modules to libperl.so with EU::MM on Linux' \
%{nil}
@ -5182,6 +5200,7 @@ popd
* Thu Nov 03 2016 Petr Pisar <ppisar@redhat.com> - 4:5.24.0-379
- Fix crash in "evalbytes S" (RT#129196)
- Fix crash in splice (RT#129164, RT#129166, RT#129167)
- Fix string overrun in Perl_gv_fetchmethod_pvn_flags (RT#129267)
* Fri Sep 02 2016 Petr Pisar <ppisar@redhat.com> - 4:5.24.0-378
- perl-core depends on Parse::CPAN::Meta module instead of package name to allow