From f9337f705b312e19418f456fc43bb8ab3f6fb127 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= Date: Tue, 9 Jan 2018 17:55:17 +0100 Subject: [PATCH] Fix setting $! when statting a closed filehandle --- ...et-when-statting-a-closed-filehandle.patch | 211 ++++++++++++++++++ perl.spec | 7 + 2 files changed, 218 insertions(+) create mode 100644 perl-5.26.1-set-when-statting-a-closed-filehandle.patch diff --git a/perl-5.26.1-set-when-statting-a-closed-filehandle.patch b/perl-5.26.1-set-when-statting-a-closed-filehandle.patch new file mode 100644 index 0000000..832aee8 --- /dev/null +++ b/perl-5.26.1-set-when-statting-a-closed-filehandle.patch @@ -0,0 +1,211 @@ +From 8c7182b26a43f14cd8afbfbe4448cbbd691c3609 Mon Sep 17 00:00:00 2001 +From: Zefram +Date: Wed, 15 Nov 2017 08:11:37 +0000 +Subject: [PATCH] set $! when statting a closed filehandle +MIME-Version: 1.0 +Content-Type: text/plain; charset=UTF-8 +Content-Transfer-Encoding: 8bit + +When a stat fails because it's on a closed or otherwise invalid +filehandle, $! was often not being set, depending on the operation +and the nature of the invalidity. Consistently set it to EBADF. +Fixes [perl #108288]. + +Petr Písař: Ported to 5.26.1. + +Signed-off-by: Petr Písař +--- + MANIFEST | 1 + + doio.c | 10 +++++++++- + pp_sys.c | 22 ++++++++++++--------- + t/op/stat_errors.t | 57 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ + 4 files changed, 80 insertions(+), 10 deletions(-) + create mode 100644 t/op/stat_errors.t + +diff --git a/MANIFEST b/MANIFEST +index fcbf5cc..996759e 100644 +--- a/MANIFEST ++++ b/MANIFEST +@@ -5670,6 +5670,7 @@ t/op/srand.t See if srand works + t/op/sselect.t See if 4 argument select works + t/op/stash.t See if %:: stashes work + t/op/stat.t See if stat works ++t/op/stat_errors.t See if stat and file tests handle threshold errors + t/op/state.t See if state variables work + t/op/study.t See if study works + t/op/studytied.t See if study works with tied scalars +diff --git a/doio.c b/doio.c +index 70d7747..71dc6e4 100644 +--- a/doio.c ++++ b/doio.c +@@ -1437,8 +1437,11 @@ Perl_my_stat_flags(pTHX_ const U32 flags) + if (PL_op->op_flags & OPf_REF) { + gv = cGVOP_gv; + do_fstat: +- if (gv == PL_defgv) ++ if (gv == PL_defgv) { ++ if (PL_laststatval < 0) ++ SETERRNO(EBADF,RMS_IFI); + return PL_laststatval; ++ } + io = GvIO(gv); + do_fstat_have_io: + PL_laststype = OP_STAT; +@@ -1449,6 +1452,7 @@ Perl_my_stat_flags(pTHX_ const U32 flags) + int fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) { + /* E.g. PerlIO::scalar has no real fd. */ ++ SETERRNO(EBADF,RMS_IFI); + return (PL_laststatval = -1); + } else { + return (PL_laststatval = PerlLIO_fstat(fd, &PL_statcache)); +@@ -1459,6 +1463,7 @@ Perl_my_stat_flags(pTHX_ const U32 flags) + } + PL_laststatval = -1; + report_evil_fh(gv); ++ SETERRNO(EBADF,RMS_IFI); + return -1; + } + else if ((PL_op->op_private & (OPpFT_STACKED|OPpFT_AFTER_t)) +@@ -1511,6 +1516,8 @@ Perl_my_lstat_flags(pTHX_ const U32 flags) + if (cGVOP_gv == PL_defgv) { + if (PL_laststype != OP_LSTAT) + Perl_croak(aTHX_ "%s", no_prev_lstat); ++ if (PL_laststatval < 0) ++ SETERRNO(EBADF,RMS_IFI); + return PL_laststatval; + } + PL_laststatval = -1; +@@ -1520,6 +1527,7 @@ Perl_my_lstat_flags(pTHX_ const U32 flags) + "Use of -l on filehandle %" HEKf, + HEKfARG(GvENAME_HEK(cGVOP_gv))); + } ++ SETERRNO(EBADF,RMS_IFI); + return -1; + } + if ((PL_op->op_private & (OPpFT_STACKED|OPpFT_AFTER_t)) +diff --git a/pp_sys.c b/pp_sys.c +index fefbea3..87961f1 100644 +--- a/pp_sys.c ++++ b/pp_sys.c +@@ -2925,10 +2925,11 @@ PP(pp_stat) + Perl_croak(aTHX_ "The stat preceding lstat() wasn't an lstat"); + } + +- if (gv != PL_defgv) { +- bool havefp; ++ if (gv == PL_defgv) { ++ if (PL_laststatval < 0) ++ SETERRNO(EBADF,RMS_IFI); ++ } else { + do_fstat_have_io: +- havefp = FALSE; + PL_laststype = OP_STAT; + PL_statgv = gv ? gv : (GV *)io; + SvPVCLEAR(PL_statname); +@@ -2939,22 +2940,25 @@ PP(pp_stat) + if (IoIFP(io)) { + int fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) { ++ report_evil_fh(gv); + PL_laststatval = -1; + SETERRNO(EBADF,RMS_IFI); + } else { + PL_laststatval = PerlLIO_fstat(fd, &PL_statcache); +- havefp = TRUE; + } + } else if (IoDIRP(io)) { + PL_laststatval = + PerlLIO_fstat(my_dirfd(IoDIRP(io)), &PL_statcache); +- havefp = TRUE; + } else { ++ report_evil_fh(gv); + PL_laststatval = -1; ++ SETERRNO(EBADF,RMS_IFI); + } +- } +- else PL_laststatval = -1; +- if (PL_laststatval < 0 && !havefp) report_evil_fh(gv); ++ } else { ++ report_evil_fh(gv); ++ PL_laststatval = -1; ++ SETERRNO(EBADF,RMS_IFI); ++ } + } + + if (PL_laststatval < 0) { +@@ -3451,7 +3455,7 @@ PP(pp_fttty) + else if (name && isDIGIT(*name) && grok_atoUV(name, &uv, NULL) && uv <= PERL_INT_MAX) + fd = (int)uv; + else +- FT_RETURNUNDEF; ++ fd = -1; + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + FT_RETURNUNDEF; +diff --git a/t/op/stat_errors.t b/t/op/stat_errors.t +new file mode 100644 +index 0000000..e043c61 +--- /dev/null ++++ b/t/op/stat_errors.t +@@ -0,0 +1,57 @@ ++#!./perl ++ ++BEGIN { ++ chdir 't' if -d 't'; ++ require './test.pl'; ++ set_up_inc('../lib'); ++} ++ ++plan(tests => 2*11*29); ++ ++use Errno qw(EBADF ENOENT); ++ ++open(SCALARFILE, "<", \"wibble") or die $!; ++open(CLOSEDFILE, "<", "./test.pl") or die $!; ++close(CLOSEDFILE) or die $!; ++opendir(CLOSEDDIR, "../lib") or die $!; ++closedir(CLOSEDDIR) or die $!; ++ ++foreach my $op ( ++ qw(stat lstat), ++ (map { "-$_" } qw(r w x o R W X O e z s f d l p S b c t u g k T B M A C)), ++) { ++ foreach my $arg ( ++ (map { ($_, "\\*$_") } ++ qw(NEVEROPENED SCALARFILE CLOSEDFILE CLOSEDDIR _)), ++ "\"tmpnotexist\"", ++ ) { ++ my $argdesc = $arg; ++ if ($arg eq "_") { ++ my @z = lstat "tmpnotexist"; ++ $argdesc .= " with prior stat fail"; ++ } ++ SKIP: { ++ if ($op eq "-l" && $arg =~ /\A\\/) { ++ # The op weirdly stringifies the globref and uses it as ++ # a filename, rather than treating it as a file handle. ++ # That might be a bug, but while that behaviour exists it ++ # needs to be exempted from these tests. ++ skip "-l on globref", 2; ++ } ++ if ($op eq "-t" && $arg eq "\"tmpnotexist\"") { ++ # The op doesn't operate on filenames. ++ skip "-t on filename", 2; ++ } ++ $! = 0; ++ my $res = eval "$op $arg"; ++ my $err = $!; ++ is $res, $op =~ /\A-/ ? undef : !!0, "result of $op $arg"; ++ is 0+$err, ++ $arg eq "\"tmpnotexist\"" || ++ ($op =~ /\A-[TB]\z/ && $arg =~ /_\z/) ? ENOENT : EBADF, ++ "error from $op $arg"; ++ } ++ } ++} ++ ++1; +-- +2.13.6 + diff --git a/perl.spec b/perl.spec index 710a7ad..e8193df 100644 --- a/perl.spec +++ b/perl.spec @@ -237,6 +237,10 @@ Patch69: perl-5.26.1-fix-do-dir-returning-no.patch # a member of an iteration list, RT#132442, in upstream after 5.27.5 Patch70: perl-5.27.5-perl-132442-Fix-stack-with-do-my-sub-l-1.patch +# Fix setting $! when statting a closed filehandle, RT#108288, +# in upstream after 5.27.5 +Patch71: perl-5.26.1-set-when-statting-a-closed-filehandle.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 @@ -2822,6 +2826,7 @@ Perl extension for Version Objects %patch68 -p1 %patch69 -p1 %patch70 -p1 +%patch71 -p1 %patch200 -p1 %patch201 -p1 @@ -2866,6 +2871,7 @@ perl -x patchlevel.h \ 'Fedora Patch68: Fix deparsing of transliterations with unprintable characters (RT#132405)' \ 'Fedora Patch69: Fix error reporting on do() on a directory (RT#125774)' \ 'Fedora Patch70: Fix stack manipulation when a lexical subroutine is defined in a do block in a member of an iteration list (RT#132442)' \ + 'Fedora Patch71: Fix setting $! when statting a closed filehandle (RT#108288)' \ '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} @@ -5164,6 +5170,7 @@ popd - Fix error reporting on do() on a directory (RT#125774) - Fix stack manipulation when a lexical subroutine is defined in a do block in a member of an iteration list (RT#132442) +- Fix setting $! when statting a closed filehandle (RT#108288) * Mon Sep 25 2017 Jitka Plesnikova - 4:5.26.1-401 - Update perl(:MODULE_COMPAT)