diffstat of debian/ for perl_5.22.1-9 perl_5.22.1-9ubuntu0.5 changelog | 52 ++++++++++++ control | 3 patches/fixes/CVE-2016-6185.patch | 120 +++++++++++++++++++++++++++++ patches/fixes/CVE-2017-12837.patch | 19 ++++ patches/fixes/CVE-2017-12883.patch | 33 ++++++++ patches/fixes/CVE-2017-6512-pre.patch | 52 ++++++++++++ patches/fixes/CVE-2017-6512.patch | 95 +++++++++++++++++++++++ patches/fixes/CVE-2018-12015.patch | 39 +++++++++ patches/fixes/CVE-2018-6797.patch | 36 ++++++++ patches/fixes/CVE-2018-6798-1.patch | 122 +++++++++++++++++++++++++++++ patches/fixes/CVE-2018-6798-2.patch | 77 ++++++++++++++++++ patches/fixes/CVE-2018-6798-3.patch | 27 ++++++ patches/fixes/CVE-2018-6913.patch | 139 ++++++++++++++++++++++++++++++++++ patches/series | 11 ++ 14 files changed, 824 insertions(+), 1 deletion(-) diff -Nru perl-5.22.1/debian/changelog perl-5.22.1/debian/changelog --- perl-5.22.1/debian/changelog 2016-03-13 11:54:20.000000000 +0000 +++ perl-5.22.1/debian/changelog 2018-06-13 12:22:39.000000000 +0000 @@ -1,3 +1,55 @@ +perl (5.22.1-9ubuntu0.5) xenial-security; urgency=medium + + * SECURITY UPDATE: Directory traversal vulnerability + - debian/patches/fixes/CVE-2018-12015.patch: fix ing + cpan/Archive-Tar/lib/Archive/Tar.pm. + - CVE-2018-12015 + + -- Leonidas S. Barbosa Tue, 12 Jun 2018 16:30:44 -0300 + +perl (5.22.1-9ubuntu0.3) xenial-security; urgency=medium + + * SECURITY UPDATE: arbitrary code exec via library in cwd + - debian/patches/fixes/CVE-2016-6185.patch: properly handle paths in + dist/XSLoader/XSLoader_pm.PL, dist/XSLoader/t/XSLoader.t. + - CVE-2016-6185 + * SECURITY UPDATE: race condition in rmtree and remove_tree + - debian/patches/fixes/CVE-2017-6512-pre.patch: correct the order of + tests of chmod() in cpan/ExtUtils-Command/t/eu_command.t. + - debian/patches/fixes/CVE-2017-6512.patch: prevent race in + cpan/File-Path/lib/File/Path.pm, cpan/File-Path/t/Path.t. + - CVE-2017-6512 + * SECURITY UPDATE: heap write overflow bug + - debian/patches/fixes/CVE-2018-6797.patch: restart a node if we change + to uni rules within the node and encounter a sharp S in regcomp.c. + - CVE-2018-6797 + * SECURITY UPDATE: heap read overflow bug + - debian/patches/fixes/CVE-2018-6798-1.patch: check lengths in + regexec.c, t/lib/warnings/regexec. + - debian/patches/fixes/CVE-2018-6798-2.patch: account for non-utf8 + target in regexec.c, t/re/re_tests. + - debian/patches/fixes/CVE-2018-6798-3.patch: no longer warns in + t/lib/warnings/regexec. + - CVE-2018-6798 + * SECURITY UPDATE: heap buffer overflow bug + - debian/patches/fixes/CVE-2018-6913.patch: fix various space + calculation issues in pp_pack.c, t/op/pack.t. + - CVE-2018-6913 + + -- Marc Deslauriers Thu, 05 Apr 2018 08:48:47 -0400 + +perl (5.22.1-9ubuntu0.2) xenial-security; urgency=medium + + * SECURITY UPDATE: Buffer overflow via crafted regular expressiion + - debian/patches/fixes/CVE-2017-12883.patch: fix crafted expression + with invalid '\N{U+...}' escape in regcomp.c + - CVE-2017-12883 + * SECURITY UPDATE: heap-based buffer overflow in S_regatom + - debian/patches/fixes/CVE-2017-12837.patch: fix issue in regcomp.c + - CVE-2017-12837 + + -- Leonidas S. Barbosa Fri, 10 Nov 2017 11:39:06 -0300 + perl (5.22.1-9) unstable; urgency=medium * Add cross build support files for alpha, hppa, sparc64, x32, mips, diff -Nru perl-5.22.1/debian/control perl-5.22.1/debian/control --- perl-5.22.1/debian/control 2016-03-13 11:27:12.000000000 +0000 +++ perl-5.22.1/debian/control 2017-11-10 13:49:58.000000000 +0000 @@ -1,7 +1,8 @@ Source: perl Section: perl Priority: standard -Maintainer: Niko Tyni +Maintainer: Ubuntu Developers +XSBC-Original-Maintainer: Niko Tyni Uploaders: Dominic Hargreaves Standards-Version: 3.9.6 Homepage: http://dev.perl.org/perl5/ diff -Nru perl-5.22.1/debian/patches/fixes/CVE-2016-6185.patch perl-5.22.1/debian/patches/fixes/CVE-2016-6185.patch --- perl-5.22.1/debian/patches/fixes/CVE-2016-6185.patch 1970-01-01 00:00:00.000000000 +0000 +++ perl-5.22.1/debian/patches/fixes/CVE-2016-6185.patch 2018-04-05 12:34:02.000000000 +0000 @@ -0,0 +1,120 @@ +From 08e3451d7b3b714ad63a27f1b9c2a23ee75d15ee Mon Sep 17 00:00:00 2001 +From: Father Chrysostomos +Date: Sat, 2 Jul 2016 22:56:51 -0700 +Subject: [PATCH] =?utf8?q?Don=E2=80=99t=20let=20XSLoader=20load=20relative?= + =?utf8?q?=20paths?= +MIME-Version: 1.0 +Content-Type: text/plain; charset=utf8 +Content-Transfer-Encoding: 8bit + +[rt.cpan.org #115808] + +The logic in XSLoader for determining the library goes like this: + + my $c = () = split(/::/,$caller,-1); + $modlibname =~ s,[\\/][^\\/]+$,, while $c--; # Q&D basename + my $file = "$modlibname/auto/$modpname/$modfname.bundle"; + +(That last line varies by platform.) + +$caller is the calling package. $modlibname is the calling file. It +removes as many path segments from $modlibname as there are segments +in $caller. So if you have Foo/Bar/XS.pm calling XSLoader from the +Foo::Bar package, the $modlibname will end up containing the path in +@INC where XS.pm was found, followed by "/Foo". Usually the fallback +to Dynaloader::bootstrap_inherit, which does an @INC search, makes +things Just Work. + +But if our hypothetical Foo/Bar/XS.pm actually calls +XSLoader::load from inside a string eval, then path ends up being +"(eval 1)/auto/Foo/Bar/Bar.bundle". + +So if someone creates a directory named ‘(eval 1)’ with a naughty +binary file in it, it will be loaded if a script using Foo::Bar is run +in the parent directory. + +This commit makes XSLoader fall back to Dynaloader’s @INC search if +the calling file has a relative path that is not found in @INC. +--- + dist/XSLoader/XSLoader_pm.PL | 25 +++++++++++++++++++++++++ + dist/XSLoader/t/XSLoader.t | 27 ++++++++++++++++++++++++++- + 2 files changed, 51 insertions(+), 1 deletion(-) + +Index: perl-5.22.1/dist/XSLoader/XSLoader_pm.PL +=================================================================== +--- perl-5.22.1.orig/dist/XSLoader/XSLoader_pm.PL 2018-04-05 08:33:59.678042050 -0400 ++++ perl-5.22.1/dist/XSLoader/XSLoader_pm.PL 2018-04-05 08:33:59.674042039 -0400 +@@ -90,6 +90,31 @@ print OUT <<'EOT'; + my $modpname = join('/',@modparts); + my $c = () = split(/::/,$caller,-1); + $modlibname =~ s,[\\/][^\\/]+$,, while $c--; # Q&D basename ++ # Does this look like a relative path? ++ if ($modlibname !~ m|^[\\/]|) { ++ # Someone may have a #line directive that changes the file name, or ++ # may be calling XSLoader::load from inside a string eval. We cer- ++ # tainly do not want to go loading some code that is not in @INC, ++ # as it could be untrusted. ++ # ++ # We could just fall back to DynaLoader here, but then the rest of ++ # this function would go untested in the perl core, since all @INC ++ # paths are relative during testing. That would be a time bomb ++ # waiting to happen, since bugs could be introduced into the code. ++ # ++ # So look through @INC to see if $modlibname is in it. A rela- ++ # tive $modlibname is not a common occurrence, so this block is ++ # not hot code. ++ FOUND: { ++ for (@INC) { ++ if ($_ eq $modlibname) { ++ last FOUND; ++ } ++ } ++ # Not found. Fall back to DynaLoader. ++ goto \&XSLoader::bootstrap_inherit; ++ } ++ } + EOT + + my $dl_dlext = quotemeta($Config::Config{'dlext'}); +Index: perl-5.22.1/dist/XSLoader/t/XSLoader.t +=================================================================== +--- perl-5.22.1.orig/dist/XSLoader/t/XSLoader.t 2018-04-05 08:33:59.678042050 -0400 ++++ perl-5.22.1/dist/XSLoader/t/XSLoader.t 2018-04-05 08:33:59.674042039 -0400 +@@ -33,7 +33,7 @@ my %modules = ( + 'Time::HiRes'=> q| ::can_ok( 'Time::HiRes' => 'usleep' ) |, # 5.7.3 + ); + +-plan tests => keys(%modules) * 3 + 9; ++plan tests => keys(%modules) * 3 + 10; + + # Try to load the module + use_ok( 'XSLoader' ); +@@ -125,3 +125,28 @@ XSLoader::load("Devel::Peek"); + EOS + or ::diag $@; + } ++ ++SKIP: { ++ skip "File::Path not available", 1 ++ unless eval { require File::Path }; ++ my $name = "phooo$$"; ++ File::Path::make_path("$name/auto/Foo/Bar"); ++ open my $fh, ++ ">$name/auto/Foo/Bar/Bar.$Config::Config{'dlext'}"; ++ close $fh; ++ my $fell_back; ++ local *XSLoader::bootstrap_inherit = sub { ++ $fell_back++; ++ # Break out of the calling subs ++ goto the_test; ++ }; ++ eval < +Date: Wed, 21 Jun 2017 11:33:37 -0600 +Subject: [PATCH] regcomp [perl #131582] + +diff --git a/regcomp.c b/regcomp.c +index 49644d7..e906072 100644 +--- a/regcomp.c ++++ b/regcomp.c +@@ -12380,6 +12380,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) + goto loopdone; + } + p = RExC_parse; ++ RExC_parse = parse_start; + if (ender > 0xff) { + REQUIRE_UTF8; + } diff -Nru perl-5.22.1/debian/patches/fixes/CVE-2017-12883.patch perl-5.22.1/debian/patches/fixes/CVE-2017-12883.patch --- perl-5.22.1/debian/patches/fixes/CVE-2017-12883.patch 1970-01-01 00:00:00.000000000 +0000 +++ perl-5.22.1/debian/patches/fixes/CVE-2017-12883.patch 2017-11-10 13:47:30.000000000 +0000 @@ -0,0 +1,33 @@ +Backport of: + +From 2be4edede4ae226e2eebd4eff28cedd2041f300f Mon Sep 17 00:00:00 2001 +From: Karl Williamson +Date: Fri, 25 Aug 2017 11:33:58 -0600 +Subject: [PATCH] PATCH: [perl #131598] + +The cause of this is that the vFAIL macro uses RExC_parse, and that +variable has just been changed in preparation for code after the vFAIL. +The solution is to not change RExC_parse until after the vFAIL. + +This is a case where the macro hides stuff that can bite you. +diff --git a/regcomp.c b/regcomp.c +index 49644d7..d21ebf5 100644 +--- a/regcomp.c ++++ b/regcomp.c +@@ -11296,13 +11296,15 @@ S_grok_bslash_N(pTHX_ RExC_state_t *pRExC_state, + } + sv_catpv(substitute_parse, ")"); + +- RExC_parse = SvPV(substitute_parse, len); ++ len = SvCUR(substitute_parse); + + /* Don't allow empty number */ + if (len < (STRLEN) 8) { + RExC_parse = endbrace; + vFAIL("Invalid hexadecimal number in \\N{U+...}"); + } ++ RExC_parse = SvPV_nolen(substitute_parse); ++ + RExC_end = RExC_parse + len; + + /* The values are Unicode, and therefore not subject to recoding, but diff -Nru perl-5.22.1/debian/patches/fixes/CVE-2017-6512-pre.patch perl-5.22.1/debian/patches/fixes/CVE-2017-6512-pre.patch --- perl-5.22.1/debian/patches/fixes/CVE-2017-6512-pre.patch 1970-01-01 00:00:00.000000000 +0000 +++ perl-5.22.1/debian/patches/fixes/CVE-2017-6512-pre.patch 2018-04-05 14:45:04.000000000 +0000 @@ -0,0 +1,52 @@ +From 6cf7ffa72ab3e7aaba668288cd63c8185a55de68 Mon Sep 17 00:00:00 2001 +From: James E Keenan +Date: Thu, 11 May 2017 04:23:40 -0400 +Subject: [PATCH] Correct the order of tests of chmod(). (#294) + +Per code review by haarg, the order of tests was wrong in the first place. +Hence, correctly re-ordering them is a better repair than changing one test's +description. + +For: https://github.com/Perl-Toolchain-Gang/ExtUtils-MakeMaker/pull/294 + +[Debian note: this is a prerequisite for the CVE-2017-6512 fix in +File-Path, and was backported by Dominic Hargreaves] + +Bug: https://github.com/Perl-Toolchain-Gang/ExtUtils-MakeMaker/pull/294 +Patch-Name: fixes/extutils_file_path_compat.diff +--- + dist/ExtUtils-Command/t/eu_command.t | 13 +++++++------ + 1 file changed, 7 insertions(+), 6 deletions(-) + +diff --git a/cpan/ExtUtils-Command/t/eu_command.t b/cpan/ExtUtils-Command/t/eu_command.t +index aa9fcb80b..8ec142d32 100644 +--- a/cpan/ExtUtils-Command/t/eu_command.t ++++ b/cpan/ExtUtils-Command/t/eu_command.t +@@ -151,20 +151,21 @@ BEGIN { + is( ((stat('testdir'))[2] & 07777) & 0700, + 0100, 'change a dir to execute-only' ); + +- # change a dir to read-only +- @ARGV = ( '0400', 'testdir' ); ++ # change a dir to write-only ++ @ARGV = ( '0200', 'testdir' ); + ExtUtils::Command::chmod(); + + is( ((stat('testdir'))[2] & 07777) & 0700, +- 0400, 'change a dir to read-only' ); ++ 0200, 'change a dir to write-only' ); + +- # change a dir to write-only +- @ARGV = ( '0200', 'testdir' ); ++ # change a dir to read-only ++ @ARGV = ( '0400', 'testdir' ); + ExtUtils::Command::chmod(); + + is( ((stat('testdir'))[2] & 07777) & 0700, +- 0200, 'change a dir to write-only' ); ++ 0400, 'change a dir to read-only' ); + ++ # remove the dir we've been playing with + @ARGV = ('testdir'); + rm_rf; + ok( ! -e 'testdir', 'rm_rf can delete a read-only dir' ); diff -Nru perl-5.22.1/debian/patches/fixes/CVE-2017-6512.patch perl-5.22.1/debian/patches/fixes/CVE-2017-6512.patch --- perl-5.22.1/debian/patches/fixes/CVE-2017-6512.patch 1970-01-01 00:00:00.000000000 +0000 +++ perl-5.22.1/debian/patches/fixes/CVE-2017-6512.patch 2018-04-05 12:34:06.000000000 +0000 @@ -0,0 +1,95 @@ +From 2f154f3e5dd7fda13f2d920993cdeb70c1da4443 Mon Sep 17 00:00:00 2001 +From: John Lightsey +Date: Tue, 2 May 2017 12:03:52 -0500 +Subject: Prevent directory chmod race attack. + +CVE-2017-6512 is a race condition attack where the chmod() of directories +that cannot be entered is misused to change the permissions on other +files or directories on the system. This has been corrected by limiting +the directory-permission loosening logic to systems where fchmod() is +supported. + +[Backported to File-Path 2.09 / perl 5.20 by Dominic Hargreaves for Debian.] + +Bug: https://rt.cpan.org/Public/Bug/Display.html?id=121951 +Bug-Debian: https://bugs.debian.org/863870 +Patch-Name: fixes/file_path_chmod_race.diff +--- + cpan/File-Path/lib/File/Path.pm | 20 ++++++++++++++------ + cpan/File-Path/t/Path.t | 24 +++++++++++++++++------- + 2 files changed, 31 insertions(+), 13 deletions(-) + +diff --git a/cpan/File-Path/lib/File/Path.pm b/cpan/File-Path/lib/File/Path.pm +index 23751d5fa..0ea6671c7 100644 +--- a/cpan/File-Path/lib/File/Path.pm ++++ b/cpan/File-Path/lib/File/Path.pm +@@ -284,13 +284,21 @@ sub _rmtree { + if (!chdir($root)) { + # see if we can escalate privileges to get in + # (e.g. funny protection mask such as -w- instead of rwx) +- $perm &= 07777; +- my $nperm = $perm | 0700; +- if (!($arg->{safe} or $nperm == $perm or chmod($nperm, $root))) { +- _error($arg, "cannot make child directory read-write-exec", $canon); +- next ROOT_DIR; ++ # This uses fchmod to avoid traversing outside of the proper ++ # location (CVE-2017-6512) ++ my $root_fh; ++ if (open($root_fh, '<', $root)) { ++ my ($fh_dev, $fh_inode) = (stat $root_fh )[0,1]; ++ $perm &= 07777; ++ my $nperm = $perm | 0700; ++ local $@; ++ if (!($arg->{safe} or $nperm == $perm or !-d _ or $fh_dev ne $ldev or $fh_inode ne $lino or eval { chmod( $nperm, $root_fh ) } )) { ++ _error($arg, "cannot make child directory read-write-exec", $canon); ++ next ROOT_DIR; ++ } ++ close $root_fh; + } +- elsif (!chdir($root)) { ++ if (!chdir($root)) { + _error($arg, "cannot chdir to child", $canon); + next ROOT_DIR; + } +diff --git a/cpan/File-Path/t/Path.t b/cpan/File-Path/t/Path.t +index a33c15a23..b6df00a9a 100644 +--- a/cpan/File-Path/t/Path.t ++++ b/cpan/File-Path/t/Path.t +@@ -16,6 +16,13 @@ my $has_Test_Output = $@ ? 0 : 1; + + my $Is_VMS = $^O eq 'VMS'; + ++my $fchmod_supported = 0; ++if (open my $fh, curdir()) { ++ my ($perm) = (stat($fh))[2]; ++ $perm &= 07777; ++ eval { $fchmod_supported = chmod( $perm, $fh); }; ++} ++ + # first check for stupid permissions second for full, so we clean up + # behind ourselves + for my $perm (0111,0777) { +@@ -258,13 +265,16 @@ is(scalar(@created), 1, "created directory (old style 3 mode undef)"); + is($created[0], $dir, "created directory (old style 3 mode undef) cross-check"); + is(rmtree($dir, 0, undef), 1, "removed directory 3 verbose undef"); + +-$dir = catdir($tmp_base,'G'); +-$dir = VMS::Filespec::unixify($dir) if $Is_VMS; +- +-@created = mkpath($dir, undef, 0200); +-is(scalar(@created), 1, "created write-only dir"); +-is($created[0], $dir, "created write-only directory cross-check"); +-is(rmtree($dir), 1, "removed write-only dir"); ++SKIP: { ++ skip "fchmod of directories not supported on this platform", 3 unless $fchmod_supported; ++ $dir = catdir($tmp_base,'G'); ++ $dir = VMS::Filespec::unixify($dir) if $Is_VMS; ++ ++ @created = mkpath($dir, undef, 0400); ++ is(scalar(@created), 1, "created read-only dir"); ++ is($created[0], $dir, "created read-only directory cross-check"); ++ is(rmtree($dir), 1, "removed read-only dir"); ++} + + # borderline new-style heuristics + if (chdir $tmp_base) { diff -Nru perl-5.22.1/debian/patches/fixes/CVE-2018-12015.patch perl-5.22.1/debian/patches/fixes/CVE-2018-12015.patch --- perl-5.22.1/debian/patches/fixes/CVE-2018-12015.patch 1970-01-01 00:00:00.000000000 +0000 +++ perl-5.22.1/debian/patches/fixes/CVE-2018-12015.patch 2018-06-12 19:30:35.000000000 +0000 @@ -0,0 +1,39 @@ +Backported of: + +From ae65651eab053fc6dc4590dbb863a268215c1fc5 Mon Sep 17 00:00:00 2001 +From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= +Date: Fri, 8 Jun 2018 11:45:40 +0100 +Subject: [PATCH] [PATCH] Remove existing files before overwriting them + +Archive should extract only the latest same-named entry. +Extracted regular file should not be writtent into existing block +device (or any other one). + +https://rt.cpan.org/Ticket/Display.html?id=125523 + +Signed-off-by: Chris 'BinGOs' Williams +Index: perl-5.26.0/cpan/Archive-Tar/lib/Archive/Tar.pm +=================================================================== +--- perl-5.26.0.orig/cpan/Archive-Tar/lib/Archive/Tar.pm ++++ perl-5.26.0/cpan/Archive-Tar/lib/Archive/Tar.pm +@@ -845,6 +845,20 @@ sub _extract_file { + return; + } + ++ ### If a file system already contains a block device with the same name as ++ ### the being extracted regular file, we would write the file's content ++ ### to the block device. So remove the existing file (block device) now. ++ ### If an archive contains multiple same-named entries, the last one ++ ### should replace the previous ones. So remove the old file now. ++ ### If the old entry is a symlink to a file outside of the CWD, the new ++ ### entry would create a file there. This is CVE-2018-12015 ++ ### . ++ if (-l $full || -e _) { ++ if (!unlink $full) { ++ $self->_error( qq[Could not remove old file '$full': $!] ); ++ return; ++ } ++ } + if( length $entry->type && $entry->is_file ) { + my $fh = IO::File->new; + $fh->open( '>' . $full ) or ( diff -Nru perl-5.22.1/debian/patches/fixes/CVE-2018-6797.patch perl-5.22.1/debian/patches/fixes/CVE-2018-6797.patch --- perl-5.22.1/debian/patches/fixes/CVE-2018-6797.patch 1970-01-01 00:00:00.000000000 +0000 +++ perl-5.22.1/debian/patches/fixes/CVE-2018-6797.patch 2018-04-05 12:36:30.000000000 +0000 @@ -0,0 +1,36 @@ +Backport of: + +From e02d7478ebfc399a9d10ba0df60eee217aa7ab8f Mon Sep 17 00:00:00 2001 +From: Karl Williamson +Date: Fri, 2 Feb 2018 15:14:27 -0700 +Subject: (perl #132227) restart a node if we change to uni rules within the + node and encounter a sharp S + +This could lead to a buffer overflow. +--- + regcomp.c | 12 ++++++++++++ + 1 file changed, 12 insertions(+) + +Index: perl-5.22.1/regcomp.c +=================================================================== +--- perl-5.22.1.orig/regcomp.c 2018-04-05 08:34:26.754116373 -0400 ++++ perl-5.22.1/regcomp.c 2018-04-05 08:36:04.470364674 -0400 +@@ -12679,6 +12679,18 @@ S_regatom(pTHX_ RExC_state_t *pRExC_stat + && isALPHA_FOLD_EQ(ender, 's') + && isALPHA_FOLD_EQ(*(s-1), 's')))) + { ++ ++ /* If the node started out having uni rules, we ++ * wouldn't have gotten here. So this means ++ * something in the middle has changed it, but ++ * didn't think it needed to reparse. But this ++ * sharp s now does indicate the need for ++ * reparsing. */ ++ if (RExC_uni_semantics) { ++ p = oldp; ++ goto loopdone; ++ } ++ + maybe_exactfu = FALSE; + } + } diff -Nru perl-5.22.1/debian/patches/fixes/CVE-2018-6798-1.patch perl-5.22.1/debian/patches/fixes/CVE-2018-6798-1.patch --- perl-5.22.1/debian/patches/fixes/CVE-2018-6798-1.patch 1970-01-01 00:00:00.000000000 +0000 +++ perl-5.22.1/debian/patches/fixes/CVE-2018-6798-1.patch 2018-04-05 12:38:26.000000000 +0000 @@ -0,0 +1,122 @@ +Backport of: + +From 29231d73407542051a287cab5e18546e5a622f4a Mon Sep 17 00:00:00 2001 +From: Karl Williamson +Date: Tue, 6 Feb 2018 14:50:48 -0700 +Subject: [perl #132063]: Heap buffer overflow + +The proximal cause is several instances in regexec.c of the code +assuming that the input was valid UTF-8, whereas the input was too short +for what the start byte claimed it would be. + +I grepped through the core for any other similar uses, and did not find +any. +--- + regexec.c | 29 ++++++++++++++++------------- + t/lib/warnings/regexec | 7 +++++++ + 2 files changed, 23 insertions(+), 13 deletions(-) + +Index: perl-5.22.1/regexec.c +=================================================================== +--- perl-5.22.1.orig/regexec.c 2018-04-05 08:37:32.986566119 -0400 ++++ perl-5.22.1/regexec.c 2018-04-05 08:37:32.986566119 -0400 +@@ -1466,7 +1466,9 @@ Perl_re_intuit_start(pTHX_ + ? trie_utf8_fold \ + : trie_latin_utf8_fold))) + +-#define REXEC_TRIE_READ_CHAR(trie_type, trie, widecharmap, uc, uscan, len, uvc, charid, foldlen, foldbuf, uniflags) \ ++/* 'uscan' is set to foldbuf, and incremented, so below the end of uscan is ++ * 'foldbuf+sizeof(foldbuf)' */ ++#define REXEC_TRIE_READ_CHAR(trie_type, trie, widecharmap, uc, uc_end, uscan, len, uvc, charid, foldlen, foldbuf, uniflags) \ + STMT_START { \ + STRLEN skiplen; \ + U8 flags = FOLD_FLAGS_FULL; \ +@@ -1474,7 +1476,7 @@ STMT_START { + case trie_flu8: \ + _CHECK_AND_WARN_PROBLEMATIC_LOCALE; \ + if (utf8_target && UTF8_IS_ABOVE_LATIN1(*uc)) { \ +- _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(uc, uc + UTF8SKIP(uc)); \ ++ _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(uc, uc_end - uc); \ + } \ + goto do_trie_utf8_fold; \ + case trie_utf8_exactfa_fold: \ +@@ -1483,7 +1485,7 @@ STMT_START { + case trie_utf8_fold: \ + do_trie_utf8_fold: \ + if ( foldlen>0 ) { \ +- uvc = utf8n_to_uvchr( (const U8*) uscan, UTF8_MAXLEN, &len, uniflags ); \ ++ uvc = utf8n_to_uvchr( (const U8*) uscan, foldlen, &len, uniflags ); \ + foldlen -= len; \ + uscan += len; \ + len=0; \ +@@ -1500,7 +1502,7 @@ STMT_START { + /* FALLTHROUGH */ \ + case trie_latin_utf8_fold: \ + if ( foldlen>0 ) { \ +- uvc = utf8n_to_uvchr( (const U8*) uscan, UTF8_MAXLEN, &len, uniflags ); \ ++ uvc = utf8n_to_uvchr( (const U8*) uscan, foldlen, &len, uniflags ); \ + foldlen -= len; \ + uscan += len; \ + len=0; \ +@@ -1519,7 +1521,7 @@ STMT_START { + } \ + /* FALLTHROUGH */ \ + case trie_utf8: \ +- uvc = utf8n_to_uvchr( (const U8*) uc, UTF8_MAXLEN, &len, uniflags ); \ ++ uvc = utf8n_to_uvchr( (const U8*) uc, uc_end - uc, &len, uniflags ); \ + break; \ + case trie_plain: \ + uvc = (UV)*uc; \ +@@ -2518,10 +2520,10 @@ S_find_byclass(pTHX_ regexp * prog, cons + } + points[pointpos++ % maxlen]= uc; + if (foldlen || uc < (U8*)strend) { +- REXEC_TRIE_READ_CHAR(trie_type, trie, +- widecharmap, uc, +- uscan, len, uvc, charid, foldlen, +- foldbuf, uniflags); ++ REXEC_TRIE_READ_CHAR(trie_type, trie, widecharmap, uc, ++ (U8 *) strend, uscan, len, uvc, ++ charid, foldlen, foldbuf, ++ uniflags); + DEBUG_TRIE_EXECUTE_r({ + dump_exec_pos( (char *)uc, c, strend, + real_start, s, utf8_target); +@@ -5168,8 +5170,9 @@ S_regmatch(pTHX_ regmatch_info *reginfo, + if ( base && (foldlen || uc < (U8*)(reginfo->strend))) { + I32 offset; + REXEC_TRIE_READ_CHAR(trie_type, trie, widecharmap, uc, +- uscan, len, uvc, charid, foldlen, +- foldbuf, uniflags); ++ (U8 *) reginfo->strend, uscan, ++ len, uvc, charid, foldlen, ++ foldbuf, uniflags); + charcount++; + if (foldlen>0) + ST.longfold = TRUE; +@@ -5302,8 +5305,8 @@ S_regmatch(pTHX_ regmatch_info *reginfo, + while (foldlen) { + if (!--chars) + break; +- uvc = utf8n_to_uvchr(uscan, UTF8_MAXLEN, &len, +- uniflags); ++ uvc = utf8n_to_uvchr(uscan, foldlen, &len, ++ uniflags); + uscan += len; + foldlen -= len; + } +Index: perl-5.22.1/t/lib/warnings/regexec +=================================================================== +--- perl-5.22.1.orig/t/lib/warnings/regexec 2018-04-05 08:37:32.986566119 -0400 ++++ perl-5.22.1/t/lib/warnings/regexec 2018-04-05 08:38:03.554631190 -0400 +@@ -213,3 +213,10 @@ Use of \b{} or \B{} for non-UTF-8 locale + Use of \b{} or \B{} for non-UTF-8 locale is wrong. Assuming a UTF-8 locale at - line 17. + Use of \b{} or \B{} for non-UTF-8 locale is wrong. Assuming a UTF-8 locale at - line 17. + Use of \b{} or \B{} for non-UTF-8 locale is wrong. Assuming a UTF-8 locale at - line 17. ++######## ++# NAME perl #132063, read beyond buffer end ++# OPTION fatal ++"\xff" =~ /(?il)\x{100}|\x{100}/; ++EXPECT ++Malformed UTF-8 character: \xff (too short; 1 byte available, need 13) in pattern match (m//) at - line 2. ++Malformed UTF-8 character (fatal) at - line 2. diff -Nru perl-5.22.1/debian/patches/fixes/CVE-2018-6798-2.patch perl-5.22.1/debian/patches/fixes/CVE-2018-6798-2.patch --- perl-5.22.1/debian/patches/fixes/CVE-2018-6798-2.patch 1970-01-01 00:00:00.000000000 +0000 +++ perl-5.22.1/debian/patches/fixes/CVE-2018-6798-2.patch 2018-04-05 12:39:42.000000000 +0000 @@ -0,0 +1,77 @@ +Backport of: + +From a59dc1f157bd0f626b6b864b9996480f9bac44aa Mon Sep 17 00:00:00 2001 +From: Yves Orton +Date: Mon, 19 Feb 2018 13:49:46 +1100 +Subject: v5.24.3: fix TRIE_READ_CHAR and DECL_TRIE_TYPE to account for + non-utf8 target + +--- + regexec.c | 14 ++++++++++---- + t/re/re_tests | 1 + + 2 files changed, 11 insertions(+), 4 deletions(-) + +Index: perl-5.22.1/regexec.c +=================================================================== +--- perl-5.22.1.orig/regexec.c 2018-04-05 08:38:46.814719737 -0400 ++++ perl-5.22.1/regexec.c 2018-04-05 08:38:46.814719737 -0400 +@@ -1451,7 +1451,7 @@ Perl_re_intuit_start(pTHX_ + #define DECL_TRIE_TYPE(scan) \ + const enum { trie_plain, trie_utf8, trie_utf8_fold, trie_latin_utf8_fold, \ + trie_utf8_exactfa_fold, trie_latin_utf8_exactfa_fold, \ +- trie_utf8l, trie_flu8 } \ ++ trie_utf8l, trie_flu8, trie_flu8_latin } \ + trie_type = ((scan->flags == EXACT) \ + ? (utf8_target ? trie_utf8 : trie_plain) \ + : (scan->flags == EXACTL) \ +@@ -1461,10 +1461,12 @@ Perl_re_intuit_start(pTHX_ + ? trie_utf8_exactfa_fold \ + : trie_latin_utf8_exactfa_fold) \ + : (scan->flags == EXACTFLU8 \ +- ? trie_flu8 \ ++ ? (utf8_target \ ++ ? trie_flu8 \ ++ : trie_flu8_latin) \ + : (utf8_target \ + ? trie_utf8_fold \ +- : trie_latin_utf8_fold))) ++ : trie_latin_utf8_fold))) + + /* 'uscan' is set to foldbuf, and incremented, so below the end of uscan is + * 'foldbuf+sizeof(foldbuf)' */ +@@ -1475,7 +1477,7 @@ STMT_START { + switch (trie_type) { \ + case trie_flu8: \ + _CHECK_AND_WARN_PROBLEMATIC_LOCALE; \ +- if (utf8_target && UTF8_IS_ABOVE_LATIN1(*uc)) { \ ++ if (UTF8_IS_ABOVE_LATIN1(*uc)) { \ + _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(uc, uc_end - uc); \ + } \ + goto do_trie_utf8_fold; \ +@@ -1497,10 +1499,14 @@ STMT_START { + uscan = foldbuf + skiplen; \ + } \ + break; \ ++ case trie_flu8_latin: \ ++ _CHECK_AND_WARN_PROBLEMATIC_LOCALE; \ ++ goto do_trie_latin_utf8_fold; \ + case trie_latin_utf8_exactfa_fold: \ + flags |= FOLD_FLAGS_NOMIX_ASCII; \ + /* FALLTHROUGH */ \ + case trie_latin_utf8_fold: \ ++ do_trie_latin_utf8_fold: \ + if ( foldlen>0 ) { \ + uvc = utf8n_to_uvchr( (const U8*) uscan, foldlen, &len, uniflags ); \ + foldlen -= len; \ +Index: perl-5.22.1/t/re/re_tests +=================================================================== +--- perl-5.22.1.orig/t/re/re_tests 2018-04-05 08:38:46.814719737 -0400 ++++ perl-5.22.1/t/re/re_tests 2018-04-05 08:39:17.318779840 -0400 +@@ -1938,6 +1938,6 @@ A+(*PRUNE)BC(?{}) AAABC y $& AAABC + (?a-x - c - Sequence (?... not terminated + .{1}?? - c - Nested quantifiers + .{1}?+ - c - Nested quantifiers +- ++(?il)\x{100}|\x{100}|\x{FF} \xFF y $& \xFF + # Keep these lines at the end of the file + # vim: softtabstop=0 noexpandtab diff -Nru perl-5.22.1/debian/patches/fixes/CVE-2018-6798-3.patch perl-5.22.1/debian/patches/fixes/CVE-2018-6798-3.patch --- perl-5.22.1/debian/patches/fixes/CVE-2018-6798-3.patch 1970-01-01 00:00:00.000000000 +0000 +++ perl-5.22.1/debian/patches/fixes/CVE-2018-6798-3.patch 2018-04-05 12:46:10.000000000 +0000 @@ -0,0 +1,27 @@ +From 9dd4e0280eca2ba666cc0671ec3724610ed7d366 Mon Sep 17 00:00:00 2001 +From: Tony Cook +Date: Mon, 19 Feb 2018 15:11:42 +1100 +Subject: (perl #132063) we should no longer warn for this code + +The first patch for 132063 prevented the buffer read overflow when +dumping the warning but didn't fix the underlying problem. + +The next change treats the supplied buffer correctly, preventing the +non-UTF-8 SV from being treated as UTF-8, preventing the warning. +--- + t/lib/warnings/regexec | 3 --- + 1 file changed, 3 deletions(-) + +Index: perl-5.22.1/t/lib/warnings/regexec +=================================================================== +--- perl-5.22.1.orig/t/lib/warnings/regexec 2018-04-05 08:46:08.431450103 -0400 ++++ perl-5.22.1/t/lib/warnings/regexec 2018-04-05 08:46:08.431450103 -0400 +@@ -215,8 +215,5 @@ Use of \b{} or \B{} for non-UTF-8 locale + Use of \b{} or \B{} for non-UTF-8 locale is wrong. Assuming a UTF-8 locale at - line 17. + ######## + # NAME perl #132063, read beyond buffer end +-# OPTION fatal + "\xff" =~ /(?il)\x{100}|\x{100}/; + EXPECT +-Malformed UTF-8 character: \xff (too short; 1 byte available, need 13) in pattern match (m//) at - line 2. +-Malformed UTF-8 character (fatal) at - line 2. diff -Nru perl-5.22.1/debian/patches/fixes/CVE-2018-6913.patch perl-5.22.1/debian/patches/fixes/CVE-2018-6913.patch --- perl-5.22.1/debian/patches/fixes/CVE-2018-6913.patch 1970-01-01 00:00:00.000000000 +0000 +++ perl-5.22.1/debian/patches/fixes/CVE-2018-6913.patch 2018-04-05 13:53:28.000000000 +0000 @@ -0,0 +1,139 @@ +Backport of: + +From c3d9db7eb4dc1747fff423ebaf0c1bcd62c2e8a9 Mon Sep 17 00:00:00 2001 +From: Tony Cook +Date: Tue, 8 Aug 2017 09:32:58 +1000 +Subject: (perl #131844) fix various space calculation issues in pp_pack.c + +- for the originally reported case, if the start/cur pointer is in the + top 75% of the address space the add (cur) + glen addition would + overflow, resulting in the condition failing incorrectly. + +- the addition of the existing space used to the space needed could + overflow, resulting in too small an allocation and a buffer overflow. + +- the scaling for UTF8 could overflow. + +- the multiply to calculate the space needed for many items could + overflow. + +For the first case, do a space calculation without making new pointers. + +For the other cases, detect the overflow and croak if there's an +overflow. + +Originally this used Size_t_MAX as the maximum size of a memory +allocation, but for -DDEBUGGING builds realloc() throws a panic for +allocations over half the address space in size, changing the error +reported for the allocation. + +For non-DEBUGGING builds the Size_t_MAX limit has the small chance +of finding a system that has 3GB of contiguous space available, and +allocating that space, which could be a denial of servce in some cases. + +Unfortunately changing the limit to half the address space means that +the exact case with the original issue can no longer occur, so the +test is no longer testing against the address + length issue that +caused the original problem, since the allocation is failing earlier. + +One option would be to change the test so the size request by pack is +just under 2GB, but this has a higher (but still low) probability that +the system has the address space available, and will actually try to +allocate the memory, so let's not do that. +--- + pp_pack.c | 25 +++++++++++++++++++++---- + t/op/pack.t | 24 +++++++++++++++++++++++- + 2 files changed, 44 insertions(+), 5 deletions(-) + +Index: perl-5.22.1/pp_pack.c +=================================================================== +--- perl-5.22.1.orig/pp_pack.c 2018-04-05 08:48:30.803640405 -0400 ++++ perl-5.22.1/pp_pack.c 2018-04-05 08:48:30.799640401 -0400 +@@ -358,11 +358,28 @@ STMT_START { \ + } \ + } STMT_END + ++#define SAFE_UTF8_EXPAND(var) \ ++STMT_START { \ ++ if ((var) > SSize_t_MAX / UTF8_EXPAND) \ ++ Perl_croak(aTHX_ "%s", "Out of memory during pack()"); \ ++ (var) = (var) * UTF8_EXPAND; \ ++} STMT_END ++ ++#define GROWING2(utf8, cat, start, cur, item_size, item_count) \ ++STMT_START { \ ++ if (SSize_t_MAX / (item_size) < (item_count)) \ ++ Perl_croak(aTHX_ "%s", "Out of memory during pack()"); \ ++ GROWING((utf8), (cat), (start), (cur), (item_size) * (item_count)); \ ++} STMT_END ++ + #define GROWING(utf8, cat, start, cur, in_len) \ + STMT_START { \ + STRLEN glen = (in_len); \ +- if (utf8) glen *= UTF8_EXPAND; \ +- if ((cur) + glen >= (start) + SvLEN(cat)) { \ ++ STRLEN catcur = (STRLEN)((cur) - (start)); \ ++ if (utf8) SAFE_UTF8_EXPAND(glen); \ ++ if (SSize_t_MAX - glen < catcur) \ ++ Perl_croak(aTHX_ "%s", "Out of memory during pack()"); \ ++ if (catcur + glen >= SvLEN(cat)) { \ + (start) = sv_exp_grow(cat, glen); \ + (cur) = (start) + SvCUR(cat); \ + } \ +@@ -372,7 +389,7 @@ STMT_START { \ + STMT_START { \ + const STRLEN glen = (in_len); \ + STRLEN gl = glen; \ +- if (utf8) gl *= UTF8_EXPAND; \ ++ if (utf8) SAFE_UTF8_EXPAND(gl); \ + if ((cur) + gl >= (start) + SvLEN(cat)) { \ + *cur = '\0'; \ + SvCUR_set((cat), (cur) - (start)); \ +@@ -2125,7 +2142,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* sym + if (props && !(props & PACK_SIZE_UNPREDICTABLE)) { + /* We can process this letter. */ + STRLEN size = props & PACK_SIZE_MASK; +- GROWING(utf8, cat, start, cur, (STRLEN) len * size); ++ GROWING2(utf8, cat, start, cur, size, (STRLEN)len); + } + } + +Index: perl-5.22.1/t/op/pack.t +=================================================================== +--- perl-5.22.1.orig/t/op/pack.t 2018-04-05 08:48:30.803640405 -0400 ++++ perl-5.22.1/t/op/pack.t 2018-04-05 08:48:30.799640401 -0400 +@@ -12,7 +12,7 @@ my $no_endianness = $] > 5.009 ? '' : + my $no_signedness = $] > 5.009 ? '' : + "Signed/unsigned pack modifiers not available on this perl"; + +-plan tests => 14708; ++plan tests => 14712; + + use strict; + use warnings qw(FATAL all); +@@ -2020,3 +2020,25 @@ is $o::num, 1, 'pack "c" does call n + #[perl #123874]: argument underflow leads to corrupt length + eval q{ pack "pi/x" }; + ok(1, "argument underflow did not crash"); ++ ++SKIP: ++{ ++ # [perl #131844] pointer addition overflow ++ $Config{ptrsize} == 4 ++ or skip "[perl #131844] need 32-bit build for this test", 4; ++ # prevent ASAN just crashing on the allocation failure ++ local $ENV{ASAN_OPTIONS} = $ENV{ASAN_OPTIONS}; ++ $ENV{ASAN_OPTIONS} .= ",allocator_may_return_null=1"; ++ fresh_perl_like('pack "f999999999"', qr/Out of memory during pack/, { stderr => 1 }, ++ "pointer addition overflow"); ++ ++ # integer (STRLEN) overflow from addition of glen to current length ++ fresh_perl_like('pack "c10f1073741823"', qr/Out of memory during pack/, { stderr => 1 }, ++ "integer overflow calculating allocation (addition)"); ++ ++ fresh_perl_like('pack "W10f536870913", 256', qr/Out of memory during pack/, { stderr => 1 }, ++ "integer overflow calculating allocation (utf8)"); ++ ++ fresh_perl_like('pack "c10f1073741824"', qr/Out of memory during pack/, { stderr => 1 }, ++ "integer overflow calculating allocation (multiply)"); ++} diff -Nru perl-5.22.1/debian/patches/series perl-5.22.1/debian/patches/series --- perl-5.22.1/debian/patches/series 2016-03-13 11:27:12.000000000 +0000 +++ perl-5.22.1/debian/patches/series 2018-06-13 12:22:10.000000000 +0000 @@ -56,3 +56,14 @@ fixes/memoize-pod.diff fixes/ok-pod.diff fixes/CVE-2016-2381_duplicate_env.diff +fixes/CVE-2017-12837.patch +fixes/CVE-2017-12883.patch +fixes/CVE-2016-6185.patch +fixes/CVE-2017-6512-pre.patch +fixes/CVE-2017-6512.patch +fixes/CVE-2018-6797.patch +fixes/CVE-2018-6798-1.patch +fixes/CVE-2018-6798-2.patch +fixes/CVE-2018-6798-3.patch +fixes/CVE-2018-6913.patch +fixes/CVE-2018-12015.patch