From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:4830:134:3::10]:58259) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dI4oo-0000NO-PQ for guix-patches@gnu.org; Mon, 05 Jun 2017 23:06:08 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1dI4ok-0001LV-N4 for guix-patches@gnu.org; Mon, 05 Jun 2017 23:06:06 -0400 Received: from debbugs.gnu.org ([208.118.235.43]:55694) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1dI4ok-0001LJ-HR for guix-patches@gnu.org; Mon, 05 Jun 2017 23:06:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1dI4ok-0002M4-9x for guix-patches@gnu.org; Mon, 05 Jun 2017 23:06:02 -0400 Subject: bug#27263: [PATCH 2/2] gnu: perl: Fix CVE-2017-6512 in File::Path. Resent-Message-ID: From: Leo Famulari Date: Mon, 5 Jun 2017 23:04:10 -0400 Message-Id: <031e297c96cc7522ca42331605079a8462784466.1496718250.git.leo@famulari.name> In-Reply-To: References: In-Reply-To: References: List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: 27263@debbugs.gnu.org * gnu/packages/perl.scm (perl)[replacement]: New field. (perl/fixed): New variable. * gnu/packages/patches/perl-file-path-CVE-2017-6512.patch: New file. * gnu/local.mk (dist_patch_DATA): Add it. --- gnu/local.mk | 1 + .../patches/perl-file-path-CVE-2017-6512.patch | 173 +++++++++++++++++++++ gnu/packages/perl.scm | 13 ++ 3 files changed, 187 insertions(+) create mode 100644 gnu/packages/patches/perl-file-path-CVE-2017-6512.patch diff --git a/gnu/local.mk b/gnu/local.mk index 4b2bdfe37..ab3fbb2d3 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -884,6 +884,7 @@ dist_patch_DATA = \ %D%/packages/patches/pcre-CVE-2017-7186.patch \ %D%/packages/patches/pcre2-CVE-2017-7186.patch \ %D%/packages/patches/pcre2-CVE-2017-8786.patch \ + %D%/packages/patches/perl-file-path-CVE-2017-6512.patch \ %D%/packages/patches/perl-autosplit-default-time.patch \ %D%/packages/patches/perl-deterministic-ordering.patch \ %D%/packages/patches/perl-finance-quote-unuse-mozilla-ca.patch \ diff --git a/gnu/packages/patches/perl-file-path-CVE-2017-6512.patch b/gnu/packages/patches/perl-file-path-CVE-2017-6512.patch new file mode 100644 index 000000000..28ab06759 --- /dev/null +++ b/gnu/packages/patches/perl-file-path-CVE-2017-6512.patch @@ -0,0 +1,173 @@ +Fix CVE-2017-6512: + +https://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2017-6512 +https://rt.cpan.org/Public/Bug/Display.html?id=121951 + +Patch copied from Debian, adapted to apply to the copy of File::Path in Perl +5.24.0. + +https://github.com/jkeenan/File-Path/commit/e5ef95276ee8ad471c66ee574a5d42552b3a6af2 +https://anonscm.debian.org/cgit/perl/perl.git/diff/debian/patches/fixes/file_path_chmod_race.diff?id=e7b50f8fb6413f8ddfbbfda2d531615fb029e2d3 + +From d760748be0efca7c05454440e24f3df77bf7cf5d 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 (whitespace adjustments) to File-Path 2.12 / perl 5.24 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 | 39 +++++++++++++++++++++++++-------------- + cpan/File-Path/t/Path.t | 40 ++++++++++++++++++++++++++-------------- + 2 files changed, 51 insertions(+), 28 deletions(-) + +diff --git a/cpan/File-Path/lib/File/Path.pm b/cpan/File-Path/lib/File/Path.pm +index 034da1e..a824cc8 100644 +--- a/cpan/File-Path/lib/File/Path.pm ++++ b/cpan/File-Path/lib/File/Path.pm +@@ -354,21 +354,32 @@ sub _rmtree { + + # see if we can escalate privileges to get in + # (e.g. funny protection mask such as -w- instead of rwx) +- $perm &= oct '7777'; +- my $nperm = $perm | oct '700'; +- 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 &= oct '7777'; ++ my $nperm = $perm | oct '700'; ++ 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 ff52fd6..956ca09 100644 +--- a/cpan/File-Path/t/Path.t ++++ b/cpan/File-Path/t/Path.t +@@ -3,7 +3,7 @@ + + use strict; + +-use Test::More tests => 127; ++use Test::More tests => 126; + use Config; + use Fcntl ':mode'; + use lib 't/'; +@@ -18,6 +18,13 @@ BEGIN { + + 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) { +@@ -299,16 +306,19 @@ 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; ++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, 0200); ++ @created = mkpath($dir, undef, 0400); + +-is(scalar(@created), 1, "created write-only dir"); ++ is(scalar(@created), 1, "created read-only dir"); + +-is($created[0], $dir, "created write-only directory cross-check"); ++ is($created[0], $dir, "created read-only directory cross-check"); + +-is(rmtree($dir), 1, "removed write-only dir"); ++ is(rmtree($dir), 1, "removed read-only dir"); ++} + + # borderline new-style heuristics + if (chdir $tmp_base) { +@@ -450,26 +460,28 @@ SKIP: { + } + + SKIP : { +- my $skip_count = 19; ++ my $skip_count = 18; + # this test will fail on Windows, as per: + # http://perldoc.perl.org/perlport.html#chmod + + skip "Windows chmod test skipped", $skip_count + if $^O eq 'MSWin32'; ++ skip "fchmod() on directories is not supported on this platform", $skip_count ++ unless $fchmod_supported; + my $mode; + my $octal_mode; + my @inputs = ( +- 0777, 0700, 0070, 0007, +- 0333, 0300, 0030, 0003, +- 0111, 0100, 0010, 0001, +- 0731, 0713, 0317, 0371, 0173, 0137, +- 00 ); ++ 0777, 0700, 0470, 0407, ++ 0433, 0400, 0430, 0403, ++ 0111, 0100, 0110, 0101, ++ 0731, 0713, 0317, 0371, ++ 0173, 0137); + my $input; + my $octal_input; +- $dir = catdir($tmp_base, 'chmod_test'); + + foreach (@inputs) { + $input = $_; ++ $dir = catdir($tmp_base, sprintf("chmod_test%04o", $input)); + # We can skip from here because 0 is last in the list. + skip "Mode of 0 means assume user defaults on VMS", 1 + if ($input == 0 && $Is_VMS); diff --git a/gnu/packages/perl.scm b/gnu/packages/perl.scm index e56c80609..6da4bb13f 100644 --- a/gnu/packages/perl.scm +++ b/gnu/packages/perl.scm @@ -51,6 +51,7 @@ ;; Yeah, Perl... It is required early in the bootstrap process by Linux. (package (name "perl") + (replacement perl/fixed) (version "5.24.0") (source (origin (method url-fetch) @@ -147,6 +148,18 @@ (home-page "http://www.perl.org/") (license gpl1+))) ; or "Artistic" +(define perl/fixed + (package + (inherit perl) + (replacement #f) + (source + (origin + (inherit (package-source perl)) + (patches + (append + (origin-patches (package-source perl)) + (search-patches "perl-file-path-CVE-2017-6512.patch"))))))) + (define-public perl-algorithm-c3 (package (name "perl-algorithm-c3") -- 2.13.0