From 2d2ad79937f4a89ce5d9308b07d6ffb776e6ac3e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= Date: Wed, 1 Aug 2018 10:37:41 +0200 Subject: [PATCH] Fix a file descriptor leak in in-place edits --- ...ys-close-the-directory-handle-on-cle.patch | 103 ++++++++++++++++++ ...-for-handle-leaks-from-in-place-edit.patch | 81 ++++++++++++++ perl.spec | 14 ++- 3 files changed, 197 insertions(+), 1 deletion(-) create mode 100644 perl-5.29.1-perl-133314-always-close-the-directory-handle-on-cle.patch create mode 100644 perl-5.29.1-perl-133314-test-for-handle-leaks-from-in-place-edit.patch diff --git a/perl-5.29.1-perl-133314-always-close-the-directory-handle-on-cle.patch b/perl-5.29.1-perl-133314-always-close-the-directory-handle-on-cle.patch new file mode 100644 index 0000000..8df0e8c --- /dev/null +++ b/perl-5.29.1-perl-133314-always-close-the-directory-handle-on-cle.patch @@ -0,0 +1,103 @@ +From 3d5e9c119db6b727684fe75dfcfe5831c4351bec Mon Sep 17 00:00:00 2001 +From: Tony Cook +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ř +--- + 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 + diff --git a/perl-5.29.1-perl-133314-test-for-handle-leaks-from-in-place-edit.patch b/perl-5.29.1-perl-133314-test-for-handle-leaks-from-in-place-edit.patch new file mode 100644 index 0000000..b7e7e4b --- /dev/null +++ b/perl-5.29.1-perl-133314-test-for-handle-leaks-from-in-place-edit.patch @@ -0,0 +1,81 @@ +From 028f02e7e97a6026ba9ef084c3803ea08d36aa5b Mon Sep 17 00:00:00 2001 +From: Tony Cook +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ř +--- + 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 + diff --git a/perl.spec b/perl.spec index ac85974..074af69 100644 --- a/perl.spec +++ b/perl.spec @@ -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 - 4:5.28.0-420 +- Fix a file descriptor leak in in-place edits (RT#133314) + * Tue Jul 17 2018 Petr Pisar - 4:5.28.0-419 - Fix index() and rindex() optimization in given-when boolean context (RT#133368)