From 4ac7295514f35016a79dbcc07500f6c9ca4729b7 Mon Sep 17 00:00:00 2001

From: Tony Cook <tony@develop-help.com>

Date: Thu, 2 Nov 2017 20:18:56 +0000

Subject: [PATCH] (perl #131895) fail stat on names with \0 embedded

MIME-Version: 1.0

Content-Type: text/plain; charset=UTF-8

Content-Transfer-Encoding: 8bit

Also lstat() and the file test ops.

Petr Písař: Port to 5.26.1.

Signed-off-by: Petr Písař <ppisar@redhat.com>

---

 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 becb19b..70d7747 100644

--- a/doio.c

+++ b/doio.c

@@ -1466,7 +1466,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;

@@ -1480,9 +1480,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");

@@ -1499,6 +1504,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) {

@@ -1542,9 +1548,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 0b60584..1b81fda 100644

--- a/pp_sys.c

+++ b/pp_sys.c

@@ -2963,19 +2963,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);

@@ -3211,8 +3216,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

@@ -3537,10 +3546,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 9c544e0..c599aa3 100644

--- a/t/lib/warnings/pp_sys

+++ b/t/lib/warnings/pp_sys

@@ -972,3 +972,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 323c498..dbbe6ec 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 => 118;

+plan tests => 120;

 my $Perl = which_perl();

@@ -653,6 +653,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.13.6