From 0fb44d64a34e7031b976f9297f76e7dba38a8d52 Mon Sep 17 00:00:00 2001 From: Chris 'BinGOs' Williams Date: Thu, 1 May 2025 07:12:57 -0400 Subject: [PATCH] cpan/File-Fetch - Update to version 1.08 1.08 Mon Apr 28 17:06:58 2025 * Switched from httpbin.org to httpbingo.org 1.06 Mon Apr 28 16:49:13 2025 * httpbin.org is being a bit unreliable at the moment and highlighted that lftp is like the little engine that could and it will keep trying and trying. Added restrictions to how many times it will retry. --- MANIFEST | 2 +- Porting/Maintainers.pl | 3 ++- cpan/File-Fetch/lib/File/Fetch.pm | 38 +++++++++++++++++++++++-------- cpan/File-Fetch/t/01_File-Fetch.t | 28 ++++++++++++----------- 4 files changed, 47 insertions(+), 24 deletions(-) diff --git a/MANIFEST b/MANIFEST index b44bc5f66452..8432b316947a 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1132,7 +1132,7 @@ cpan/ExtUtils-PL2Bat/lib/ExtUtils/PL2Bat.pm Implement pl2bat cpan/ExtUtils-PL2Bat/t/make_executable.t Tests if ExtUtils::PL2Bat makes bat files that are executable cpan/File-Fetch/lib/File/Fetch.pm File::Fetch cpan/File-Fetch/t/01_File-Fetch.t File::Fetch tests -cpan/File-Fetch/t/null_subclass.t +cpan/File-Fetch/t/null_subclass.t Test file related to File::Fetch cpan/File-Path/lib/File/Path.pm Do things like 'mkdir -p' and 'rm -r' cpan/File-Path/t/FilePathTest.pm See if File::Path works cpan/File-Path/t/Path.t See if File::Path works diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index f149cbedd3b0..b68f82a0a077 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -533,7 +533,8 @@ package Maintainers; }, 'File::Fetch' => { - 'DISTRIBUTION' => 'BINGOS/File-Fetch-1.04.tar.gz', + 'DISTRIBUTION' => 'BINGOS/File-Fetch-1.08.tar.gz', + 'SYNCINFO' => 'jkeenan on Thu May 1 07:12:12 2025', 'FILES' => q[cpan/File-Fetch], }, diff --git a/cpan/File-Fetch/lib/File/Fetch.pm b/cpan/File-Fetch/lib/File/Fetch.pm index 157f308ade63..704b7e54b84f 100644 --- a/cpan/File-Fetch/lib/File/Fetch.pm +++ b/cpan/File-Fetch/lib/File/Fetch.pm @@ -1,6 +1,7 @@ package File::Fetch; use strict; +use warnings; use FileHandle; use File::Temp; use File::Copy; @@ -22,7 +23,7 @@ use vars qw[ $VERBOSE $PREFER_BIN $FROM_EMAIL $USER_AGENT $FTP_PASSIVE $TIMEOUT $DEBUG $WARN $FORCEIPV4 ]; -$VERSION = '1.04'; +$VERSION = '1.08'; $VERSION = eval $VERSION; # avoid warnings with development releases $PREFER_BIN = 0; # XXX TODO implement $FROM_EMAIL = 'File-Fetch@example.com'; @@ -39,7 +40,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| ], + https => [ qw|lwp httptiny wget curl| ], ftp => [ qw|lwp netftp wget curl lftp fetch ncftp ftp| ], file => [ qw|lwp lftp file| ], rsync => [ qw|rsync| ], @@ -58,7 +59,7 @@ use constant ON_VMS => ($^O eq 'VMS'); use constant ON_UNIX => (!ON_WIN); use constant HAS_VOL => (ON_WIN); use constant HAS_SHARE => (ON_WIN); -use constant HAS_FETCH => ( $^O =~ m!^(freebsd|netbsd|dragonfly)$! ); +use constant HAS_FETCH => ( $^O =~ m!^(freebsd|netbsd|dragonfly|midnightbsd)$! ); =pod @@ -400,9 +401,12 @@ sub _parse_uri { ### rebuild the path from the leftover parts; $href->{path} = join '/', '', splice( @parts, $index, $#parts ); - } else { + } elsif ( $href->{scheme} eq 'http' || $href->{scheme} eq 'https' ) { ### using anything but qw() in hash slices may produce warnings ### in older perls :-( + @{$href}{ qw(userinfo host path) } = $uri =~ m|(?:([^\@:]*:[^\:\@]*)@)?([^/]*)(/.*)?$|s; + $href->{path} = '/' unless defined $href->{path}; + } else { @{$href}{ qw(userinfo host path) } = $uri =~ m|(?:([^\@:]*:[^\:\@]*)@)?([^/]*)(/.*)$|s; } @@ -491,7 +495,9 @@ sub fetch { next if grep { lc $_ eq $method } @$BLACKLIST; ### method is known to fail ### - next if $METHOD_FAIL->{$method}; + next if ref $METHOD_FAIL->{$method} + ? $METHOD_FAIL->{$method}{$self->scheme} + : $METHOD_FAIL->{$method}; ### there's serious issues with IPC::Run and quoting of command ### line arguments. using quotes in the wrong place breaks things, @@ -569,10 +575,6 @@ sub _lwp_fetch { }; - if ($self->scheme eq 'https') { - $use_list->{'LWP::Protocol::https'} = '0'; - } - ### Fix CVE-2016-1238 ### local $Module::Load::Conditional::FORCE_SAFE_INC = 1; unless( can_load( modules => $use_list ) ) { @@ -580,6 +582,17 @@ sub _lwp_fetch { return; } + if ($self->scheme eq 'https') { + my $https_use_list = { + 'LWP::Protocol::https' => '0.0', + }; + + unless ( can_load(modules => $https_use_list) ) { + $METHOD_FAIL->{'lwp'} = { 'https' => 1 }; + return; + } + } + ### setup the uri object my $uri = URI->new( File::Spec::Unix->catfile( $self->path, $self->file @@ -638,6 +651,10 @@ sub _httptiny_fetch { $METHOD_FAIL->{'httptiny'} = 1; return; } + if ( $self->scheme eq 'https' && !HTTP::Tiny->can_ssl ) { + $METHOD_FAIL->{'httptiny'} = 1; + return; + } my $uri = $self->uri; @@ -962,6 +979,9 @@ sub _lftp_fetch { ### if a timeout is set, add it ### $str .= "set net:timeout $TIMEOUT;\n" if $TIMEOUT; + ### lftp can get stuck in a loop of retries without this + $str .= "set net:reconnect-interval-base 5;\nset net:max-retries 2;\n"; + ### run passive if specified ### $str .= "set ftp:passive-mode 1;\n" if $FTP_PASSIVE; diff --git a/cpan/File-Fetch/t/01_File-Fetch.t b/cpan/File-Fetch/t/01_File-Fetch.t index cdd9e504e313..015f5dc25fb4 100644 --- a/cpan/File-Fetch/t/01_File-Fetch.t +++ b/cpan/File-Fetch/t/01_File-Fetch.t @@ -1,6 +1,7 @@ BEGIN { chdir 't' if -d 't' }; use strict; +use warnings; use lib '../lib'; use Test::More 'no_plan'; @@ -16,7 +17,9 @@ use_ok('File::Fetch'); $File::Fetch::DEBUG = $File::Fetch::DEBUG = 1 if $ARGV[0]; $IPC::Cmd::DEBUG = $IPC::Cmd::DEBUG = 1 if $ARGV[0]; -$File::Fetch::FORCEIPV4=1; +$File::Fetch::FORCEIPV4 = $File::Fetch::FORCEIPV4 = 1; + +$File::Fetch::TIMEOUT = $File::Fetch::TIMEOUT = 30; unless( $ENV{PERL_CORE} ) { warn qq[ @@ -77,6 +80,12 @@ my @map = ( path => '/tmp/', file => 'index.txt', }, + { uri => 'http://localhost', # non-canonical URI + scheme => 'http', + host => 'localhost', + path => '/', # default path is '/' + file => '', + }, ### only test host part, the rest is OS dependant { uri => 'file://localhost/tmp/index.txt', @@ -195,14 +204,15 @@ for my $entry (@map) { ### Heuristics { require IO::Socket::INET; - my $sock = IO::Socket::INET->new( PeerAddr => 'httpbin.org', PeerPort => 80, Timeout => 20 ) + my $sock = IO::Socket::INET->new( PeerAddr => 'httpbingo.org', PeerPort => 80, Timeout => 20 ) or $heuristics{http} = 0; } ### http:// tests ### -{ for my $uri ( 'http://httpbin.org/html', - 'http://httpbin.org/response-headers?q=1', - 'http://httpbin.org/response-headers?q=1&y=2', +{ for my $uri ( 'http://httpbingo.org', + 'http://httpbingo.org/html', + 'http://httpbingo.org/response-headers?q=1', + 'http://httpbingo.org/response-headers?q=1&y=2', #'http://www.cpan.org/index.html?q=1&y=2', #'http://user:passwd@httpbin.org/basic-auth/user/passwd', ) { @@ -300,11 +310,3 @@ sub _fetch_uri { }} } } - - - - - - - -