Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

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

Closed
p5pRT opened this issue Oct 20, 2016 · 8 comments
Closed

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

p5pRT opened this issue Oct 20, 2016 · 8 comments

Comments

@p5pRT
Copy link

p5pRT commented Oct 20, 2016

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

Searchable as RT129928$

@p5pRT
Copy link
Author

p5pRT commented Oct 20, 2016

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
Copy link
Author

p5pRT commented Oct 20, 2016

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
Copy link
Author

p5pRT commented Oct 20, 2016

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
Copy link
Author

p5pRT commented Oct 25, 2016

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
Copy link
Author

p5pRT commented Oct 25, 2016

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

@p5pRT
Copy link
Author

p5pRT commented Oct 25, 2016

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

@p5pRT
Copy link
Author

p5pRT commented May 30, 2017

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
Copy link
Author

p5pRT commented May 30, 2017

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

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Development

No branches or pull requests

1 participant