Fix setting $! when statting a closed filehandle
This commit is contained in:
Petr Písař
parent
acce317536
commit
f9337f705b
211
perl-5.26.1-set-when-statting-a-closed-filehandle.patch
Normal file
211
perl-5.26.1-set-when-statting-a-closed-filehandle.patch
Normal file
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user