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 +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ř +--- + 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 - 4:5.26.0-397 - Enable separate debuginfo back