Skip to content

cpan/File-Fetch - Update to version 1.08 #23236

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 1 commit into
base: blead
Choose a base branch
from
+47 −24
Open

cpan/File-Fetch - Update to version 1.08 #23236

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion MANIFEST
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
3 changes: 2 additions & 1 deletion Porting/Maintainers.pl
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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],
},

Expand Down
38 changes: 29 additions & 9 deletions cpan/File-Fetch/lib/File/Fetch.pm
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
package File::Fetch;

use strict;
use warnings;
use FileHandle;
use File::Temp;
use File::Copy;
Expand All @@ -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 = '[email protected]';
Expand All @@ -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| ],
Expand All @@ -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

Expand Down Expand Up @@ -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;
}

Expand Down Expand Up @@ -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,
Expand Down Expand Up @@ -569,17 +575,24 @@ 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 ) ) {
$METHOD_FAIL->{'lwp'} = 1;
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
Expand Down Expand Up @@ -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;

Expand Down Expand Up @@ -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;

Expand Down
28 changes: 15 additions & 13 deletions cpan/File-Fetch/t/01_File-Fetch.t
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
BEGIN { chdir 't' if -d 't' };

use strict;
use warnings;
use lib '../lib';

use Test::More 'no_plan';
Expand All @@ -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[
Expand Down Expand Up @@ -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',
Expand Down Expand Up @@ -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:[email protected]/basic-auth/user/passwd',
) {
Expand Down Expand Up @@ -300,11 +310,3 @@ sub _fetch_uri {
}}
}
}








Loading