do "a\0b" dies instead of returning undef / ENOENT

[p5pRT]

Migrated from rt.perl.org#129928 (status was 'resolved')

Searchable as RT129928$

[p5pRT]

From @mauke

Created by @mauke

perldoc -f do​:

| If "do" cannot read the file, it returns undef and sets $! to the
| error.

$ perl -we 'open my $fh, "<", "a\0b" or warn "open failed with​: $!"'
Invalid \0 character in pathname for open​: a\0b at -e line 1.
open failed with​: No such file or directory at -e line 1.

$ perl -we 'do "a\0b" or warn "do failed with​: $!"'
Invalid \0 character in pathname for require​: a\0b at -e line 1.
Can't locate a\0b​: No such file or directory at -e line 1.

When given a filename containing "\0", 'do' throws a "Can't locate"
exception instead of returning undef and setting $! to ENOENT.

Perl Info

Flags:
    category=core
    severity=low

Site configuration information for perl 5.24.0:

Configured by mauke at Mon May  9 21:21:33 CEST 2016.

Summary of my perl5 (revision 5 version 24 subversion 0) configuration:
   
  Platform:
    osname=linux, osvers=4.4.5-1-arch, archname=i686-linux
    uname='linux simplicio 4.4.5-1-arch #1 smp preempt thu mar 10 07:54:30 cet 2016 i686 gnulinux '
    config_args=''
    hint=previous, useposix=true, d_sigaction=define
    useithreads=undef, usemultiplicity=undef
    use64bitint=undef, use64bitall=undef, uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='cc', ccflags ='-fwrapv -fno-strict-aliasing -pipe -fstack-protector-strong -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-O2 -flto',
    cppflags='-fwrapv -fno-strict-aliasing -pipe -fstack-protector-strong -I/usr/local/include'
    ccversion='', gccversion='6.1.1 20160501', gccosandvers=''
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234, doublekind=3
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12, longdblkind=3
    ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=4, prototype=define
  Linker and Libraries:
    ld='cc', ldflags ='-fstack-protector-strong -L/usr/local/lib -flto'
    libpth=/usr/local/lib /usr/lib/gcc/i686-pc-linux-gnu/6.1.1/include-fixed /usr/lib /lib /usr/local/lib /usr/lib/gcc/i686-pc-linux-gnu/6.1.1/include-fixed /usr/lib
    libs=-lpthread -lnsl -lgdbm -ldb -ldl -lm -lcrypt -lutil -lc -lgdbm_compat
    perllibs=-lpthread -lnsl -ldl -lm -lcrypt -lutil -lc
    libc=libc-2.23.so, so=so, useshrplib=false, libperl=libperl.a
    gnulibc_version='2.23'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
    cccdlflags='-fPIC', lddlflags='-shared -O2 -flto -L/usr/local/lib -fstack-protector-strong'



@INC for perl 5.24.0:
    /home/mauke/usr/lib/perl5/site_perl/5.24.0/i686-linux
    /home/mauke/usr/lib/perl5/site_perl/5.24.0
    /home/mauke/usr/lib/perl5/5.24.0/i686-linux
    /home/mauke/usr/lib/perl5/5.24.0
    .


Environment for perl 5.24.0:
    HOME=/home/mauke
    LANG=en_US.UTF-8
    LANGUAGE=en_US
    LC_COLLATE=C
    LC_MONETARY=de_DE.UTF-8
    LC_TIME=de_DE.UTF-8
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/home/mauke/perl5/perlbrew/bin:/home/mauke/bin:/usr/local/sbin:/usr/local/bin:/usr/bin:/usr/bin/site_perl:/usr/bin/vendor_perl:/usr/bin/core_perl
    PERLBREW_BASHRC_VERSION=0.73
    PERLBREW_HOME=/home/mauke/.perlbrew
    PERLBREW_ROOT=/home/mauke/perl5/perlbrew
    PERL_BADLANG (unset)
    PERL_UNICODE=SAL
    SHELL=/bin/bash

[p5pRT]

From @mauke

On Thu Oct 20 12​:00​:22 2016, mauke- wrote​:

When given a filename containing "\0", 'do' throws a "Can't locate"
exception instead of returning undef and setting $! to ENOENT.

Patch attached.

[p5pRT]

From @mauke

0001-make-do-a-0b-fail-silently-instead-of-throwing-RT-12.patch

From c73c31dd573882e99184c56f3f5aac526208cb6b Mon Sep 17 00:00:00 2001
From: Lukas Mai <l.mai@web.de>
Date: Fri, 21 Oct 2016 00:10:15 +0200
Subject: [PATCH] make do "a\0b" fail silently instead of throwing (RT #129928)

Also remove the label/goto from CLEAR_ERRSV because labels have function
scope, which means you couldn't use CLEAR_ERRSV more than once per
function without getting a "duplicate label" error.
---
 perl.h                |  5 ++---
 pp_ctl.c              |  4 ++++
 t/op/require_errors.t | 16 +++++++++++++---
 3 files changed, 19 insertions(+), 6 deletions(-)

diff --git a/perl.h b/perl.h
index d27a131..175dc2e 100644
--- a/perl.h
+++ b/perl.h
@@ -1280,14 +1280,13 @@ EXTERN_C char *crypt(const char *, const char *);
 #define CLEAR_ERRSV() STMT_START {					\
     SV ** const svp = &GvSV(PL_errgv);					\
     if (!*svp) {							\
-	goto clresv_newemptypv;						\
+        *svp = newSVpvs("");                                            \
     } else if (SvREADONLY(*svp)) {					\
 	SvREFCNT_dec_NN(*svp);						\
-	clresv_newemptypv:						\
 	*svp = newSVpvs("");						\
     } else {								\
 	SV *const errsv = *svp;						\
-        SvPVCLEAR(errsv);                                                \
+        SvPVCLEAR(errsv);                                               \
 	SvPOK_only(errsv);						\
 	if (SvMAGICAL(errsv)) {						\
 	    mg_free(errsv);						\
diff --git a/pp_ctl.c b/pp_ctl.c
index 8aa02d5..921d53f 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3692,6 +3692,10 @@ S_require_file(pTHX_ SV *const sv)
         DIE(aTHX_ "Missing or undefined argument to require");
 
     if (!IS_SAFE_PATHNAME(name, len, "require")) {
+        if (PL_op->op_type != OP_REQUIRE) {
+            CLEAR_ERRSV();
+            RETPUSHUNDEF;
+        }
         DIE(aTHX_ "Can't locate %s:   %s",
             pv_escape(newSVpvs_flags("",SVs_TEMP),name,len,len*2,
                       NULL, SvUTF8(sv)?PERL_PV_ESCAPE_UNI:0),
diff --git a/t/op/require_errors.t b/t/op/require_errors.t
index d2c2bb5..2bacf59 100644
--- a/t/op/require_errors.t
+++ b/t/op/require_errors.t
@@ -9,7 +9,7 @@ BEGIN {
 use strict;
 use warnings;
 
-plan(tests => 20);
+plan(tests => 23);
 
 my $nonfile = tempfile();
 
@@ -120,11 +120,21 @@ SKIP: {
 # fail and print the full filename
 eval { no warnings 'syscalls'; require "strict.pm\0invalid"; };
 like $@, qr/^Can't locate strict\.pm\\0invalid: /, 'require nul check [perl #117265]';
-eval { no warnings 'syscalls'; do "strict.pm\0invalid"; };
-like $@, qr/^Can't locate strict\.pm\\0invalid: /, 'do nul check';
 {
   my $WARN;
   local $SIG{__WARN__} = sub { $WARN = shift };
+  {
+    my $ret = do "strict.pm\0invalid";
+    my $exc = $@;
+    my $err = $!;
+    is $ret, undef, 'do nulstring returns undef';
+    is $exc, '',    'do nulstring clears $@';
+    $! = $err;
+    ok $!{ENOENT},  'do nulstring fails with ENOENT';
+    like $WARN, qr{^Invalid \\0 character in pathname for require: strict\.pm\\0invalid at }, 'do nulstring warning';
+  }
+
+  $WARN = '';
   eval { require "strict.pm\0invalid"; };
   like $WARN, qr{^Invalid \\0 character in pathname for require: strict\.pm\\0invalid at }, 'nul warning';
   like $@, qr{^Can't locate strict\.pm\\0invalid: }, 'nul error';
-- 
2.10.0

[p5pRT]

From @tonycoz

On Thu Oct 20 15​:14​:25 2016, mauke- wrote​:

On Thu Oct 20 12​:00​:22 2016, mauke- wrote​:

When given a filename containing "\0", 'do' throws a "Can't locate"
exception instead of returning undef and setting $! to ENOENT.

Patch attached.

Thanks, applied as a1b60c8.

Tony

[p5pRT]

The RT System itself - Status changed from 'new' to 'open'

[p5pRT]

@tonycoz - Status changed from 'open' to 'pending release'

[p5pRT]

From @khwilliamson

Thank you for filing this report. You have helped make Perl better.

With the release today of Perl 5.26.0, this and 210 other issues have been
resolved.

Perl 5.26.0 may be downloaded via​:
https://metacpan.org/release/XSAWYERX/perl-5.26.0

If you find that the problem persists, feel free to reopen this ticket.

[p5pRT]

@khwilliamson - Status changed from 'pending release' to 'resolved'