perl: Remove default «.» from @INC before loading modules

When loading eval'ed modules we should remove «.» from @INC, or we
might end up loading code under the caller's control.

Fixes: CVE-2016-1238

6 files changed, 19 insertions, 4 deletions

diff --git a/scripts/Dpkg/Changelog/Parse.pm b/scripts/Dpkg/Changelog/Parse.pm
index b57b7d99e..68777b4b0 100644
--- a/scripts/Dpkg/Changelog/Parse.pm
+++ b/scripts/Dpkg/Changelog/Parse.pm
@@ -157,6 +157,7 @@ sub _changelog_parse {
     my $format = ucfirst lc $options{changelogformat};
     my $changes;
     eval qq{
+        pop \@INC if \$INC[-1] eq '.';
         require Dpkg::Changelog::$format;
         \$changes = Dpkg::Changelog::$format->new();
     };
diff --git a/scripts/Dpkg/File.pm b/scripts/Dpkg/File.pm
index c6ae3264c..075238ee8 100644
--- a/scripts/Dpkg/File.pm
+++ b/scripts/Dpkg/File.pm
@@ -38,7 +38,10 @@ sub file_lock($$) {
     # and dpkg-dev indirectly making use of it, makes building new perl
     # package which bump the perl ABI impossible as these packages cannot
     # be installed alongside.
-    eval 'use File::FcntlLock';
+    eval q{
+        pop @INC if $INC[-1] eq '.';
+        use File::FcntlLock;
+    };
     if ($@) {
         warning(g_('File::FcntlLock not available; using flock which is not NFS-safe'));
         flock($fh, LOCK_EX)
diff --git a/scripts/Dpkg/Gettext.pm b/scripts/Dpkg/Gettext.pm
index 7be03d495..aa5aeb8da 100644
--- a/scripts/Dpkg/Gettext.pm
+++ b/scripts/Dpkg/Gettext.pm
@@ -98,7 +98,10 @@ or $msgid_plural otherwise.
 use constant GETTEXT_CONTEXT_GLUE => "\004";
 
 BEGIN {
-    eval 'use Locale::gettext';
+    eval q{
+        pop @INC if $INC[-1] eq '.';
+        use Locale::gettext;
+    };
     if ($@) {
         eval q{
             sub g_ {
diff --git a/scripts/Dpkg/Source/Package.pm b/scripts/Dpkg/Source/Package.pm
index d0d1f124c..6dc20397a 100644
--- a/scripts/Dpkg/Source/Package.pm
+++ b/scripts/Dpkg/Source/Package.pm
@@ -290,7 +290,11 @@ sub upgrade_object_type {
         $major =~ s/\.[\d\.]+$//;
         my $module = "Dpkg::Source::Package::V$major";
         $module .= '::' . ucfirst $variant if defined $variant;
-        eval "require $module; \$minor = \$${module}::CURRENT_MINOR_VERSION;";
+        eval qq{
+            pop \@INC if \$INC[-1] eq '.';
+            require $module;
+            \$minor = \$${module}::CURRENT_MINOR_VERSION;
+        };
         $minor //= 0;
         if ($update_format) {
             $self->{fields}{'Format'} = "$major.$minor";
diff --git a/scripts/Dpkg/Vendor.pm b/scripts/Dpkg/Vendor.pm
index f40ed2723..96f81cffd 100644
--- a/scripts/Dpkg/Vendor.pm
+++ b/scripts/Dpkg/Vendor.pm
@@ -162,6 +162,7 @@ sub get_vendor_object {
 
     foreach my $name (@names) {
         eval qq{
+            pop \@INC if \$INC[-1] eq '.';
             require Dpkg::Vendor::$name;
             \$obj = Dpkg::Vendor::$name->new();
         };
diff --git a/scripts/dpkg-mergechangelogs.pl b/scripts/dpkg-mergechangelogs.pl
index eacab5f5b..c66b72194 100755
--- a/scripts/dpkg-mergechangelogs.pl
+++ b/scripts/dpkg-mergechangelogs.pl
@@ -38,7 +38,10 @@ sub get_conflict_block($$);
 sub join_lines($);
 
 BEGIN {
-    eval 'use Algorithm::Merge qw(merge);';
+    eval q{
+        pop @INC if $INC[-1] eq '.';
+        use Algorithm::Merge qw(merge);
+    };
     if ($@) {
         eval q{
             sub merge {