summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/File/Fetch.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/File/Fetch.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/File/Fetch.pm39
1 files changed, 24 insertions, 15 deletions
diff --git a/Master/tlpkg/tlperl/lib/File/Fetch.pm b/Master/tlpkg/tlperl/lib/File/Fetch.pm
index de2ab123363..acfa442841a 100644
--- a/Master/tlpkg/tlperl/lib/File/Fetch.pm
+++ b/Master/tlpkg/tlperl/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.52';
$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