From 1fda472dd88b81e98b96371623f4106791f02c5c Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Mon, 27 Jun 2016 16:21:21 +1000 Subject: cpan/: remove . from @INC when loading optional modules This was originally against maint-5.24 where bignum is in cpan/, but in maint-5.22 it was in dist/ (Backported to 5.20.2 by Niko Tyni ) Origin: backport Bug: https://rt.perl.org/Public/Bug/Display.html?id=127834 Patch-Name: fixes/CVE-2016-1238/remove-dot-in-cpan.diff --- cpan/CPAN/lib/App/Cpan.pm | 21 ++++++++++++++++----- cpan/CPAN/lib/CPAN.pm | 4 ++++ cpan/Digest/Digest.pm | 6 +++++- cpan/Encode/Encode.pm | 2 ++ cpan/File-Fetch/lib/File/Fetch.pm | 10 ++++++++++ cpan/HTTP-Tiny/lib/HTTP/Tiny.pm | 2 ++ cpan/IO-Compress/lib/IO/Uncompress/AnyUncompress.pm | 2 ++ cpan/IPC-Cmd/lib/IPC/Cmd.pm | 4 ++++ .../lib/Locale/Maketext/Simple.pm | 7 ++++++- cpan/Memoize/Memoize.pm | 6 +++++- cpan/Pod-Perldoc/lib/Pod/Perldoc.pm | 5 +++++ cpan/Sys-Syslog/Syslog.pm | 2 ++ cpan/libnet/Net/Config.pm | 7 ++++++- dist/ExtUtils-Command/lib/ExtUtils/Command.pm | 5 ++++- dist/bignum/lib/bigint.pm | 2 ++ dist/bignum/lib/bignum.pm | 2 ++ dist/bignum/lib/bigrat.pm | 2 ++ 17 files changed, 79 insertions(+), 10 deletions(-) diff --git a/cpan/CPAN/lib/App/Cpan.pm b/cpan/CPAN/lib/App/Cpan.pm index b548bcc0ae..e79ace6eee 100644 --- a/cpan/CPAN/lib/App/Cpan.pm +++ b/cpan/CPAN/lib/App/Cpan.pm @@ -458,9 +458,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 ) { @@ -898,7 +909,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" ); } @@ -1013,7 +1024,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; @@ -1035,7 +1046,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; @@ -1099,7 +1110,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; diff --git a/cpan/CPAN/lib/CPAN.pm b/cpan/CPAN/lib/CPAN.pm index 4ed4b6cdd0..074924c155 100644 --- a/cpan/CPAN/lib/CPAN.pm +++ b/cpan/CPAN/lib/CPAN.pm @@ -1090,6 +1090,8 @@ sub has_usable { ] }; if ($usable->{$mod}) { + local @INC = @INC; + pop @INC if $INC[-1] eq '.'; for my $c (0..$#{$usable->{$mod}}) { my $code = $usable->{$mod}[$c]; my $ret = eval { &$code() }; @@ -1118,6 +1120,8 @@ sub has_inst { $CPAN::META->{dontload_hash}{$mod}||=1; # unsafe meta access, ok return 0; } + local @INC = @INC; + pop @INC if $INC[-1] eq '.'; my $file = $mod; my $obj; $file =~ s|::|/|g; diff --git a/cpan/Digest/Digest.pm b/cpan/Digest/Digest.pm index c3355a8bd4..299e25e0b7 100644 --- a/cpan/Digest/Digest.pm +++ b/cpan/Digest/Digest.pm @@ -38,7 +38,11 @@ sub new unless (exists ${"$class\::"}{"VERSION"}) { my $pm_file = $class . ".pm"; $pm_file =~ s{::}{/}g; - eval { require $pm_file }; + eval { + local @INC = @INC; + pop @INC if $INC[-1] eq '.'; + require $pm_file + }; if ($@) { $err ||= $@; next; diff --git a/cpan/Encode/Encode.pm b/cpan/Encode/Encode.pm index 5d477f6bde..ac90e549ed 100644 --- a/cpan/Encode/Encode.pm +++ b/cpan/Encode/Encode.pm @@ -56,6 +56,8 @@ require Encode::Config; eval { local $SIG{__DIE__}; local $SIG{__WARN__}; + local @INC = @INC; + pop @INC if $INC[-1] eq '.'; require Encode::ConfigLocal; }; diff --git a/cpan/File-Fetch/lib/File/Fetch.pm b/cpan/File-Fetch/lib/File/Fetch.pm index 7d6a263e2b..5a8799b76a 100644 --- a/cpan/File-Fetch/lib/File/Fetch.pm +++ b/cpan/File-Fetch/lib/File/Fetch.pm @@ -567,6 +567,8 @@ sub _lwp_fetch { }; + local @INC = @INC; + pop @INC if $INC[-1] eq '.'; unless( can_load( modules => $use_list ) ) { $METHOD_FAIL->{'lwp'} = 1; return; @@ -619,6 +621,8 @@ sub _httptiny_fetch { }; + local @INC = @INC; + pop @INC if $INC[-1] eq '.'; unless( can_load(modules => $use_list) ) { $METHOD_FAIL->{'httptiny'} = 1; return; @@ -658,6 +662,8 @@ sub _httplite_fetch { }; + local @INC = @INC; + pop @INC if $INC[-1] eq '.'; unless( can_load(modules => $use_list) ) { $METHOD_FAIL->{'httplite'} = 1; return; @@ -733,6 +739,8 @@ sub _iosock_fetch { 'IO::Select' => '0.0', }; + local @INC = @INC; + pop @INC if $INC[-1] eq '.'; unless( can_load(modules => $use_list) ) { $METHOD_FAIL->{'iosock'} = 1; return; @@ -814,6 +822,8 @@ sub _netftp_fetch { check( $tmpl, \%hash ) or return; ### required modules ### + local @INC = @INC; + pop @INC if $INC[-1] eq '.'; my $use_list = { 'Net::FTP' => 0 }; unless( can_load( modules => $use_list ) ) { diff --git a/cpan/HTTP-Tiny/lib/HTTP/Tiny.pm b/cpan/HTTP-Tiny/lib/HTTP/Tiny.pm index e348753b93..0ab7f4b674 100644 --- a/cpan/HTTP-Tiny/lib/HTTP/Tiny.pm +++ b/cpan/HTTP-Tiny/lib/HTTP/Tiny.pm @@ -1368,6 +1368,8 @@ sub _find_CA_file { return $self->{SSL_options}->{SSL_ca_file} if $self->{SSL_options}->{SSL_ca_file} and -e $self->{SSL_options}->{SSL_ca_file}; + local @INC = @INC; + pop @INC if $INC[-1] eq '.'; return Mozilla::CA::SSL_ca_file() if eval { require Mozilla::CA }; diff --git a/cpan/IO-Compress/lib/IO/Uncompress/AnyUncompress.pm b/cpan/IO-Compress/lib/IO/Uncompress/AnyUncompress.pm index e2b104dff4..3de5776193 100644 --- a/cpan/IO-Compress/lib/IO/Uncompress/AnyUncompress.pm +++ b/cpan/IO-Compress/lib/IO/Uncompress/AnyUncompress.pm @@ -27,6 +27,8 @@ Exporter::export_ok_tags('all'); BEGIN { + local @INC = @INC; + pop @INC if $INC[-1] eq '.'; eval ' use IO::Uncompress::Adapter::Inflate 2.064 ;'; eval ' use IO::Uncompress::Adapter::Bunzip2 2.064 ;'; eval ' use IO::Uncompress::Adapter::LZO 2.064 ;'; diff --git a/cpan/IPC-Cmd/lib/IPC/Cmd.pm b/cpan/IPC-Cmd/lib/IPC/Cmd.pm index 6a82bdff9b..84ad0a0371 100644 --- a/cpan/IPC-Cmd/lib/IPC/Cmd.pm +++ b/cpan/IPC-Cmd/lib/IPC/Cmd.pm @@ -142,6 +142,8 @@ sub can_use_ipc_run { return if IS_WIN98; ### if we don't have ipc::run, we obviously can't use it. + local @INC = @INC; + pop @INC if $INC[-1] eq '.'; return unless can_load( modules => { 'IPC::Run' => '0.55' }, verbose => ($WARN && $verbose), @@ -169,6 +171,8 @@ sub can_use_ipc_open3 { ### IPC::Open3 works on every non-VMS platform, but it can't ### capture buffers on win32 :( + local @INC = @INC; + pop @INC if $INC[-1] eq '.'; return unless can_load( modules => { map {$_ => '0.0'} qw|IPC::Open3 IO::Select Symbol| }, verbose => ($WARN && $verbose), diff --git a/cpan/Locale-Maketext-Simple/lib/Locale/Maketext/Simple.pm b/cpan/Locale-Maketext-Simple/lib/Locale/Maketext/Simple.pm index 30760f3c26..9465c529c8 100644 --- a/cpan/Locale-Maketext-Simple/lib/Locale/Maketext/Simple.pm +++ b/cpan/Locale-Maketext-Simple/lib/Locale/Maketext/Simple.pm @@ -134,7 +134,12 @@ sub load_loc { my $pkg = join('::', grep { defined and length } $args{Class}, $args{Subclass}); return $Loc{$pkg} if exists $Loc{$pkg}; - eval { require Locale::Maketext::Lexicon; 1 } or return; + eval { + local @INC = @INC; + pop @INC if $INC[-1] eq '.'; + require Locale::Maketext::Lexicon; + 1 + } or return; $Locale::Maketext::Lexicon::VERSION > 0.20 or return; eval { require File::Spec; 1 } or return; diff --git a/cpan/Memoize/Memoize.pm b/cpan/Memoize/Memoize.pm index 9a58c4ac74..b566f21b96 100644 --- a/cpan/Memoize/Memoize.pm +++ b/cpan/Memoize/Memoize.pm @@ -184,7 +184,11 @@ sub _my_tie { } my $modulefile = $module . '.pm'; $modulefile =~ s{::}{/}g; - eval { require $modulefile }; + eval { + local @INC = @INC; + pop @INC if $INC[-1] eq '.'; + require $modulefile + }; if ($@) { croak "Memoize: Couldn't load hash tie module `$module': $@; aborting"; } diff --git a/cpan/Pod-Perldoc/lib/Pod/Perldoc.pm b/cpan/Pod-Perldoc/lib/Pod/Perldoc.pm index 1089f5bb3e..5cf7424cee 100644 --- a/cpan/Pod-Perldoc/lib/Pod/Perldoc.pm +++ b/cpan/Pod-Perldoc/lib/Pod/Perldoc.pm @@ -563,6 +563,9 @@ sub find_good_formatter_class { my @class_list = @{ $self->{'formatter_classes'} || [] }; $self->die( "WHAT? Nothing in the formatter class list!?" ) unless @class_list; + local @INC = @INC; + pop @INC if $INC[-1] eq '.'; + my $good_class_found; foreach my $c (@class_list) { DEBUG > 4 and print "Trying to load $c...\n"; @@ -994,6 +997,8 @@ sub new_translator { # $tr = $self->new_translator($lang); my $self = shift; my $lang = shift; + local @INC = @INC; + pop @INC if $INC[-1] eq '.'; my $pack = 'POD2::' . uc($lang); eval "require $pack"; if ( !$@ && $pack->can('new') ) { diff --git a/cpan/Sys-Syslog/Syslog.pm b/cpan/Sys-Syslog/Syslog.pm index 25164af320..eed224a7c4 100644 --- a/cpan/Sys-Syslog/Syslog.pm +++ b/cpan/Sys-Syslog/Syslog.pm @@ -888,6 +888,8 @@ sub silent_eval (&) { sub can_load { my ($module, $verbose) = @_; local($SIG{__DIE__}, $SIG{__WARN__}, $@); + local @INC = @INC; + pop @INC if $INC[-1] eq '.'; my $loaded = eval "use $module; 1"; warn $@ if not $loaded and $verbose; return $loaded diff --git a/cpan/libnet/Net/Config.pm b/cpan/libnet/Net/Config.pm index 4b1ea19315..e6b7f5c0cd 100644 --- a/cpan/libnet/Net/Config.pm +++ b/cpan/libnet/Net/Config.pm @@ -15,7 +15,12 @@ use strict; @ISA = qw(Net::LocalCfg Exporter); $VERSION = "1.13"; -eval { local $SIG{__DIE__}; require Net::LocalCfg }; +eval { + local @INC = @INC; + pop @INC if $INC[-1] eq '.'; + local $SIG{__DIE__}; + require Net::LocalCfg; +}; %NetConfig = ( nntp_hosts => [], diff --git a/dist/ExtUtils-Command/lib/ExtUtils/Command.pm b/dist/ExtUtils-Command/lib/ExtUtils/Command.pm index 035d5ca9df..8d3c7b7cad 100644 --- a/dist/ExtUtils-Command/lib/ExtUtils/Command.pm +++ b/dist/ExtUtils-Command/lib/ExtUtils/Command.pm @@ -24,7 +24,10 @@ if( $Is_VMS ) { my $vms_efs; my $vms_case; - if (eval { local $SIG{__DIE__}; require VMS::Feature; }) { + if (eval { local $SIG{__DIE__}; + local @INC = @INC; + pop @INC if $INC[-1] eq '.'; + require VMS::Feature; }) { $vms_unix_rpt = VMS::Feature::current("filename_unix_report"); $vms_efs = VMS::Feature::current("efs_charset"); $vms_case = VMS::Feature::current("efs_case_preserve"); diff --git a/dist/bignum/lib/bigint.pm b/dist/bignum/lib/bigint.pm index 993ea9112f..592ed76512 100644 --- a/dist/bignum/lib/bigint.pm +++ b/dist/bignum/lib/bigint.pm @@ -248,6 +248,8 @@ sub import # see if we can find Math::BigInt::Lite if (!defined $a && !defined $p) # rounding won't work to well { + local @INC = @INC; + pop @INC if $INC[-1] eq '.'; eval 'require Math::BigInt::Lite;'; if ($@ eq '') { diff --git a/dist/bignum/lib/bignum.pm b/dist/bignum/lib/bignum.pm index 40aedceca7..caf4fc8844 100644 --- a/dist/bignum/lib/bignum.pm +++ b/dist/bignum/lib/bignum.pm @@ -155,6 +155,8 @@ sub import # see if we can find Math::BigInt::Lite if (!defined $a && !defined $p) # rounding won't work to well { + local @INC = @INC; + pop @INC if $INC[-1] eq '.'; eval 'require Math::BigInt::Lite;'; if ($@ eq '') { diff --git a/dist/bignum/lib/bigrat.pm b/dist/bignum/lib/bigrat.pm index adbeff4dba..4e3db00217 100644 --- a/dist/bignum/lib/bigrat.pm +++ b/dist/bignum/lib/bigrat.pm @@ -148,6 +148,8 @@ sub import # see if we can find Math::BigInt::Lite if (!defined $a && !defined $p) # rounding won't work to well { + local @INC = @INC; + pop @INC if $INC[-1] eq '.'; eval 'require Math::BigInt::Lite;'; if ($@ eq '') {