This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
cpan/: remove . from @INC when loading optional modules
authorTony Cook <tony@develop-help.com>
Mon, 27 Jun 2016 06:21:21 +0000 (16:21 +1000)
committerTony Cook <tony@develop-help.com>
Tue, 26 Jul 2016 05:36:32 +0000 (15:36 +1000)
17 files changed:
cpan/CPAN/lib/App/Cpan.pm
cpan/CPAN/lib/CPAN.pm
cpan/Digest/Digest.pm
cpan/Encode/Encode.pm
cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command.pm
cpan/File-Fetch/lib/File/Fetch.pm
cpan/HTTP-Tiny/lib/HTTP/Tiny.pm
cpan/IO-Compress/lib/IO/Uncompress/AnyUncompress.pm
cpan/IPC-Cmd/lib/IPC/Cmd.pm
cpan/Locale-Maketext-Simple/lib/Locale/Maketext/Simple.pm
cpan/Memoize/Memoize.pm
cpan/Pod-Perldoc/lib/Pod/Perldoc.pm
cpan/Sys-Syslog/Syslog.pm
cpan/bignum/lib/bigint.pm
cpan/bignum/lib/bignum.pm
cpan/bignum/lib/bigrat.pm
cpan/libnet/lib/Net/Config.pm

index 59642ed..ff73787 100644 (file)
@@ -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;
 
index 4844cbe..49e3352 100644 (file)
@@ -1118,6 +1118,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() };
@@ -1160,6 +1162,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;
index c3355a8..299e25e 100644 (file)
@@ -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;
index f42483a..041e60c 100644 (file)
@@ -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;
 };
 
index a1d70b5..c214970 100644 (file)
@@ -20,7 +20,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");
index 7d6a263..5a8799b 100644 (file)
@@ -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 ) ) {
index 42653e0..1f11662 100644 (file)
@@ -504,6 +504,8 @@ sub can_ssl {
     my($ok, $reason) = (1, '');
 
     # Need IO::Socket::SSL 1.42 for SSL_create_ctx_callback
+    local @INC = @INC;
+    pop @INC if $INC[-1] eq '.';
     unless (eval {require IO::Socket::SSL; IO::Socket::SSL->VERSION(1.42)}) {
         $ok = 0;
         $reason .= qq/IO::Socket::SSL 1.42 must be installed for https support\n/;
@@ -1568,6 +1570,8 @@ sub _find_CA_file {
         return $ca_file;
     }
 
+    local @INC = @INC;
+    pop @INC if $INC[-1] eq '.';
     return Mozilla::CA::SSL_ca_file()
         if eval { require Mozilla::CA; 1 };
 
index 7f5b27c..0760fc5 100644 (file)
@@ -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.069 ;';
    eval ' use IO::Uncompress::Adapter::Bunzip2 2.069 ;';
    eval ' use IO::Uncompress::Adapter::LZO 2.069 ;';
index 13f3c6b..e8e295e 100644 (file)
@@ -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),
index 30760f3..9465c52 100644 (file)
@@ -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;
 
index 9a58c4a..b566f21 100644 (file)
@@ -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";
   }
index 84f6624..d35d0a0 100644 (file)
@@ -575,6 +575,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";
@@ -1006,6 +1009,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') ) {
index 0cfc749..43afcd9 100644 (file)
@@ -918,6 +918,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
index fa30eb8..c03e096 100644 (file)
@@ -315,6 +315,8 @@ sub import {
     } else {
         # 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 '.';
             if (eval { require Math::BigInt::Lite; 1 }) {
                 @import = ();                   # :constant in Lite, not MBI
                 Math::BigInt::Lite->import(':constant');
index bf2881e..89cf0af 100644 (file)
@@ -157,6 +157,8 @@ sub import {
     else {
         # 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 '.';
             if (eval { require Math::BigInt::Lite; 1 }) {
                 @import = ();                   # :constant in Lite, not MBI
                 Math::BigInt::Lite->import(':constant');
index 8557fc9..e1032b6 100644 (file)
@@ -150,6 +150,8 @@ sub import {
     else {
         # 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 '.';
             if (eval { require Math::BigInt::Lite; 1 }) {
                 @import = ();                   # :constant in Lite, not MBI
                 Math::BigInt::Lite->import(':constant');
index ff2b841..ec106f9 100644 (file)
@@ -24,7 +24,12 @@ our $VERSION = "3.09";
 
 our($CONFIGURE, $LIBNET_CFG);
 
-eval { local $SIG{__DIE__}; require Net::LocalCfg };
+eval {
+  local @INC = @INC;
+  pop @INC if $INC[-1] eq '.';
+  local $SIG{__DIE__};
+  require Net::LocalCfg;
+};
 
 our %NetConfig = (
   nntp_hosts      => [],