rpms/perl
3
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix a file descriptor leak in in-place edits

Browse Source
This commit is contained in:
Petr Písař 2018-08-01 10:37:41 +02:00
parent 1f538b3dc4
commit 2d2ad79937
3 changed files with 197 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

103
perl-5.29.1-perl-133314-always-close-the-directory-handle-on-cle.patch Normal file
View File

@ -0,0 +1,103 @@
From 3d5e9c119db6b727684fe75dfcfe5831c4351bec Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 2 Jul 2018 10:43:19 +1000
Subject: [PATCH 2/2] (perl #133314) always close the directory handle on clean
up
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Previously the directory handle was only closed if the rest of the
magic free clean up is done, but in most success cases that code
doesn't run, leaking the directory handle.
So always close the directory if our AV is available.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
doio.c | 56 +++++++++++++++++++++++++++++++-------------------------
1 file changed, 31 insertions(+), 25 deletions(-)
diff --git a/doio.c b/doio.c
index 4b8923f77c..16daf9fd11 100644
--- a/doio.c
+++ b/doio.c
@@ -1163,44 +1163,50 @@ S_argvout_free(pTHX_ SV *io, MAGIC *mg) {
/* mg_obj can be NULL if a thread is created with the handle open, in which
case we leave any clean up to the parent thread */
- if (mg->mg_obj && IoIFP(io)) {
- SV **pid_psv;
+ if (mg->mg_obj) {
#ifdef ARGV_USE_ATFUNCTIONS
SV **dir_psv;
DIR *dir;
+
+ dir_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_ORIG_DIRP, FALSE);
+ assert(dir_psv && *dir_psv && SvIOK(*dir_psv));
+ dir = INT2PTR(DIR *, SvIV(*dir_psv));
#endif
- PerlIO *iop = IoIFP(io);
+ if (IoIFP(io)) {
+ SV **pid_psv;
+ PerlIO *iop = IoIFP(io);
- assert(SvTYPE(mg->mg_obj) == SVt_PVAV);
+ assert(SvTYPE(mg->mg_obj) == SVt_PVAV);
- pid_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_ORIG_PID, FALSE);
+ pid_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_ORIG_PID, FALSE);
- assert(pid_psv && *pid_psv);
+ assert(pid_psv && *pid_psv);
- if (SvIV(*pid_psv) == (IV)PerlProc_getpid()) {
- /* if we get here the file hasn't been closed explicitly by the
- user and hadn't been closed implicitly by nextargv(), so
- abandon the edit */
- SV **temp_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_TEMP_NAME, FALSE);
- const char *temp_pv = SvPVX(*temp_psv);
+ if (SvIV(*pid_psv) == (IV)PerlProc_getpid()) {
+ /* if we get here the file hasn't been closed explicitly by the
+ user and hadn't been closed implicitly by nextargv(), so
+ abandon the edit */
+ SV **temp_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_TEMP_NAME, FALSE);
+ const char *temp_pv = SvPVX(*temp_psv);
- assert(temp_psv && *temp_psv && SvPOK(*temp_psv));
- (void)PerlIO_close(iop);
- IoIFP(io) = IoOFP(io) = NULL;
+ assert(temp_psv && *temp_psv && SvPOK(*temp_psv));
+ (void)PerlIO_close(iop);
+ IoIFP(io) = IoOFP(io) = NULL;
#ifdef ARGV_USE_ATFUNCTIONS
- dir_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_ORIG_DIRP, FALSE);
- assert(dir_psv && *dir_psv && SvIOK(*dir_psv));
- dir = INT2PTR(DIR *, SvIV(*dir_psv));
- if (dir) {
- if (unlinkat(my_dirfd(dir), temp_pv, 0) < 0 &&
- NotSupported(errno))
- (void)UNLINK(temp_pv);
- closedir(dir);
- }
+ if (dir) {
+ if (unlinkat(my_dirfd(dir), temp_pv, 0) < 0 &&
+ NotSupported(errno))
+ (void)UNLINK(temp_pv);
+ }
#else
- (void)UNLINK(temp_pv);
+ (void)UNLINK(temp_pv);
#endif
+ }
}
+#ifdef ARGV_USE_ATFUNCTIONS
+ if (dir)
+ closedir(dir);
+#endif
}
return 0;
--
2.14.4

81
perl-5.29.1-perl-133314-test-for-handle-leaks-from-in-place-edit.patch Normal file
View File

@ -0,0 +1,81 @@
From 028f02e7e97a6026ba9ef084c3803ea08d36aa5b Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Wed, 1 Aug 2018 11:55:22 +1000
Subject: [PATCH 1/2] (perl #133314) test for handle leaks from in-place
editing
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
t/io/nargv.t | 46 +++++++++++++++++++++++++++++++++++++++++++++-
1 file changed, 45 insertions(+), 1 deletion(-)
diff --git a/t/io/nargv.t b/t/io/nargv.t
index 598ceed617..4482572aeb 100644
--- a/t/io/nargv.t
+++ b/t/io/nargv.t
@@ -6,7 +6,7 @@ BEGIN {
set_up_inc('../lib');
}
-print "1..6\n";
+print "1..7\n";
my $j = 1;
for $i ( 1,2,5,4,3 ) {
@@ -84,6 +84,50 @@ sub other {
}
}
+{
+ # (perl #133314) directory handle leak
+ #
+ # We process a significant number of files here to make sure any
+ # leaks are significant
+ @ARGV = mkfiles(1 .. 10);
+ for my $file (@ARGV) {
+ open my $f, ">", $file;
+ print $f "\n";
+ close $f;
+ }
+ local $^I = ".bak";
+ local $_;
+ while (<>) {
+ s/^/foo/;
+ }
+}
+
+{
+ # (perl #133314) directory handle leak
+ # We open three handles here because the file processing opened:
+ # - the original file
+ # - the output file, and finally
+ # - the directory
+ # so we need to open the first two to use up the slots used for the original
+ # and output files.
+ # This test assumes fd are allocated in the typical *nix way - lowest
+ # available, which I believe is the case for the Win32 CRTs too.
+ # If this turns out not to be the case this test will need to skip on
+ # such platforms or only run on a small set of known-good platforms.
+ my $tfile = mkfiles(1);
+ open my $f, "<", $tfile
+ or die "Cannot open temp: $!";
+ open my $f2, "<", $tfile
+ or die "Cannot open temp: $!";
+ open my $f3, "<", $tfile
+ or die "Cannot open temp: $!";
+ print +(fileno($f3) < 20 ? "ok" : "not ok"), " 7 check fd leak\n";
+ close $f;
+ close $f2;
+ close $f3;
+}
+
+
my @files;
sub mkfiles {
foreach (@_) {
--
2.14.4

14
perl.spec
View File

@ -81,7 +81,7 @@ License: GPL+ or Artistic
Epoch: %{perl_epoch}
Version: %{perl_version}
# release number must be even higher, because dual-lived modules will be broken otherwise
Release: 419%{?dist}
Release: 420%{?dist}
Summary: Practical Extraction and Report Language
Url: https://www.perl.org/
Source0: https://www.cpan.org/src/5.0/perl-%{perl_version}.tar.xz
@ -172,6 +172,11 @@ Patch19: perl-5.29.0-treat-when-index-1-as-a-boolean-expression.patch
# Fix build conditions in locale.c, in upstream after 5.29.0
Patch20: perl-5.29.0-locale.c-Fix-conditional-compilation.patch
# Fix a file descriptor leak in in-place edits, RT#133314,
# in upstream after 5.29.1
Patch21: perl-5.29.1-perl-133314-test-for-handle-leaks-from-in-place-edit.patch
Patch22: perl-5.29.1-perl-133314-always-close-the-directory-handle-on-cle.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
@ -2744,6 +2749,8 @@ Perl extension for Version Objects
%patch18 -p1
%patch19 -p1
%patch20 -p1
%patch21 -p1
%patch22 -p1
%patch200 -p1
%patch201 -p1
@ -2771,6 +2778,8 @@ perl -x patchlevel.h \
'Fedora Patch18: Fix invoking a check for wide characters while ISO-8859-1 locale is in effect' \
'Fedora Patch19: Fix index() and rindex() optimization in given-when boolean context (RT#133368)' \
'Fedora Patch20: Fix build conditions in locale.c' \
'Fedora Patch21: Fix a file descriptor leak in in-place edits (RT#133314)' \
'Fedora Patch22: Fix a file descriptor leak in in-place edits (RT#133314)' \
'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}
@ -5059,6 +5068,9 @@ popd
# Old changelog entries are preserved in CVS.
%changelog
* Wed Aug 01 2018 Petr Pisar <ppisar@redhat.com> - 4:5.28.0-420
- Fix a file descriptor leak in in-place edits (RT#133314)
* Tue Jul 17 2018 Petr Pisar <ppisar@redhat.com> - 4:5.28.0-419
- Fix index() and rindex() optimization in given-when boolean context
(RT#133368)