diff options
Diffstat (limited to 'lib/Net')
| -rw-r--r-- | lib/Net/IMAP/InterIMAP.pm | 61 |
1 files changed, 42 insertions, 19 deletions
diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index 849dc0f..e3a539d 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -1446,23 +1446,39 @@ my $RE_IPv6 = do { | (?: (?: $h16 : ){0,6} $h16 )? :: /x }; +# Parse an IPv4 or IPv6. In list context, return a pair (IP, family), +# otherwise only the IP. If the argument is not an IP (for instance if +# it's a hostname), then return (undef, undef) resp. undef. The input +# can optionaly be enclosed in square brackets which forces its +# interpretation as an IP literal: an error is raised if it is not the +# case. +my $RE_IPv4_anchored = qr/\A($RE_IPv4)\z/; +my $RE_IPv6_anchored = qr/\A($RE_IPv6)\z/; +sub _parse_hostip($) { + my $v = shift // return; + my $literal = $v =~ s/\A\[(.*)\]\z/$1/ ? 1 : 0; + my ($ip, $af) = $v =~ $RE_IPv4_anchored ? ($1, AF_INET) + : $v =~ $RE_IPv6_anchored ? ($1, AF_INET6) + : (undef, undef); + die "Invalid IP literal: $v\n" if $literal and !defined($ip); + return wantarray ? ($ip, $af) : $ip; +} # Opens a TCP socket to the given $host and $port. sub _tcp_connect($$$) { my ($self, $host, $port) = @_; my %hints = (socktype => SOCK_STREAM, protocol => IPPROTO_TCP); - if ($host =~ qr/\A$RE_IPv4\z/) { - $hints{family} = AF_INET; - $hints{flags} |= AI_NUMERICHOST; - } elsif ($host =~ qr/\A\[($RE_IPv6)\]\z/) { - $host = $1; - $hints{family} = AF_INET6; + my ($host2, $family) = _parse_hostip($host); + if (defined $family) { + $hints{family} = $family; $hints{flags} |= AI_NUMERICHOST; + } else { + $host2 = $host; } - my ($err, @res) = getaddrinfo($host, $port, \%hints); - $self->fail("Can't getaddrinfo: $err") if $err ne ''; + my ($err, @res) = getaddrinfo($host2, $port, \%hints); + $self->fail("getaddrinfo($host2): $err") if $err ne ''; SOCKETS: foreach my $ai (@res) { @@ -1520,7 +1536,7 @@ sub _proxify($$$$) { $port = getservbyname($port, 'tcp') // $self->fail("Can't getservbyname $port") unless $port =~ /\A[0-9]+\z/; - $proxy =~ /\A([A-Za-z0-9]+):\/\/(\P{Control}*\@)?($RE_IPv4|\[$RE_IPv6\]|[^:]+)(:[A-Za-z0-9]+)?\z/ + $proxy =~ /\A([A-Za-z0-9]+):\/\/(\P{Control}*\@)?([^:]+|\[[^\]]+\])(:[A-Za-z0-9]+)?\z/ or $self->fail("Invalid proxy URI $proxy"); my ($proto, $userpass, $proxyhost, $proxyport) = ($1, $2, $3, $4); $userpass =~ s/\@\z// if defined $userpass; @@ -1553,23 +1569,30 @@ sub _proxify($$$$) { $self->fail('SOCKSv5', 'No acceptable authentication methods'); } - if ($host !~ /\A(?:$RE_IPv4|\[$RE_IPv6\])\z/ and !$resolv) { + my ($hostip, $fam) = _parse_hostip($host); + unless (defined($fam) or $resolv) { # resove the hostname $host locally my ($err, @res) = getaddrinfo($host, undef, {socktype => SOCK_RAW}); - $self->fail("Can't getaddrinfo: $err") if $err ne ''; - ($host) = first { defined $_ } map { + $self->fail("getaddrinfo($host): $err") if $err ne ''; + my ($addr) = first { defined($_) } map { my ($err, $ipaddr) = getnameinfo($_->{addr}, NI_NUMERICHOST, NIx_NOSERV); - $err eq '' ? $ipaddr : undef + $err eq '' ? [$ipaddr,$_->{family}] : undef } @res; - $self->fail("Can't getnameinfo") unless defined $host; + $self->fail("Can't getnameinfo") unless defined $addr; + ($hostip, $fam) = @$addr; } # send a CONNECT command (CMD 0x01) - my ($typ, $addr) = - $host =~ /\A$RE_IPv4\z/ ? (0x01, Socket::inet_pton(AF_INET, $host)) - : ($host =~ /\A\[($RE_IPv6)\]\z/ or $host =~ /\A($RE_IPv6)\z/) ? (0x04, Socket::inet_pton(AF_INET6, $1)) - : (0x03, pack('C',length($host)).$host); - $self->_xwrite($socket, pack('C4', $v, 0x01, 0x00, $typ).$addr.pack('n', $port)); + my ($typ, $addr); + if (defined $fam) { + $typ = $fam == AF_INET ? 0x01 : $fam == AF_INET6 ? 0x04 : $self->panic(); + $addr = Socket::inet_pton($fam, $hostip); + } else { + # let the SOCKS server do the resolution + $typ = 0x03; + $addr = pack('C',length($host)) . $host; + } + $self->_xwrite($socket, pack('C4', $v, 0x01, 0x00, $typ) . $addr . pack('n', $port)); ($v2, my $r, my $rsv, $typ) = unpack('C4', $self->_xread($socket, 4)); $self->fail('SOCKSv5', 'Invalid protocol') unless $v == $v2 and $rsv == 0x00; |