Skip Menu |
Report information
Id: 129928
Status: resolved
Priority: 0/
Queue: perl5

Owner: Nobody
Requestors: mauke- <l.mai [at] web.de>
Cc:
AdminCc:

Operating System: Linux
PatchStatus: (no value)
Severity: low
Type: core
Perl Version: 5.24.0
Fixed In: (no value)

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



From: l.mai [...] web.de
Date: Thu, 20 Oct 2016 20:59:53 +0200
To: perlbug [...] perl.org
Subject: do "a\0b" dies instead of returning undef / ENOENT
Download (untitled) / with headers
text/plain 3.5k
This is a bug report for perl from l.mai@web.de, generated with the help of perlbug 1.40 running under perl 5.24.0. ----------------------------------------------------------------- [Please describe your issue here] 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. [Please do not change anything below this line] ----------------------------------------------------------------- --- 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
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 194b
On Thu Oct 20 12:00:22 2016, mauke- wrote: Show quoted text
> When given a filename containing "\0", 'do' throws a "Can't locate" > exception instead of returning undef and setting $! to ENOENT.
Patch attached.
Subject: 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
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 315b
On Thu Oct 20 15:14:25 2016, mauke- wrote: Show quoted text
> 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 a1b60c8dae6ad00c164e20cf9151bae68e85ab2d. Tony
Download (untitled) / with headers
text/plain 313b
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.


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

For issues related to this RT instance (aka "perlbug"), please contact perlbug-admin at perl.org