Skip Menu |
Report information
Id: 131895
Status: open
Priority: 0/
Queue: perl5

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

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

Attachments
0001-perl-131895-fail-stat-on-names-with-0-embedded.patch



Date: Mon, 14 Aug 2017 22:39:19 +0200
To: perlbug [...] perl.org
Subject: stat() doesn't fail on filenames containing \0 / NUL
From: l.mai [...] web.de
Download (untitled) / with headers
text/plain 3.2k
This is a bug report for perl from l.mai@web.de, generated with the help of perlbug 1.40 running under perl 5.26.0. ----------------------------------------------------------------- [Please describe your issue here] $ perl -wE 'stat ".\0-" or die $!' $ stat() returns success even though there is no file called ".\0-" on my system (because \0 is not valid in a file name). I would have expected a "No such file or directory" error (ENOENT), just like with open(). [Please do not change anything below this line] ----------------------------------------------------------------- --- Flags: category=core severity=low --- Site configuration information for perl 5.26.0: Configured by mauke at Tue May 30 23:06:36 CEST 2017. Summary of my perl5 (revision 5 version 26 subversion 0) configuration: Platform: osname=linux osvers=4.10.11-1-arch archname=i686-linux uname='linux simplicio 4.10.11-1-arch #1 smp preempt tue apr 18 09:00:04 cest 2017 i686 gnulinux ' config_args='' hint=recommended useposix=true d_sigaction=define useithreads=undef usemultiplicity=undef use64bitint=undef use64bitall=undef uselongdouble=undef usemymalloc=n default_inc_excludes_dot=define 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 -march=native' cppflags='-fwrapv -fno-strict-aliasing -pipe -fstack-protector-strong -I/usr/local/include' ccversion='' gccversion='7.1.1 20170516' 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' libpth=/usr/local/lib /usr/lib/gcc/i686-pc-linux-gnu/7.1.1/include-fixed /usr/lib /lib libs=-lpthread -lnsl -lgdbm -ldb -ldl -lm -lcrypt -lutil -lc -lgdbm_compat perllibs=-lpthread -lnsl -ldl -lm -lcrypt -lutil -lc libc=libc-2.25.so so=so useshrplib=false libperl=libperl.a gnulibc_version='2.25' Dynamic Linking: dlsrc=dl_dlopen.xs dlext=so d_dlsymun=undef ccdlflags='-Wl,-E' cccdlflags='-fPIC' lddlflags='-shared -O2 -march=native -L/usr/local/lib -fstack-protector-strong' --- @INC for perl 5.26.0: /home/mauke/usr/lib/perl5/site_perl/5.26.0/i686-linux /home/mauke/usr/lib/perl5/site_perl/5.26.0 /home/mauke/usr/lib/perl5/5.26.0/i686-linux /home/mauke/usr/lib/perl5/5.26.0 --- Environment for perl 5.26.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 346b
On Mon, 14 Aug 2017 13:39:41 -0700, mauke- wrote: Show quoted text
> $ perl -wE 'stat ".\0-" or die $!' > $ > > stat() returns success even though there is no file called ".\0-" on > my system > (because \0 is not valid in a file name). I would have expected a "No > such file > or directory" error (ENOENT), just like with open().
How about the attached? Tony
Subject: 0001-perl-131895-fail-stat-on-names-with-0-embedded.patch
From 409477758f331b110dbf6e79ac7802d6177ff204 Mon Sep 17 00:00:00 2001 From: Tony Cook <tony@develop-help.com> Date: Mon, 21 Aug 2017 14:58:14 +1000 Subject: (perl #131895) fail stat on names with \0 embedded Also lstat() and the file test ops. --- doio.c | 21 ++++++++++++++++----- pp_sys.c | 29 +++++++++++++++++++++++------ t/lib/warnings/pp_sys | 14 ++++++++++++++ t/op/filetest.t | 10 +++++++++- t/op/stat.t | 12 +++++++++++- 5 files changed, 73 insertions(+), 13 deletions(-) diff --git a/doio.c b/doio.c index 6f4cd84..14a46e5 100644 --- a/doio.c +++ b/doio.c @@ -1471,7 +1471,7 @@ Perl_my_stat_flags(pTHX_ const U32 flags) return PL_laststatval; else { SV* const sv = TOPs; - const char *s; + const char *s, *d; STRLEN len; if ((gv = MAYBE_DEREF_GV_flags(sv,flags))) { goto do_fstat; @@ -1485,9 +1485,14 @@ Perl_my_stat_flags(pTHX_ const U32 flags) s = SvPV_flags_const(sv, len, flags); PL_statgv = NULL; sv_setpvn(PL_statname, s, len); - s = SvPVX_const(PL_statname); /* s now NUL-terminated */ + d = SvPVX_const(PL_statname); /* s now NUL-terminated */ PL_laststype = OP_STAT; - PL_laststatval = PerlLIO_stat(s, &PL_statcache); + if (!IS_SAFE_PATHNAME(s, len, OP_NAME(PL_op))) { + PL_laststatval = -1; + } + else { + PL_laststatval = PerlLIO_stat(d, &PL_statcache); + } if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && should_warn_nl(s)) { GCC_DIAG_IGNORE(-Wformat-nonliteral); /* PL_warn_nl is constant */ Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "stat"); @@ -1504,6 +1509,7 @@ Perl_my_lstat_flags(pTHX_ const U32 flags) static const char* const no_prev_lstat = "The stat preceding -l _ wasn't an lstat"; dSP; const char *file; + STRLEN len; SV* const sv = TOPs; bool isio = FALSE; if (PL_op->op_flags & OPf_REF) { @@ -1547,9 +1553,14 @@ Perl_my_lstat_flags(pTHX_ const U32 flags) HEKfARG(GvENAME_HEK((const GV *) (SvROK(sv) ? SvRV(sv) : sv)))); } - file = SvPV_flags_const_nolen(sv, flags); + file = SvPV_flags_const(sv, len, flags); sv_setpv(PL_statname,file); - PL_laststatval = PerlLIO_lstat(file,&PL_statcache); + if (!IS_SAFE_PATHNAME(file, len, OP_NAME(PL_op))) { + PL_laststatval = -1; + } + else { + PL_laststatval = PerlLIO_lstat(file,&PL_statcache); + } if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && should_warn_nl(file)) { GCC_DIAG_IGNORE(-Wformat-nonliteral); /* PL_warn_nl is constant */ Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "lstat"); diff --git a/pp_sys.c b/pp_sys.c index e3aee18..0de9843 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -2968,19 +2968,24 @@ PP(pp_stat) } else { const char *file; + const char *temp; + STRLEN len; if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVIO) { io = MUTABLE_IO(SvRV(sv)); if (PL_op->op_type == OP_LSTAT) goto do_fstat_warning_check; goto do_fstat_have_io; } - SvTAINTED_off(PL_statname); /* previous tainting irrelevant */ - sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv)); + temp = SvPV_nomg_const(sv, len); + sv_setpv(PL_statname, temp); PL_statgv = NULL; PL_laststype = PL_op->op_type; file = SvPV_nolen_const(PL_statname); - if (PL_op->op_type == OP_LSTAT) + if (!IS_SAFE_PATHNAME(temp, len, OP_NAME(PL_op))) { + PL_laststatval = -1; + } + else if (PL_op->op_type == OP_LSTAT) PL_laststatval = PerlLIO_lstat(file, &PL_statcache); else PL_laststatval = PerlLIO_stat(file, &PL_statcache); @@ -3216,8 +3221,12 @@ PP(pp_ftrread) if (use_access) { #if defined(HAS_ACCESS) || defined (PERL_EFF_ACCESS) - const char *name = SvPV_nolen(*PL_stack_sp); - if (effective) { + STRLEN len; + const char *name = SvPV(*PL_stack_sp, len); + if (!IS_SAFE_PATHNAME(name, len, OP_NAME(PL_op))) { + result = -1; + } + else if (effective) { # ifdef PERL_EFF_ACCESS result = PERL_EFF_ACCESS(name, access_mode); # else @@ -3542,10 +3551,18 @@ PP(pp_fttext) } else { const char *file; + const char *temp; + STRLEN temp_len; int fd; assert(sv); - sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv)); + temp = SvPV_nomg_const(sv, temp_len); + sv_setpv(PL_statname, temp); + if (!IS_SAFE_PATHNAME(temp, temp_len, OP_NAME(PL_op))) { + PL_laststatval = -1; + PL_laststype = OP_STAT; + FT_RETURNUNDEF; + } really_filename: file = SvPVX_const(PL_statname); PL_statgv = NULL; diff --git a/t/lib/warnings/pp_sys b/t/lib/warnings/pp_sys index 337defd..90d3cc7 100644 --- a/t/lib/warnings/pp_sys +++ b/t/lib/warnings/pp_sys @@ -913,3 +913,17 @@ close $fh; unlink $file; EXPECT syswrite() is deprecated on :utf8 handles. This will be a fatal error in Perl 5.30 at - line 5. +######## +# NAME stat on name with \0 +use warnings; +my @x = stat("./\0-"); +my @y = lstat("./\0-"); +-T ".\0-"; +-x ".\0-"; +-l ".\0-"; +EXPECT +Invalid \0 character in pathname for stat: ./\0- at - line 2. +Invalid \0 character in pathname for lstat: ./\0- at - line 3. +Invalid \0 character in pathname for fttext: .\0- at - line 4. +Invalid \0 character in pathname for fteexec: .\0- at - line 5. +Invalid \0 character in pathname for ftlink: .\0- at - line 6. diff --git a/t/op/filetest.t b/t/op/filetest.t index 8883381..bd1d08c 100644 --- a/t/op/filetest.t +++ b/t/op/filetest.t @@ -9,7 +9,7 @@ BEGIN { set_up_inc(qw '../lib ../cpan/Perl-OSType/lib'); } -plan(tests => 53 + 27*14); +plan(tests => 57 + 27*14); if ($^O =~ /MSWin32|cygwin|msys/ && !is_miniperl) { require Win32; # for IsAdminUser() @@ -393,3 +393,11 @@ SKIP: { is $failed_stat2, $failed_stat1, 'failed -r($gv_with_io_but_no_fp) with and w/out fatal warnings'; } + +{ + # [perl #131895] stat() doesn't fail on filenames containing \0 / NUL + ok(!-T "TEST\0-", '-T on name with \0'); + ok(!-B "TEST\0-", '-B on name with \0'); + ok(!-f "TEST\0-", '-f on name with \0'); + ok(!-r "TEST\0-", '-r on name with \0'); +} diff --git a/t/op/stat.t b/t/op/stat.t index 48b659b..f93f21d 100644 --- a/t/op/stat.t +++ b/t/op/stat.t @@ -25,7 +25,7 @@ if ($^O eq 'MSWin32') { ${^WIN32_SLOPPY_STAT} = 0; } -plan tests => 108; +plan tests => 110; my $Perl = which_perl(); @@ -626,6 +626,16 @@ SKIP: 'stat on an array of valid paths should return ENOENT'; } +# [perl #131895] stat() doesn't fail on filenames containing \0 / NUL +ok !stat("TEST\0-"), 'stat on filename with \0'; +SKIP: { + my $link = "TEST.symlink.$$"; + my $can_symlink = eval { symlink "TEST", $link }; + skip "cannot symlink", 1 unless $can_symlink; + ok !lstat("$link\0-"), 'lstat on filename with \0'; + unlink $link; +} + END { chmod 0666, $tmpfile; unlink_all $tmpfile; -- 2.1.4


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