From 0b127f245a7d80625437277b70101380e19e00a8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= Date: Mon, 19 Dec 2016 12:52:35 +0100 Subject: [PATCH] Fix a memory leak in IO::Poll --- ...-perl-129788-IO-Poll-fix-memory-leak.patch | 134 ++++++++++++++++++ perl.spec | 6 + 2 files changed, 140 insertions(+) create mode 100644 perl-5.24.0-perl-129788-IO-Poll-fix-memory-leak.patch diff --git a/perl-5.24.0-perl-129788-IO-Poll-fix-memory-leak.patch b/perl-5.24.0-perl-129788-IO-Poll-fix-memory-leak.patch new file mode 100644 index 0000000..aa6f20f --- /dev/null +++ b/perl-5.24.0-perl-129788-IO-Poll-fix-memory-leak.patch @@ -0,0 +1,134 @@ +From 478d23ef9e7700e20a75907648dd4c53b1b4f544 Mon Sep 17 00:00:00 2001 +From: Tony Cook +Date: Tue, 25 Oct 2016 16:17:18 +1100 +Subject: [PATCH] (perl #129788) IO::Poll: fix memory leak +MIME-Version: 1.0 +Content-Type: text/plain; charset=UTF-8 +Content-Transfer-Encoding: 8bit + +Petr Pisar: Ported to 5.24.0: + +commit 6de2dd46140d0d3ab6813e26940d7b74418b0260 +Author: Tony Cook +Date: Tue Oct 25 16:17:18 2016 +1100 + + (perl #129788) IO::Poll: fix memory leak + + Whenever a magical/tied scalar which dies upon read was passed to _poll() + temporary buffer for events was not freed. + + Adapted from a patch by Sergey Aleynikov + +Signed-off-by: Petr Písař +--- + MANIFEST | 1 + + META.json | 1 + + META.yml | 1 + + dist/IO/IO.xs | 3 +-- + dist/IO/t/io_leak.t | 37 +++++++++++++++++++++++++++++++++++++ + 5 files changed, 41 insertions(+), 2 deletions(-) + create mode 100644 dist/IO/t/io_leak.t + +diff --git a/MANIFEST b/MANIFEST +index 2cdf616..3b5f8fb 100644 +--- a/MANIFEST ++++ b/MANIFEST +@@ -3228,6 +3228,7 @@ dist/IO/t/io_dir.t See if directory-related methods from IO work + dist/IO/t/io_dup.t See if dup()-related methods from IO work + dist/IO/t/io_file_export.t Test IO::File exports + dist/IO/t/io_file.t See if binmode()-related methods on IO::File work ++dist/IO/t/io_leak.t See if IO leaks SVs (only run in core) + dist/IO/t/io_linenum.t See if I/O line numbers are tracked correctly + dist/IO/t/io_multihomed.t See if INET sockets work with multi-homed hosts + dist/IO/t/io_pipe.t See if pipe()-related methods from IO work +diff --git a/META.json b/META.json +index 4cb21a9..2809b58 100644 +--- a/META.json ++++ b/META.json +@@ -84,6 +84,7 @@ + "dist/IO/t/io_dup.t", + "dist/IO/t/io_file.t", + "dist/IO/t/io_file_export.t", ++ "dist/IO/t/io_leak.t", + "dist/IO/t/io_linenum.t", + "dist/IO/t/io_multihomed.t", + "dist/IO/t/io_pipe.t", +diff --git a/META.yml b/META.yml +index 13a2bb3..7494d2a 100644 +--- a/META.yml ++++ b/META.yml +@@ -81,6 +81,7 @@ no_index: + - dist/IO/t/io_dup.t + - dist/IO/t/io_file.t + - dist/IO/t/io_file_export.t ++ - dist/IO/t/io_leak.t + - dist/IO/t/io_linenum.t + - dist/IO/t/io_multihomed.t + - dist/IO/t/io_pipe.t +diff --git a/dist/IO/IO.xs b/dist/IO/IO.xs +index fe749a6..15ef9b2 100644 +--- a/dist/IO/IO.xs ++++ b/dist/IO/IO.xs +@@ -318,7 +318,7 @@ PPCODE: + { + #ifdef HAS_POLL + const int nfd = (items - 1) / 2; +- SV *tmpsv = NEWSV(999,nfd * sizeof(struct pollfd)); ++ SV *tmpsv = sv_2mortal(NEWSV(999,nfd * sizeof(struct pollfd))); + /* We should pass _some_ valid pointer even if nfd is zero, but it + * doesn't matter what it is, since we're telling it to not check any fds. + */ +@@ -337,7 +337,6 @@ PPCODE: + sv_setiv(ST(i), fds[j].revents); i++; + } + } +- SvREFCNT_dec(tmpsv); + XSRETURN_IV(ret); + #else + not_here("IO::Poll::poll"); +diff --git a/dist/IO/t/io_leak.t b/dist/IO/t/io_leak.t +new file mode 100644 +index 0000000..08cbe2b +--- /dev/null ++++ b/dist/IO/t/io_leak.t +@@ -0,0 +1,37 @@ ++#!/usr/bin/perl ++ ++use warnings; ++use strict; ++ ++use Test::More; ++ ++eval { require XS::APItest; XS::APItest->import('sv_count'); 1 } ++ or plan skip_all => "No XS::APItest::sv_count() available"; ++ ++plan tests => 1; ++ ++sub leak { ++ my ($n, $delta, $code, $name) = @_; ++ my $sv0 = 0; ++ my $sv1 = 0; ++ for my $i (1..$n) { ++ &$code(); ++ $sv1 = sv_count(); ++ $sv0 = $sv1 if $i == 1; ++ } ++ cmp_ok($sv1-$sv0, '<=', ($n-1)*$delta, $name); ++} ++ ++# [perl #129788] IO::Poll shouldn't leak on errors ++{ ++ package io_poll_leak; ++ use IO::Poll; ++ ++ sub TIESCALAR { bless {} } ++ sub FETCH { die } ++ ++ tie(my $a, __PACKAGE__); ++ sub f {eval { IO::Poll::_poll(0, $a, 1) }} ++ ++ ::leak(5, 0, \&f, q{IO::Poll::_poll shouldn't leak}); ++} +-- +2.7.4 + diff --git a/perl.spec b/perl.spec index 6ab8daa..38ea12e 100644 --- a/perl.spec +++ b/perl.spec @@ -238,6 +238,9 @@ Patch62: perl-5.25.7-Fix-const-correctness-in-hv_func.h.patch # in upsream after 5.25.7 Patch63: perl-5.24.0-assertion-failure-in-.-or-0-x-0.patch +# Fix a memory leak in IO::Poll, RT#129788, in upstream after 5.25.7 +Patch64: perl-5.24.0-perl-129788-IO-Poll-fix-memory-leak.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 @@ -2927,6 +2930,7 @@ Perl extension for Version Objects %patch61 -p1 %patch62 -p1 %patch63 -p1 +%patch64 -p1 %patch200 -p1 %patch201 -p1 @@ -2981,6 +2985,7 @@ perl -x patchlevel.h \ 'Fedora Patch61: Fix assigning split() return values to an array' \ 'Fedora Patch62: Fix const correctness in hv_func.h (RT#130169)' \ 'Fedora Patch63: Fix a crash in optimized evaluation of "or ((0) x 0))" (RT#130247)' \ + 'Fedora Patch64: Fix a memory leak in IO::Poll (RT#129788)' \ '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} @@ -5261,6 +5266,7 @@ popd %changelog * Mon Dec 19 2016 Petr Pisar - 4:5.24.0-382 - Fix a crash in optimized evaluation of "or ((0) x 0))" (RT#130247) +- Fix a memory leak in IO::Poll (RT#129788) * Thu Dec 01 2016 Petr Pisar - 4:5.24.0-381 - Fix crash in Storable when deserializing malformed code reference