[dpkg] 130/187: perl: Remove default «.» from @INC before loading modules

[Reiner Herrmann]

This is an automated email from the git hooks/post-receive script.

deki-guest pushed a commit to branch master
in repository dpkg.

commit 583e7b0ab992c4770414e1f8f903f207035d0523
Author: Guillem Jover <guillem at debian.org>
Date:   Wed Sep 14 23:26:16 2016 +0200

    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
---
 debian/changelog                | 2 ++
 dselect/methods/ftp/install.pl  | 1 +
 dselect/methods/ftp/setup.pl    | 5 ++++-
 dselect/methods/ftp/update.pl   | 5 ++++-
 scripts/Dpkg/Changelog/Parse.pm | 1 +
 scripts/Dpkg/File.pm            | 5 ++++-
 scripts/Dpkg/Gettext.pm         | 5 ++++-
 scripts/Dpkg/Source/Package.pm  | 6 +++++-
 scripts/Dpkg/Vendor.pm          | 1 +
 scripts/dpkg-mergechangelogs.pl | 5 ++++-
 10 files changed, 30 insertions(+), 6 deletions(-)

diff --git a/debian/changelog b/debian/changelog
index 3058474..f622bb5 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -52,6 +52,8 @@ dpkg (1.18.11) UNRELEASED; urgency=medium
     --remove and then --purge sequentially. When purging a package which is
     already in config-files (i.e. it has been removed before), do not print
     nor log the remove action.
+  * Remove default «.» from @INC before loading perl modules in perl code.
+    Fixes CVE-2016-1238.
   * Architecture support:
     - Add support for AIX operating system.
   * Portability:
diff --git a/dselect/methods/ftp/install.pl b/dselect/methods/ftp/install.pl
index b183d15..1dddb60 100755
--- a/dselect/methods/ftp/install.pl
+++ b/dselect/methods/ftp/install.pl
@@ -20,6 +20,7 @@ use strict;
 use warnings;
 
 eval q{
+    pop @INC if $INC[-1] eq '.';
     use Net::FTP;
     use File::Path qw(make_path remove_tree);
     use File::Basename;
diff --git a/dselect/methods/ftp/setup.pl b/dselect/methods/ftp/setup.pl
index 0e661cf..18a5832 100755
--- a/dselect/methods/ftp/setup.pl
+++ b/dselect/methods/ftp/setup.pl
@@ -19,7 +19,10 @@
 use strict;
 use warnings;
 
-eval 'use Net::FTP;';
+eval q{
+    pop @INC if $INC[-1] eq '.';
+    use Net::FTP;
+};
 if ($@) {
     warn "Please install the 'perl' package if you want to use the\n" .
          "FTP access method of dselect.\n\n";
diff --git a/dselect/methods/ftp/update.pl b/dselect/methods/ftp/update.pl
index 4a81366..68f7a67 100755
--- a/dselect/methods/ftp/update.pl
+++ b/dselect/methods/ftp/update.pl
@@ -19,7 +19,10 @@
 use strict;
 use warnings;
 
-eval 'use Net::FTP;';
+eval q{
+    pop @INC if $INC[-1] eq '.';
+    use Net::FTP;
+};
 if ($@) {
     warn "Please install the 'perl' package if you want to use the\n" .
          "FTP access method of dselect.\n\n";
diff --git a/scripts/Dpkg/Changelog/Parse.pm b/scripts/Dpkg/Changelog/Parse.pm
index b57b7d9..68777b4 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 c6ae326..075238e 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 7be03d4..aa5aeb8 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 d0d1f12..6dc2039 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 f40ed27..96f81cf 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 eacab5f..c66b721 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 {

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/reproducible/dpkg.git