perl/perl-5.26.1-set-when-statting-a-closed-filehandle.patch

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