From 1f7cdc64d9d97de2396234a8c7981eab14e5d572 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= Date: Tue, 9 Jan 2018 15:17:11 +0100 Subject: [PATCH] Fix an overflow when parsing a character range with no preceding character --- ...5-fail-stat-on-names-with-0-embedded.patch | 223 ++++++++++++++++++ perl.spec | 8 + 2 files changed, 231 insertions(+) create mode 100644 perl-5.26.1-perl-131895-fail-stat-on-names-with-0-embedded.patch diff --git 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 new file mode 100644 index 0000000..d9aba47 --- /dev/null +++ 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 +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ř +--- + 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 + diff --git a/perl.spec b/perl.spec index dcc36ee..0a7ad73 100644 --- 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 - 4:5.26.1-401 - Update perl(:MODULE_COMPAT)