Upgrade File-Fetch from version 0.48_01 to 0.50

4 files changed, 29 insertions, 24 deletions

diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl
index fc0e62d553..1992106414 100755
--- a/Porting/Maintainers.pl
+++ b/Porting/Maintainers.pl
@@ -519,12 +519,8 @@ use File::Glob qw(:case);
     },
 
     'File::Fetch' => {
-        'DISTRIBUTION' => 'BINGOS/File-Fetch-0.48.tar.gz',
+        'DISTRIBUTION' => 'BINGOS/File-Fetch-0.50.tar.gz',
         'FILES'        => q[cpan/File-Fetch],
-        'CUSTOMIZED'   => [
-            # CVE-2016-1238
-            qw( lib/File/Fetch.pm )
-        ],
     },
 
     'File::Path' => {
diff --git a/cpan/File-Fetch/lib/File/Fetch.pm b/cpan/File-Fetch/lib/File/Fetch.pm
index de2ab12336..108e658f89 100644
--- a/cpan/File-Fetch/lib/File/Fetch.pm
+++ b/cpan/File-Fetch/lib/File/Fetch.pm
@@ -22,7 +22,7 @@ use vars    qw[ $VERBOSE $PREFER_BIN $FROM_EMAIL $USER_AGENT
                 $FTP_PASSIVE $TIMEOUT $DEBUG $WARN $FORCEIPV4
             ];
 
-$VERSION        = '0.48_01';
+$VERSION        = '0.50';
 $VERSION        = eval $VERSION;    # avoid warnings with development releases
 $PREFER_BIN     = 0;                # XXX TODO implement
 $FROM_EMAIL     = 'File-Fetch@example.com';
@@ -39,6 +39,7 @@ $FORCEIPV4      = 0;
 ### methods available to fetch the file depending on the scheme
 $METHODS = {
     http    => [ qw|lwp httptiny wget curl lftp fetch httplite lynx iosock| ],
+    https   => [ qw|lwp wget curl| ],
     ftp     => [ qw|lwp netftp wget curl lftp fetch ncftp ftp| ],
     file    => [ qw|lwp lftp file| ],
     rsync   => [ qw|rsync| ],
@@ -51,6 +52,9 @@ local $Params::Check::VERBOSE               = 1;
 local $Module::Load::Conditional::VERBOSE   = 0;
 local $Module::Load::Conditional::VERBOSE   = 0;
 
+### Fix CVE-2016-1238 ###
+local $Module::Load::Conditional::FORCE_SAFE_INC = 1;
+
 ### see what OS we are on, important for file:// uris ###
 use constant ON_WIN     => ($^O eq 'MSWin32');
 use constant ON_VMS     => ($^O eq 'VMS');
@@ -164,6 +168,7 @@ http://www.abc.net.au/ the contents retrieved may be from a remote file called
         path            => { default => '/' },
         file            => { required => 1 },
         uri             => { required => 1 },
+        userinfo        => { default => '' },
         vol             => { default => '' }, # windows for file:// uris
         share           => { default => '' }, # windows for file:// uris
         file_default    => { default => 'file_default' },
@@ -401,7 +406,7 @@ sub _parse_uri {
     } else {
         ### using anything but qw() in hash slices may produce warnings
         ### in older perls :-(
-        @{$href}{ qw(host path) } = $uri =~ m|([^/]*)(/.*)$|s;
+        @{$href}{ qw(userinfo host path) } = $uri =~ m|(?:([^\@:]*:[^\:\@]*)@)?([^/]*)(/.*)$|s;
     }
 
     ### split the path into file + dir ###
@@ -567,8 +572,10 @@ sub _lwp_fetch {
 
     };
 
-    local @INC = @INC;
-    pop @INC if $INC[-1] eq '.';
+    if ($self->scheme eq 'https') {
+        $use_list->{'LWP::Protocol::https'} = '0';
+    }
+
     unless( can_load( modules => $use_list ) ) {
         $METHOD_FAIL->{'lwp'} = 1;
         return;
@@ -582,7 +589,12 @@ sub _lwp_fetch {
     ### special rules apply for file:// uris ###
     $uri->scheme( $self->scheme );
     $uri->host( $self->scheme eq 'file' ? '' : $self->host );
-    $uri->userinfo("anonymous:$FROM_EMAIL") if $self->scheme ne 'file';
+
+    if ($self->userinfo) {
+        $uri->userinfo($self->userinfo);
+    } elsif ($self->scheme ne 'file') {
+        $uri->userinfo("anonymous:$FROM_EMAIL");
+    }
 
     ### set up the useragent object
     my $ua = LWP::UserAgent->new();
@@ -621,8 +633,6 @@ sub _httptiny_fetch {
 
     };
 
-    local @INC = @INC;
-    pop @INC if $INC[-1] eq '.';
     unless( can_load(modules => $use_list) ) {
         $METHOD_FAIL->{'httptiny'} = 1;
         return;
@@ -659,11 +669,9 @@ sub _httplite_fetch {
     ### modules required to download with lwp ###
     my $use_list = {
         'HTTP::Lite'    => '2.2',
-
+        'MIME::Base64'  => '0',
     };
 
-    local @INC = @INC;
-    pop @INC if $INC[-1] eq '.';
     unless( can_load(modules => $use_list) ) {
         $METHOD_FAIL->{'httplite'} = 1;
         return;
@@ -679,6 +687,11 @@ sub _httplite_fetch {
       $http->{timeout} = $TIMEOUT if $TIMEOUT;
       $http->http11_mode(1);
 
+      if ($self->userinfo) {
+          my $encoded = MIME::Base64::encode($self->userinfo, '');
+          $http->add_req_header("Authorization", "Basic $encoded");
+      }
+
       my $fh = FileHandle->new;
 
       unless ( $fh->open($to,'>') ) {
@@ -739,8 +752,6 @@ 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;
@@ -822,8 +833,6 @@ 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 ) ) {
@@ -1512,7 +1521,7 @@ Below is a mapping of what utilities will be used in what order
 for what schemes, if available:
 
     file    => LWP, lftp, file
-    http    => LWP, HTTP::Lite, wget, curl, lftp, fetch, lynx, iosock
+    http    => LWP, HTTP::Tiny, wget, curl, lftp, fetch, HTTP::Lite, lynx, iosock
     ftp     => LWP, Net::FTP, wget, curl, lftp, fetch, ncftp, ftp
     rsync   => rsync
     git     => git
diff --git a/cpan/File-Fetch/t/01_File-Fetch.t b/cpan/File-Fetch/t/01_File-Fetch.t
index b4443e658b..76efd1179e 100644
--- a/cpan/File-Fetch/t/01_File-Fetch.t
+++ b/cpan/File-Fetch/t/01_File-Fetch.t
@@ -176,13 +176,13 @@ for my $entry (@map) {
 ### Heuristics
 {
   require IO::Socket::INET;
-  my $sock = IO::Socket::INET->new( PeerAddr => 'ftp.funet.fi', PeerPort => 21, Timeout => 20 )
+  my $sock = IO::Socket::INET->new( PeerAddr => 'mirror.bytemark.co.uk', PeerPort => 21, Timeout => 20 )
      or $heuristics{ftp} = 0;
 }
 
 ### ftp:// tests ###
-{   my $uri = 'ftp://ftp.funet.fi/pub/CPAN/index.html';
-    for (qw[lwp netftp wget curl lftp fetch ncftp]) {
+{   my $uri = 'ftp://mirror.bytemark.co.uk/CPAN/index.html';
+    for (qw[wget curl lftp fetch ncftp]) {
 
         ### STUPID STUPID warnings ###
         next if $_ eq 'ncftp' and $File::Fetch::FTP_PASSIVE
@@ -203,6 +203,7 @@ for my $entry (@map) {
 {   for my $uri ( 'http://www.cpan.org/index.html',
                   'http://www.cpan.org/index.html?q=1',
                   'http://www.cpan.org/index.html?q=1&y=2',
+                  'http://user:passwd@httpbin.org/basic-auth/user/passwd',
     ) {
         for (qw[lwp httptiny wget curl lftp fetch lynx httplite iosock]) {
             _fetch_uri( http => $uri, $_ );
diff --git a/t/porting/customized.dat b/t/porting/customized.dat
index 148d78803b..7333b9594f 100644
--- a/t/porting/customized.dat
+++ b/t/porting/customized.dat
@@ -11,7 +11,6 @@ Encode cpan/Encode/t/enc_utf8.t 7d1c9a4260c0c6b263eff30539e591c417e602a9
 Encode cpan/Encode/t/encoding.t ed051c17c92510713b24217c22384815088834a8
 Encode cpan/Encode/t/jperl.t 584a3813e7bc680ee6ec1d54253bbf861bda8215
 ExtUtils::Constant cpan/ExtUtils-Constant/t/Constant.t a0369c919e216fb02767a637666bb4577ad79b02
-File::Fetch cpan/File-Fetch/lib/File/Fetch.pm bd0b64a1d8ee2ffac39e017f9fa9f78f95514b4d
 File::Path cpan/File-Path/lib/File/Path.pm fd8ce4420a0c113d3f47dd3223859743655c1da8
 File::Path cpan/File-Path/t/Path_win32.t 94b9276557ce7f80b91f6fd9bfa7a0cd9bf9683e
 HTTP::Tiny cpan/HTTP-Tiny/lib/HTTP/Tiny.pm 5c418f455ac27283d5728ecb166707e6eb0e359c