You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
212 lines
6.4 KiB
212 lines
6.4 KiB
From 0a41ca5a68626a0f44e0d552e460e86567e47140 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.24.3.
|
|
|
|
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 fcf7eae..3077142 100644
|
|
--- a/MANIFEST
|
|
+++ b/MANIFEST
|
|
@@ -5394,6 +5394,7 @@ t/op/sselect.t See if 4 argument select works
|
|
t/op/stash.t See if %:: stashes work
|
|
t/op/state.t See if state variables 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/study.t See if study works
|
|
t/op/studytied.t See if study works with tied scalars
|
|
t/op/sub_lval.t See if lvalue subroutines work
|
|
diff --git a/doio.c b/doio.c
|
|
index 2792c66..f2934c5 100644
|
|
--- a/doio.c
|
|
+++ b/doio.c
|
|
@@ -1429,8 +1429,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;
|
|
@@ -1441,6 +1444,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));
|
|
@@ -1451,6 +1455,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))
|
|
@@ -1503,6 +1508,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;
|
|
@@ -1512,6 +1519,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 5e0993d..2fcc219 100644
|
|
--- a/pp_sys.c
|
|
+++ b/pp_sys.c
|
|
@@ -2889,10 +2889,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;
|
|
sv_setpvs(PL_statname, "");
|
|
@@ -2903,22 +2904,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) {
|
|
@@ -3415,7 +3419,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
|
|
|