From 0a41ca5a68626a0f44e0d552e460e86567e47140 Mon Sep 17 00:00:00 2001 From: Zefram 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ř --- 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