In perl.git, the branch ap/baseincguard has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/f94344e85705ef634122789f9aabed978591894a?hp=f7353e3479cc0ecf3d8962e6011b103af978647b>

  discards  f7353e3479cc0ecf3d8962e6011b103af978647b (commit)
  discards  731dfe2db5c1fe2489e6776c928fc6f22b757b9c (commit)
- Log -----------------------------------------------------------------
commit f94344e85705ef634122789f9aabed978591894a
Author: Aristotle Pagaltzis <[email protected]>
Date:   Thu Oct 20 17:05:45 2016 +0200

    base: only hide $INC[-1] . from optional loads

M       dist/base/lib/base.pm
M       dist/base/t/incdot.t
M       dist/base/t/lib/BaseIncChecker.pm
M       dist/base/t/lib/BaseIncDoubleExtender.pm
M       dist/base/t/lib/BaseIncExtender.pm

commit a7b01d569a4dfc3aa92fecea323826cf511df1d3
Author: Aristotle Pagaltzis <[email protected]>
Date:   Thu Oct 20 16:38:20 2016 +0200

    base: fix test name

R100    dist/base/t/incmodified-vs-incdot.t     dist/base/t/incdot.t

commit 7a46c33a28cb1257237556bbc1583e57bad4e3d2
Author: Aristotle Pagaltzis <[email protected]>
Date:   Thu Oct 20 16:30:51 2016 +0200

    base: roll relevant incdot tests together

D       dist/base/t/incdot.t
M       dist/base/t/incmodified-vs-incdot.t
A       dist/base/t/lib/BaseIncChecker.pm
-----------------------------------------------------------------------

Summary of changes:
 dist/base/lib/base.pm | 18 +++++++++++++++---
 dist/base/t/incdot.t  |  9 ++++++++-
 2 files changed, 23 insertions(+), 4 deletions(-)

diff --git a/dist/base/lib/base.pm b/dist/base/lib/base.pm
index 1216a48..d7d2645 100644
--- a/dist/base/lib/base.pm
+++ b/dist/base/lib/base.pm
@@ -103,8 +103,8 @@ sub import {
             {
                 local $SIG{__DIE__};
                 my $fn = _module_to_filename($base);
-                eval {
-                    my $redot = $INC[-1] eq '.' && !!%{"$base\::"} # only when 
optional
+                my $success = eval {
+                    my $incdot = $INC[-1] eq '.' && %{"$base\::"} # only if 
optional
                         && bless [ $INC[-1] = sub {()} ], 
'base::__inc_scope_guard';
                     require $fn
                 };
@@ -118,7 +118,7 @@ sub import {
                 # see [perl #118561]
                 die if $@ && $@ !~ /^Can't locate \Q$fn\E .*? at .* line 
[0-9]+(?:, <[^>]*> (?:line|chunk) [0-9]+)?\.\n\z/s
                           || $@ =~ /Compilation failed in require at .* line 
[0-9]+(?:, <[^>]*> (?:line|chunk) [0-9]+)?\.\n\z/;
-                unless (%{"$base\::"}) {
+                if (!%{"$base\::"}) {
                     require Carp;
                     local $" = " ";
                     Carp::croak(<<ERROR);
@@ -127,6 +127,18 @@ Base class package "$base" is empty.
     or make that module available in \@INC (\@INC contains: @INC).
 ERROR
                 }
+                elsif (!$success && $INC[-1] eq '.' && -e $fn) {
+                    require Carp;
+                    Carp::croak(<<ERROR);
+Base class package "$base" is not empty but "$fn" exists in the current 
directory.
+    To help avoid security issues, base.pm now refuses to load optional modules
+    from the current working directory when it is the last entry in \@INC.
+    If your software worked on previous versions of Perl, the best solution
+    is to use FindBin to detect the path properly and to add that path to
+    \@INC.  As a last resort, you can re-enable looking in the current working
+    directory by adding "use lib '.'" to your code.
+ERROR
+                }
                 $sigdie = $SIG{__DIE__} || undef;
             }
             # Make sure a global $SIG{__DIE__} makes it out of the 
localization.
diff --git a/dist/base/t/incdot.t b/dist/base/t/incdot.t
index 64cf8c8..39eb84f 100644
--- a/dist/base/t/incdot.t
+++ b/dist/base/t/incdot.t
@@ -1,7 +1,7 @@
 #!/usr/bin/perl -w
 
 use strict;
-use Test::More tests => 11;  # one test is in each BaseInc* itself
+use Test::More tests => 13;  # one test is in each BaseInc* itself
 
 use lib 't/lib';
 
@@ -10,6 +10,13 @@ BEGIN { push @INC, '.' if $INC[-1] ne '.' }
 
 use base 'BaseIncChecker';
 
+BEGIN {
+    @t::lib::Dummy::ISA = (); # make it look like an optional load
+    ok !eval("use base 't::lib::Dummy'"), 'loading optional modules from . 
fails';
+    like $@, qr!Base class package "t::lib::Dummy" is not empty but 
"t/lib/Dummy\.pm" exists in the current directory\.!,
+        '... with a proper error message';
+}
+
 BEGIN { @BaseIncExtender::ISA = () } # make it look like an optional load
 use base 'BaseIncExtender';
 

--
Perl5 Master Repository

Reply via email to