In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/c5bdcad0231d784705e8d314ec6a87a1c6d2ae59?hp=45c198c1bc981a507ab719edbd292922a896a397>
- Log ----------------------------------------------------------------- commit c5bdcad0231d784705e8d314ec6a87a1c6d2ae59 Author: Steve Hay <[email protected]> Date: Wed Aug 10 17:30:48 2016 +0100 Upgrade File-Fetch from version 0.48_01 to 0.50 ----------------------------------------------------------------------- Summary of changes: Porting/Maintainers.pl | 6 +----- cpan/File-Fetch/lib/File/Fetch.pm | 39 ++++++++++++++++++++++++--------------- cpan/File-Fetch/t/01_File-Fetch.t | 7 ++++--- t/porting/customized.dat | 1 - 4 files changed, 29 insertions(+), 24 deletions(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index fc0e62d..1992106 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 de2ab12..108e658 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 = '[email protected]'; @@ -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 b4443e6..76efd11 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:[email protected]/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 148d788..7333b95 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 -- Perl5 Master Repository
