Fix setting $! when statting a closed filehandle

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 <zefram@fysh.org>
+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ř <ppisar@redhat.com>
+---
+ 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
+

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 <jplesnik@redhat.com> - 4:5.26.1-401
 - Update perl(:MODULE_COMPAT)