diff --git a/perl-5.27.8-don-t-clobber-file-bytes-in-encoding-layer.patch b/perl-5.27.8-don-t-clobber-file-bytes-in-encoding-layer.patch new file mode 100644 index 0000000..ca9ef63 --- /dev/null +++ b/perl-5.27.8-don-t-clobber-file-bytes-in-encoding-layer.patch @@ -0,0 +1,127 @@ +From fed9fe5b48ccdffef9065a03c12c237cc7418de6 Mon Sep 17 00:00:00 2001 +From: Zefram +Date: Fri, 16 Feb 2018 17:20:34 +0000 +Subject: [PATCH] don't clobber file bytes in :encoding layer +MIME-Version: 1.0 +Content-Type: text/plain; charset=UTF-8 +Content-Transfer-Encoding: 8bit + +The PerlIO::encoding layer, when used on input, was creating an SvLEN==0 +scalar pointing into the byte buffer, to pass to the ->decode method +of the encoding object. Since the method mutates this scalar, for some +encodings this led to mutating the byte buffer, and depending on where +it came from that might be something visible elsewhere that should not +be mutated. Remove the code for the SvLEN==0 scalar, instead always +using the alternate code that would copy the bytes into a separate buffer +owned by the scalar. Fixes [perl #132833]. + +Signed-off-by: Petr Písař +--- + ext/PerlIO-encoding/encoding.pm | 2 +- + ext/PerlIO-encoding/encoding.xs | 43 ++++++++++------------------------------ + ext/PerlIO-encoding/t/encoding.t | 12 ++++++++++- + 3 files changed, 22 insertions(+), 35 deletions(-) + +diff --git a/ext/PerlIO-encoding/encoding.pm b/ext/PerlIO-encoding/encoding.pm +index 08d2df4713..3d740b181a 100644 +--- a/ext/PerlIO-encoding/encoding.pm ++++ b/ext/PerlIO-encoding/encoding.pm +@@ -1,7 +1,7 @@ + package PerlIO::encoding; + + use strict; +-our $VERSION = '0.25'; ++our $VERSION = '0.26'; + our $DEBUG = 0; + $DEBUG and warn __PACKAGE__, " called by ", join(", ", caller), "\n"; + +diff --git a/ext/PerlIO-encoding/encoding.xs b/ext/PerlIO-encoding/encoding.xs +index bb4754f3d9..941d786266 100644 +--- a/ext/PerlIO-encoding/encoding.xs ++++ b/ext/PerlIO-encoding/encoding.xs +@@ -307,42 +307,19 @@ PerlIOEncode_fill(pTHX_ PerlIO * f) + goto end_of_file; + } + } +- if (SvCUR(e->dataSV)) { +- /* something left over from last time - create a normal +- SV with new data appended +- */ +- if (use + SvCUR(e->dataSV) > e->base.bufsiz) { +- if (e->flags & NEEDS_LINES) { +- /* Have to grow buffer */ +- e->base.bufsiz = use + SvCUR(e->dataSV); +- PerlIOEncode_get_base(aTHX_ f); +- } +- else { +- use = e->base.bufsiz - SvCUR(e->dataSV); +- } +- } +- sv_catpvn(e->dataSV,(char*)ptr,use); +- } +- else { +- /* Create a "dummy" SV to represent the available data from layer below */ +- if (SvLEN(e->dataSV) && SvPVX_const(e->dataSV)) { +- Safefree(SvPVX_mutable(e->dataSV)); +- } +- if (use > (SSize_t)e->base.bufsiz) { +- if (e->flags & NEEDS_LINES) { +- /* Have to grow buffer */ +- e->base.bufsiz = use; +- PerlIOEncode_get_base(aTHX_ f); +- } +- else { +- use = e->base.bufsiz; ++ if (!SvCUR(e->dataSV)) ++ SvPVCLEAR(e->dataSV); ++ if (use + SvCUR(e->dataSV) > e->base.bufsiz) { ++ if (e->flags & NEEDS_LINES) { ++ /* Have to grow buffer */ ++ e->base.bufsiz = use + SvCUR(e->dataSV); ++ PerlIOEncode_get_base(aTHX_ f); + } ++ else { ++ use = e->base.bufsiz - SvCUR(e->dataSV); + } +- SvPV_set(e->dataSV, (char *) ptr); +- SvLEN_set(e->dataSV, 0); /* Hands off sv.c - it isn't yours */ +- SvCUR_set(e->dataSV,use); +- SvPOK_only(e->dataSV); + } ++ sv_catpvn(e->dataSV,(char*)ptr,use); + SvUTF8_off(e->dataSV); + PUSHMARK(sp); + XPUSHs(e->enc); +diff --git a/ext/PerlIO-encoding/t/encoding.t b/ext/PerlIO-encoding/t/encoding.t +index 088f89ee20..41cefcb137 100644 +--- a/ext/PerlIO-encoding/t/encoding.t ++++ b/ext/PerlIO-encoding/t/encoding.t +@@ -16,7 +16,7 @@ BEGIN { + require "../../t/charset_tools.pl"; + } + +-use Test::More tests => 24; ++use Test::More tests => 27; + + my $grk = "grk$$"; + my $utf = "utf$$"; +@@ -231,6 +231,16 @@ is $x, "To hymn him who heard her herd herd\n", + + } # SKIP + ++# decoding shouldn't mutate the original bytes [perl #132833] ++{ ++ my $b = "a\0b\0\n\0"; ++ open my $fh, "<:encoding(UTF16-LE)", \$b or die; ++ is scalar(<$fh>), "ab\n"; ++ is $b, "a\0b\0\n\0"; ++ close $fh or die; ++ is $b, "a\0b\0\n\0"; ++} ++ + END { + 1 while unlink($grk, $utf, $fail1, $fail2, $russki, $threebyte); + } +-- +2.14.3 + diff --git a/perl.spec b/perl.spec index 1076ef6..95e810b 100644 --- a/perl.spec +++ b/perl.spec @@ -256,6 +256,10 @@ Patch79: perl-5.27.8-hints-linux-Add-lphtread-to-lddlflags.patch # in upstream after 5.27.7 Patch80: perl-5.26.1-fix-parsing-of-braced-subscript-after-parens.patch +# Do not clobber file bytes in :encoding layer, RT#132833, +# in upstream after 5.27.8 +Patch81: perl-5.27.8-don-t-clobber-file-bytes-in-encoding-layer.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 @@ -2857,6 +2861,7 @@ Perl extension for Version Objects %patch78 -p1 %patch79 -p1 %patch80 -p1 +%patch81 -p1 %patch200 -p1 %patch201 -p1 @@ -2905,6 +2910,7 @@ perl -x patchlevel.h \ 'Fedora Patch78: Fix compatibility with libxcrypt (bug #1536752)' \ 'Fedora Patch79: Link XS modules to pthread library to fix linking with -z defs' \ 'Fedora Patch80: Fix parsing braced subscript after parentheses (RT#8045)' \ + 'Fedora Patch81: Do not clobber file bytes in :encoding layer (RT#132833)' \ '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} @@ -5195,6 +5201,7 @@ popd * Thu Apr 19 2018 Petr Pisar - 4:5.26.2-412 - perl-devel requires redhat-rpm-config because of hardened compiler profiles (bug #1557667) +- Do not clobber file bytes in :encoding layer (RT#132833) * Mon Apr 16 2018 Petr Pisar - 4:5.26.2-411 - 5.26.2 bump