In perl.git, the branch blead has been updated <https://perl5.git.perl.org/perl.git/commitdiff/a155eb055a920e456f1b3a516de544bdf104322e?hp=f5727a1c71878a34f6255eb1a506c0b21af7d36f>
- Log ----------------------------------------------------------------- commit a155eb055a920e456f1b3a516de544bdf104322e Author: Tony Cook <[email protected]> Date: Thu Nov 2 20:18:56 2017 +0000 (perl #131895) fail stat on names with \0 embedded Also lstat() and the file test ops. ----------------------------------------------------------------------- Summary of changes: doio.c | 21 ++++++++++++++++----- pod/perldelta.pod | 6 ++++++ pp_sys.c | 29 +++++++++++++++++++++++------ t/lib/warnings/pp_sys | 14 ++++++++++++++ t/op/filetest.t | 10 +++++++++- t/op/stat.t | 12 +++++++++++- 6 files changed, 79 insertions(+), 13 deletions(-) diff --git a/doio.c b/doio.c index ebcf1b13d3..6931346940 100644 --- a/doio.c +++ b/doio.c @@ -1808,7 +1808,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; @@ -1822,9 +1822,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"); @@ -1841,6 +1846,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) { @@ -1884,9 +1890,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/pod/perldelta.pod b/pod/perldelta.pod index a86e290fd9..a8f029cf45 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -444,6 +444,12 @@ files in F<ext/> and F<lib/> are best summarized in L</Modules and Pragmata>. =item * +C<stat()>, C<lstat()>, and file test operators now fail if given a +filename containing a nul character, in the same way that C<open()> +already fails. + +=item * + The in-place reverse optimisation now correctly strengthens weak references using the L<C<sv_rvunweaken()>|perlapi/sv_rvunweaken> API function. diff --git a/pp_sys.c b/pp_sys.c index a41b1880fe..672e7de08e 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -2952,19 +2952,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); @@ -3198,8 +3203,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 @@ -3524,10 +3533,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 337defdb5e..90d3cc790d 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 8883381f94..bd1d08c298 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 48b659b2e1..f93f21deb6 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; -- Perl5 Master Repository
