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