Fix an overflow when parsing a character range with no preceding character

2018-01-09 15:17:11 +01:00 · 2018-01-09 15:17:11 +01:00 · 1f7cdc64d9
commit 1f7cdc64d9
parent 0f64d90212
2 changed files with 231 additions and 0 deletions
--- a/perl-5.26.1-perl-131895-fail-stat-on-names-with-0-embedded.patch
+++ b/perl-5.26.1-perl-131895-fail-stat-on-names-with-0-embedded.patch
@ -0,0 +1,223 @@
+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
+
--- a/perl.spec
+++ b/perl.spec
@ -218,6 +218,10 @@ Patch64:        perl-5.26.1-perl-132245-don-t-try-to-process-a-char-range-with-n
 # Fix walking symbol table for ISA in Carp, in upstream after 5.27.5
 Patch65:        perl-5.27.5-Carp-Don-t-choke-on-ISA-constant.patch

+# Fix handling file names with null bytes in stat and lstat functions,
+# RT#131895, in upstream after 5.27.5
+Patch66:        perl-5.26.1-perl-131895-fail-stat-on-names-with-0-embedded.patch
+
 # Link XS modules to libperl.so with EU::CBuilder on Linux, bug #960048
 Patch200:       perl-5.16.3-Link-XS-modules-to-libperl.so-with-EU-CBuilder-on-Li.patch

@ -2798,6 +2802,7 @@ Perl extension for Version Objects
 %patch63 -p1
 %patch64 -p1
 %patch65 -p1
+%patch66 -p1
 %patch200 -p1
 %patch201 -p1

@ -2837,6 +2842,7 @@ perl -x patchlevel.h \
    'Fedora Patch63: Fix a crash when a match for inversely repeated group fails (RT#132017)' \
    'Fedora Patch64: Fix an overflow when parsing a character range with no preceding character (RT#132245)' \
    'Fedora Patch65: Fix walking symbol table for ISA in Carp' \
+    'Fedora Patch66: Fix handling file names with null bytes in stat and lstat functions (RT#131895)' \
    'Fedora Patch200: Link XS modules to libperl.so with EU::CBuilder on Linux' \
    'Fedora Patch201: Link XS modules to libperl.so with EU::MM on Linux' \
    %{nil}
@ -5128,6 +5134,8 @@ popd
 - Fix an overflow when parsing a character range with no preceding character
  (RT#132245)
 - Fix walking symbol table for ISA in Carp
+- Fix handling file names with null bytes in stat and lstat functions
+  (RT#131895)

 * Mon Sep 25 2017 Jitka Plesnikova <jplesnik@redhat.com> - 4:5.26.1-401
 - Update perl(:MODULE_COMPAT)