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

@@ -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:

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;

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";

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";

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();
     };

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)

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_ {

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";

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();
         };

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 {