IPv6 support in upload and download module

This commit is contained in:
Jamie Cameron
2010-11-20 10:01:51 -08:00
parent 2656513b89
commit ed54b279cf
2 changed files with 13 additions and 10 deletions

View File

@@ -13,11 +13,9 @@ $i = 0;
@urls || &error($text{'download_enone'});
foreach $u (@urls) {
local ($proto, $host, $port, $page, $ssl);
if ($u =~ /^(http|https):\/\/([^\/]+)(\/.*)$/) {
$proto = "http";
$ssl = $1 eq 'https';
$host = $2; $page = $3; $port = $ssl ? 443 : 80;
if ($host =~ /^(.*):(\d+)$/) { $host = $1; $port = $2; }
if ($u =~ /^http/) {
($host, $port, $page, $ssl, $user, $pass) = &parse_http_url($u);
$proto = $ssl ? "https" : "http";
}
elsif ($u =~ /^ftp:\/\/([^\/]+)(:21)?(\/.*)$/) {
$proto = "ftp";

View File

@@ -7430,16 +7430,21 @@ return substr($file, 0, length($dir)) eq $dir;
=head2 parse_http_url(url, [basehost, baseport, basepage, basessl])
Given an absolute URL, returns the host, port, page and ssl flag components.
If a username and password are given before the hostname, return those too.
Relative URLs can also be parsed, if the base information is provided.
=cut
sub parse_http_url
{
if ($_[0] =~ /^(http|https):\/\/\[([^\]]+)\](:(\d+))?(\/\S*)?$/ ||
$_[0] =~ /^(http|https):\/\/([^:\/]+)(:(\d+))?(\/\S*)?$/) {
if ($_[0] =~ /^(http|https):\/\/([^\@]+\@)?\[([^\]]+)\](:(\d+))?(\/\S*)?$/ ||
$_[0] =~ /^(http|https):\/\/([^\@]+\@)?([^:\/]+)(:(\d+))?(\/\S*)?$/) {
# An absolute URL
my $ssl = $1 eq 'https';
return ($2, $3 ? $4 : $ssl ? 443 : 80, $5 || "/", $ssl);
my @rv = ($3, $4 ? $5 : $ssl ? 443 : 80, $6 || "/", $ssl);
if ($2 =~ /^([^:]+):(\S+)\@/) {
push(@rv, $1, $2);
}
return @rv;
}
elsif (!$_[1]) {
# Could not parse
@@ -7447,13 +7452,13 @@ elsif (!$_[1]) {
}
elsif ($_[0] =~ /^\/\S*$/) {
# A relative to the server URL
return ($_[1], $_[2], $_[0], $_[4]);
return ($_[1], $_[2], $_[0], $_[4], $_[5], $_[6]);
}
else {
# A relative to the directory URL
my $page = $_[3];
$page =~ s/[^\/]+$//;
return ($_[1], $_[2], $page.$_[0], $_[4]);
return ($_[1], $_[2], $page.$_[0], $_[4], $_[5], $_[6]);
}
}