Blob Blame History Raw
From 394ac06dc5e9e94a81c39c43135d1635f516422e Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Wed, 27 Jul 2016 12:14:13 +1000
Subject: [PATCH] CVE-2016-1238: don't load optional modules from default .
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

App::Cpan attempts to load several optional modules, which an attacker
can use if cpan is run from a directory writable by other users, such
as /tmp.

Signed-off-by: Petr Písař <ppisar@redhat.com>
---
 lib/App/Cpan.pm | 21 ++++++++++++++++-----
 1 file changed, 16 insertions(+), 5 deletions(-)

diff --git a/lib/App/Cpan.pm b/lib/App/Cpan.pm
index f43dea9..c654c2c 100644
--- a/lib/App/Cpan.pm
+++ b/lib/App/Cpan.pm
@@ -549,9 +549,20 @@ sub AUTOLOAD { 1 }
 sub DESTROY { 1 }
 }
 
+# load a module without searching the default entry for the current
+# directory
+sub _safe_load_module {
+    my $name = shift;
+
+    local @INC = @INC;
+    pop @INC if $INC[-1] eq '.';
+
+    eval "require $name; 1";
+}
+
 sub _init_logger
 	{
-	my $log4perl_loaded = eval "require Log::Log4perl; 1";
+	my $log4perl_loaded = _safe_load_module("Log::Log4perl");
 
     unless( $log4perl_loaded )
         {
@@ -1020,7 +1031,7 @@ sub _load_local_lib # -I
 	{
 	$logger->debug( "Loading local::lib" );
 
-	my $rc = eval { require local::lib; 1; };
+	my $rc = _safe_load_module("local::lib");
 	unless( $rc ) {
 		$logger->die( "Could not load local::lib" );
 		}
@@ -1160,7 +1171,7 @@ sub _get_file
 	{
 	my $path = shift;
 
-	my $loaded = eval "require LWP::Simple; 1;";
+	my $loaded = _safe_load_module("LWP::Simple");
 	croak "You need LWP::Simple to use features that fetch files from CPAN\n"
 		unless $loaded;
 
@@ -1182,7 +1193,7 @@ sub _gitify
 	{
 	my $args = shift;
 
-	my $loaded = eval "require Archive::Extract; 1;";
+	my $loaded = _safe_load_module("Archive::Extract");
 	croak "You need Archive::Extract to use features that gitify distributions\n"
 		unless $loaded;
 
@@ -1245,7 +1256,7 @@ sub _show_Changes
 sub _get_changes_file
 	{
 	croak "Reading Changes files requires LWP::Simple and URI\n"
-		unless eval "require LWP::Simple; require URI; 1";
+		unless _safe_load_module("LWP::Simple") && _safe_load_module("URI");
 
     my $url = shift;
 
-- 
2.7.4