From 30fdce8a32696baa5a04b0af57a7f1599d0df2f5 Mon Sep 17 00:00:00 2001
From: Petr Písař <ppi...@redhat.com>
Date: Aug 09 2017 11:44:53 +0000
Subject: Fix select called with a repeated magical variable
---
diff --git a/perl-5.27.1-perl-131645-Fix-assert-fail-in-pp_sselect.patch
b/perl-5.27.1-perl-131645-Fix-assert-fail-in-pp_sselect.patch
new file mode 100644
index 0000000..3b10683
--- /dev/null
+++ b/perl-5.27.1-perl-131645-Fix-assert-fail-in-pp_sselect.patch
@@ -0,0 +1,126 @@
+From e26c6904d9f9f5ea818e590331b14038279332d1 Mon Sep 17 00:00:00 2001
+From: Father Chrysostomos <spr...@cpan.org>
+Date: Sun, 25 Jun 2017 06:37:19 -0700
+Subject: [PATCH] [perl #131645] Fix assert fail in pp_sselect
+MIME-Version: 1.0
+Content-Type: text/plain; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+
+pp_sselect (4-arg select) process its first three bitfield arguments
+first, making sure each one has a valid PV, and then it moves on to
+the final, timeout argument.
+
+SvGETMAGIC() on the timeout argument will wipe out any values the SV
+holds, so if the same scalar is used as a bitfield argument *and* as
+the timeout, it will no longer hold a valid PV.
+
+Assertions later in pp_sselect make sure there is a valid PV.
+
+This commit solves the assertion failure by making a temporary copy of
+any gmagical or overloaded argument. When the temporary copy is made,
+the values written to the temporary copies of the bitfield arguments
+are then copied back to the original magical arguments.
+
+Signed-off-by: Petr Písař <ppi...@redhat.com>
+---
+ pp_sys.c | 21 +++++++++++++++------
+ t/op/sselect.t | 11 ++++++++++-
+ 2 files changed, 25 insertions(+), 7 deletions(-)
+
+diff --git a/pp_sys.c b/pp_sys.c
+index 65900fa..100762c 100644
+--- a/pp_sys.c
++++ b/pp_sys.c
+@@ -1149,6 +1149,7 @@ PP(pp_sselect)
+ struct timeval *tbuf = &timebuf;
+ I32 growsize;
+ char *fd_sets[4];
++ SV *svs[4];
+ #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
+ I32 masksize;
+ I32 offset;
+@@ -1164,7 +1165,7 @@ PP(pp_sselect)
+
+ SP -= 4;
+ for (i = 1; i <= 3; i++) {
+- SV * const sv = SP[i];
++ SV * const sv = svs[i] = SP[i];
+ SvGETMAGIC(sv);
+ if (!SvOK(sv))
+ continue;
+@@ -1177,9 +1178,14 @@ PP(pp_sselect)
+ if (!SvPOKp(sv))
+ Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
+ "Non-string passed as bitmask");
+- SvPV_force_nomg_nolen(sv); /* force string conversion */
++ if (SvGAMAGIC(sv)) {
++ svs[i] = sv_newmortal();
++ sv_copypv_nomg(svs[i], sv);
++ }
++ else
++ SvPV_force_nomg_nolen(sv); /* force string conversion */
+ }
+- j = SvCUR(sv);
++ j = SvCUR(svs[i]);
+ if (maxlen < j)
+ maxlen = j;
+ }
+@@ -1228,7 +1234,7 @@ PP(pp_sselect)
+ tbuf = NULL;
+
+ for (i = 1; i <= 3; i++) {
+- sv = SP[i];
++ sv = svs[i];
+ if (!SvOK(sv) || SvCUR(sv) == 0) {
+ fd_sets[i] = 0;
+ continue;
+@@ -1275,7 +1281,7 @@ PP(pp_sselect)
+ #endif
+ for (i = 1; i <= 3; i++) {
+ if (fd_sets[i]) {
+- sv = SP[i];
++ sv = svs[i];
+ #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
+ s = SvPVX(sv);
+ for (offset = 0; offset < growsize; offset += masksize) {
+@@ -1284,7 +1290,10 @@ PP(pp_sselect)
+ }
+ Safefree(fd_sets[i]);
+ #endif
+- SvSETMAGIC(sv);
++ if (sv != SP[i])
++ SvSetMagicSV(SP[i], sv);
++ else
++ SvSETMAGIC(sv);
+ }
+ }
+
+diff --git a/t/op/sselect.t b/t/op/sselect.t
+index fedbfc7..9ec1c63 100644
+--- a/t/op/sselect.t
++++ b/t/op/sselect.t
+@@ -13,7 +13,7 @@ BEGIN {
+ skip_all("Win32 miniperl has no socket select")
+ if $^O eq "MSWin32" && is_miniperl();
+
+-plan (15);
++plan (16);
+
+ my $blank = "";
+ eval {select undef, $blank, $blank, 0};
+@@ -95,3 +95,12 @@ note("diff=$diff under=$under");
+ select (undef, undef, undef, $sleep);
+ ::is($count, 1, 'RT120102');
+ }
++
++package _131645{
++ sub TIESCALAR { bless [] }
++ sub FETCH { 0 }
++ sub STORE { }
++}
++tie $tie, _131645::;
++select ($tie, undef, undef, $tie);
++ok("no crash from select $numeric_tie, undef, undef, $numeric_tie")
+--
+2.9.4
+
diff --git a/perl.spec b/perl.spec
index 7630146..ab647d6 100644
--- a/perl.spec
+++ b/perl.spec
@@ -197,6 +197,10 @@ Patch48:
perl-5.27.1-add-an-additional-test-for-whitespace-tolerance-in-c
# in upstream after 5.27.1
Patch49:
perl-5.27.1-utf8n_to_uvchr-Don-t-display-too-many-bytes-in-msg.patch
+# Fix select called with a repeated magical variable, RT#131645,
+# in upstream after 5.27.1
+Patch50: perl-5.27.1-perl-131645-Fix-assert-fail-in-pp_sselect.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
@@ -2774,6 +2778,7 @@ Perl extension for Version Objects
%patch47 -p1
%patch48 -p1
%patch49 -p1
+%patch50 -p1
%patch200 -p1
%patch201 -p1
@@ -2808,6 +2813,7 @@ perl -x patchlevel.h \
'Fedora Patch46: Fix t/op/hash.t test random failures' \
'Fedora Patch47: Parse caret variables with subscripts as normal variables
inside ${...} escaping (RT#131664)' \
'Fedora Patch49: Do not display too many bytes when reporting malformed
UTF-8 character' \
+ 'Fedora Patch50: Fix select called with a repeated magical variable
(RT#131645)' \
'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}
@@ -5098,6 +5104,7 @@ popd
- Parse caret variables with subscripts as normal variables inside ${...}
escaping (RT#131664)
- Do not display too many bytes when reporting malformed UTF-8 character
+- Fix select called with a repeated magical variable (RT#131645)
* Sat Jul 29 2017 Igor Gnatenko <ignatenkobr...@fedoraproject.org> -
4:5.26.0-397
- Enable separate debuginfo back
https://src.fedoraproject.org/rpms/perl/c/30fdce8a32696baa5a04b0af57a7f1599d0df2f5?branch=master
_______________________________________________
perl-devel mailing list -- perl-devel@lists.fedoraproject.org
To unsubscribe send an email to perl-devel-le...@lists.fedoraproject.org
