diff options
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_generic.pm')
-rw-r--r-- | systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_generic.pm | 33 |
1 files changed, 30 insertions, 3 deletions
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_generic.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_generic.pm index 9ff33b2142..50bc7d27df 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_generic.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_generic.pm @@ -8,13 +8,33 @@ use parent qw(URI URI::_query); use URI::Escape qw(uri_unescape); use Carp (); -our $VERSION = '5.10'; +our $VERSION = '5.27'; -my $ACHAR = $URI::uric; $ACHAR =~ s,\\[/?],,g; -my $PCHAR = $URI::uric; $PCHAR =~ s,\\[?],,g; +my $ACHAR = URI::HAS_RESERVED_SQUARE_BRACKETS ? $URI::uric : $URI::uric4host; $ACHAR =~ s,\\[/?],,g; +my $PCHAR = $URI::uric; $PCHAR =~ s,\\[?],,g; sub _no_scheme_ok { 1 } +our $IPv6_re; + +sub _looks_like_raw_ip6_address { + my $addr = shift; + + if ( !$IPv6_re ) { #-- lazy / runs once / use Regexp::IPv6 if installed + eval { + require Regexp::IPv6; + Regexp::IPv6->import( qw($IPv6_re) ); + 1; + } || do { $IPv6_re = qr/[:0-9a-f]{3,}/; }; #-- fallback: unambitious guess + } + + return 0 unless $addr; + return 0 if $addr =~ tr/:/:/ < 2; #-- fallback must not create false positive for IPv4:Port = 0:0 + return 1 if $addr =~ /^$IPv6_re$/i; + return 0; +} + + sub authority { my $self = shift; @@ -26,6 +46,13 @@ sub authority my $rest = $3; if (defined $auth) { $auth =~ s/([^$ACHAR])/ URI::Escape::escape_char($1)/ego; + if ( my ($user, $host) = $auth =~ /^(.*@)?([^@]+)$/ ) { #-- special escape userinfo part + $user ||= ''; + $user =~ s/([^$URI::uric4user])/ URI::Escape::escape_char($1)/ego; + $user =~ s/%40$/\@/; # recover final '@' + $host = "[$host]" if _looks_like_raw_ip6_address( $host ); + $auth = $user . $host; + } utf8::downgrade($auth); $$self .= "//$auth"; } |