You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
224 lines
7.1 KiB
224 lines
7.1 KiB
From 9a4826e0881f8c5498a0fd5f24ed2a0fefb771b7 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.24.3.
|
|
|
|
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 6704862..2792c66 100644
|
|
--- a/doio.c
|
|
+++ b/doio.c
|
|
@@ -1458,7 +1458,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;
|
|
@@ -1472,9 +1472,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");
|
|
@@ -1491,6 +1496,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) {
|
|
@@ -1534,9 +1540,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 bd55043..1a72e60 100644
|
|
--- a/pp_sys.c
|
|
+++ b/pp_sys.c
|
|
@@ -2927,19 +2927,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);
|
|
@@ -3175,8 +3180,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
|
|
@@ -3501,10 +3510,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 6338964..ded5d7d 100644
|
|
--- a/t/lib/warnings/pp_sys
|
|
+++ b/t/lib/warnings/pp_sys
|
|
@@ -962,3 +962,17 @@ close $fh;
|
|
unlink $file;
|
|
EXPECT
|
|
syswrite() is deprecated on :utf8 handles at - line 6.
|
|
+########
|
|
+# 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 637a902..71193ad 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();
|
|
|
|
@@ -651,6 +651,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
|
|
|