-
Notifications
You must be signed in to change notification settings - Fork 542
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
[PATCH] Fix possible memory leak in IO::Poll #15640
Comments
From @dur-randirCreated by @dur-randirUnder some exotic circumstances IO::Poll::_poll() could leak memory. use IO::Poll; sub TIESCALAR { bless {} } tie(my $foo, __PACKAGE__); while (1) { Perl Info
|
From @dur-randir0001-IO-Poll-fix-possible-memory-leak.patchFrom ab98ace745499ec49f9d20a90a9fb8e1f2f54c79 Mon Sep 17 00:00:00 2001
From: Sergey Aleynikov <sergey.aleynikov@gmail.com>
Date: Sun, 2 Oct 2016 21:50:34 +0300
Subject: [PATCH] IO::Poll: fix possible memory leak
When a magical/tied scalar which dies upon read was passed to _poll()
temporary buffer for events were not freed.
---
dist/IO/IO.xs | 3 +--
1 file changed, 1 insertion(+), 2 deletions(-)
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");
--
2.10.0
|
From @jkeenanOn Sun Oct 02 12:54:53 2016, randir wrote:
Is there a way of converting this example into a test case, say, something that could go into dist/IO/t/io_poll.t? Thank you very much. -- |
The RT System itself - Status changed from 'new' to 'open' |
From @dur-randirOn Sun Oct 02 17:26:53 2016, jkeenan wrote:
Problem with leaks is that it's hard to create cross-platform test for them without accessing perl internals. I see such tests in t/op/svleak.t, but they use XS::APItest. Is it OK to place test for a module in there? |
From @cpansproutOn Tue Oct 04 12:56:24 2016, randir wrote:
Since IO is built with perl that should be OK. Alternatively, you could put a test in io_poll.t that uses XS::APItest, but make it conditional on whether XS::APItest can load. -- Father Chrysostomos |
From @dur-randirHere's an updated patch with a test added to t/op/svleak.t |
From @dur-randir0001-IO-Poll-fix-possible-memory-leak.patchFrom 03948fa8c4c74e8dff8f23d363a5e969f9f4fac9 Mon Sep 17 00:00:00 2001
From: Sergey Aleynikov <sergey.aleynikov@gmail.com>
Date: Wed, 5 Oct 2016 21:33:38 +0300
Subject: [PATCH] IO::Poll: fix possible memory leak
Whenever a magical/tied scalar which dies upon read was passed to _poll()
temporary buffer for events was not freed.
---
dist/IO/IO.pm | 2 +-
dist/IO/IO.xs | 3 +--
t/op/svleak.t | 16 +++++++++++++++-
3 files changed, 17 insertions(+), 4 deletions(-)
diff --git a/dist/IO/IO.pm b/dist/IO/IO.pm
index 07a5e51..a9a5852 100644
--- a/dist/IO/IO.pm
+++ b/dist/IO/IO.pm
@@ -7,7 +7,7 @@ use Carp;
use strict;
use warnings;
-our $VERSION = "1.37";
+our $VERSION = "1.38";
XSLoader::load 'IO', $VERSION;
sub import {
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/t/op/svleak.t b/t/op/svleak.t
index 77ff9ae..4a0c046 100644
--- a/t/op/svleak.t
+++ b/t/op/svleak.t
@@ -15,7 +15,7 @@ BEGIN {
use Config;
-plan tests => 138;
+plan tests => 139;
# run some code N times. If the number of SVs at the end of loop N is
# greater than (N-1)*delta at the end of loop 1, we've got a leak
@@ -560,3 +560,17 @@ EOF
sub f { $a =~ /[^.]+$b/; }
::leak(2, 0, \&f, q{use re 'strict' shouldn't leak warning strings});
}
+
+# [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.10.0
|
From @tonycozOn Wed Oct 05 11:36:18 2016, randir wrote:
I suspect the attached is closer to what Father Chrysostomos was Tony |
From @tonycoz0001-perl-129788-IO-Poll-fix-memory-leak.patchFrom 59ac1937eb4e3fcc8eb6740d2a988af339326d7f Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 25 Oct 2016 16:17:18 +1100
Subject: (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 <sergey.aleynikov@gmail.com>
---
MANIFEST | 1 +
META.json | 1 +
META.yml | 1 +
dist/IO/IO.pm | 2 +-
dist/IO/IO.xs | 3 +--
dist/IO/t/io_leak.t | 37 +++++++++++++++++++++++++++++++++++++
6 files changed, 42 insertions(+), 3 deletions(-)
create mode 100644 dist/IO/t/io_leak.t
diff --git a/MANIFEST b/MANIFEST
index d2dfa4c..2f1a709 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -3412,6 +3412,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.t See if binmode()-related methods on IO::File work
dist/IO/t/io_file_export.t Test IO::File exports
+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 e8aa5cb..41d44d3 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 4d43f10..95ae2bf 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.pm b/dist/IO/IO.pm
index 07a5e51..a9a5852 100644
--- a/dist/IO/IO.pm
+++ b/dist/IO/IO.pm
@@ -7,7 +7,7 @@ use Carp;
use strict;
use warnings;
-our $VERSION = "1.37";
+our $VERSION = "1.38";
XSLoader::load 'IO', $VERSION;
sub import {
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.1.4
|
@tonycoz - Status changed from 'open' to 'pending release' |
From @khwilliamsonThank you for filing this report. You have helped make Perl better. With the release today of Perl 5.26.0, this and 210 other issues have been Perl 5.26.0 may be downloaded via: If you find that the problem persists, feel free to reopen this ticket. |
@khwilliamson - Status changed from 'pending release' to 'resolved' |
Migrated from rt.perl.org#129788 (status was 'resolved')
Searchable as RT129788$
The text was updated successfully, but these errors were encountered: