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

stat() doesn't fail on filenames containing \0 / NUL #16115

Closed
p5pRT opened this issue Aug 14, 2017 · 9 comments
Closed

stat() doesn't fail on filenames containing \0 / NUL #16115

p5pRT opened this issue Aug 14, 2017 · 9 comments

Comments

@p5pRT
Copy link

p5pRT commented Aug 14, 2017

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

Searchable as RT131895$

@p5pRT
Copy link
Author

p5pRT commented Aug 14, 2017

From @mauke

Created by @mauke

$ 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().

Perl Info

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

@p5pRT
Copy link
Author

p5pRT commented Aug 21, 2017

From @tonycoz

On Mon, 14 Aug 2017 13​:39​:41 -0700, mauke- wrote​:

$ 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

@p5pRT
Copy link
Author

p5pRT commented Aug 21, 2017

From @tonycoz

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

@p5pRT
Copy link
Author

p5pRT commented Aug 21, 2017

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

@p5pRT
Copy link
Author

p5pRT commented Nov 2, 2017

From zefram@fysh.org

Tony Cook via RT wrote​:

How about the attached?

LGTM. Applied as a155eb0.

-zefram

@p5pRT
Copy link
Author

p5pRT commented Nov 15, 2017

@xsawyerx - Status changed from 'open' to 'resolved'

@p5pRT
Copy link
Author

p5pRT commented Nov 15, 2017

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

@p5pRT
Copy link
Author

p5pRT commented Jun 23, 2018

From @khwilliamson

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

With the release yesterday of Perl 5.28.0, this and 185 other issues have been
resolved.

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

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

@p5pRT
Copy link
Author

p5pRT commented Jun 23, 2018

@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