Merge tag 'v0.5.4' into debian/latest

Release version 0.5.4

1 files changed, 82 insertions, 25 deletions

diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index 1a71f59..fff1570 100644
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -24,7 +24,7 @@ use strict;
 use Compress::Raw::Zlib qw/Z_OK Z_STREAM_END Z_FULL_FLUSH Z_SYNC_FLUSH MAX_WBITS/;
 use Config::Tiny ();
 use Errno qw/EEXIST EINTR/;
-use Net::SSLeay 1.73 ();
+use Net::SSLeay 1.83 ();
 use List::Util qw/all first/;
 use POSIX ':signal_h';
 use Socket qw/SOCK_STREAM SOCK_RAW SOCK_CLOEXEC IPPROTO_TCP SHUT_RDWR
@@ -65,6 +65,7 @@ my %OPTIONS = (
     SSL_protocols => qr/\A(!?$RE_SSL_PROTO(?: !?$RE_SSL_PROTO)*)\z/,
     SSL_fingerprint => qr/\A((?:[A-Za-z0-9]+\$)?\p{AHex}+(?: (?:[A-Za-z0-9]+\$)?\p{AHex}+)*)\z/,
     SSL_cipherlist => qr/\A(\P{Control}+)\z/,
+    SSL_hostname => qr/\A(\P{Control}*)\z/,
     SSL_verify => qr/\A(YES|NO)\z/i,
     SSL_CApath => qr/\A(\P{Control}+)\z/,
     SSL_CAfile => qr/\A(\P{Control}+)\z/,
@@ -1446,23 +1447,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 +1537,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 +1570,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;
@@ -1593,7 +1617,7 @@ sub _proxify($$$$) {
         return $socket;
     }
     else {
-        $self->error("Unsupported proxy protocol $proto");
+        $self->fail("Unsupported proxy protocol $proto");
     }
 }
 
@@ -1635,6 +1659,7 @@ sub _ssl_verify($$$) {
 
                 my $pkey = Net::SSLeay::X509_get_X509_PUBKEY($cert);
                 if (defined $pkey and Net::SSLeay::EVP_Digest($pkey, $type) eq $digest) {
+                    $self->log('Peer certificate matches pinned SPKI digest ', $algo .'$'. $fpr) if $self->{debug};
                     $rv = 1;
                     last;
                 }
@@ -1667,6 +1692,7 @@ BEGIN {
 #   Upgrade the $socket to SSL/TLS.
 sub _start_ssl($$) {
     my ($self, $socket) = @_;
+    my $openssl_version = Net::SSLeay::OPENSSL_VERSION_NUMBER();
     my $ctx = Net::SSLeay::CTX_new() or $self->panic("Failed to create SSL_CTX $!");
     my $ssl_options = Net::SSLeay::OP_SINGLE_DH_USE() | Net::SSLeay::OP_SINGLE_ECDH_USE();
 
@@ -1709,25 +1735,56 @@ sub _start_ssl($$) {
             or $self->_ssl_error("Can't set cipher list");
     }
 
+    my $vpm = Net::SSLeay::X509_VERIFY_PARAM_new() or $self->_ssl_error("X509_VERIFY_PARAM_new()");
+    my $purpose = Net::SSLeay::X509_PURPOSE_SSL_SERVER();
+    $self->_ssl_error("X509_VERIFY_PARAM_set_purpose()") unless Net::SSLeay::X509_VERIFY_PARAM_set_purpose($vpm, $purpose) == 1;
+    $self->_ssl_error("CTX_set_purpose()") unless Net::SSLeay::CTX_set_purpose($ctx, $purpose) == 1;
+
+    my $host = $self->{host} // $self->panic();
+    my ($hostip, $hostipfam) = _parse_hostip($host);
     if ($self->{SSL_verify} // 1) {
-        # verify the certificate chain
+        # for X509_VERIFY_PARAM_set1_{ip,host}()
+        $self->panic("Failed requirement libssl >=1.0.2") if $openssl_version < 0x1000200f;
+
+        # verify certificate chain
         my ($file, $path) = ($self->{SSL_CAfile} // '', $self->{SSL_CApath} // '');
         if ($file ne '' or $path ne '') {
             Net::SSLeay::CTX_load_verify_locations($ctx, $file, $path)
                 or $self->_ssl_error("Can't load verify locations");
         }
+
+        # verify DNS hostname or IP literal
+        if (defined $hostipfam) {
+            my $addr = Socket::inet_pton($hostipfam, $hostip) // $self->panic();
+            $self->_ssl_error("X509_VERIFY_PARAM_set1_ip()")
+                unless Net::SSLeay::X509_VERIFY_PARAM_set1_ip($vpm, $addr) == 1;
+        } else {
+            $self->_ssl_error("X509_VERIFY_PARAM_set1_host()")
+                unless Net::SSLeay::X509_VERIFY_PARAM_set1_host($vpm, $host) == 1;
+        }
     }
     else {
         Net::SSLeay::CTX_set_verify_depth($ctx, 0);
     }
-    Net::SSLeay::CTX_set_purpose($ctx, Net::SSLeay::X509_PURPOSE_SSL_SERVER())
-        or $self->_ssl_error("Can't set purpose");
     Net::SSLeay::CTX_set_verify($ctx, Net::SSLeay::VERIFY_PEER(), sub($$) {$self->_ssl_verify(@_)});
+    $self->_ssl_error("CTX_SSL_set1_param()") unless Net::SSLeay::CTX_set1_param($ctx, $vpm) == 1;
 
     my $ssl = Net::SSLeay::new($ctx) or $self->fail("Can't create new SSL structure");
     Net::SSLeay::set_fd($ssl, fileno $socket) or $self->fail("SSL filehandle association failed");
+
+    # always use 'SSL_hostname' when set, otherwise use 'host' (unless it's an IP) on OpenSSL >=0.9.8f
+    my $servername = $self->{SSL_hostname} // (defined $hostipfam ? "" : $host);
+    if ($servername ne "") {
+        $self->panic("Failed requirement libssl >=0.9.8f") if $openssl_version < 0x00908070;
+        $self->_ssl_error("Can't set TLS servername extension (value $servername)")
+            unless Net::SSLeay::set_tlsext_host_name($ssl, $servername) == 1;
+        $self->log("Using SNI with name $servername") if $self->{debug};
+    }
+
     $self->_ssl_error("Can't initiate TLS/SSL handshake") unless Net::SSLeay::connect($ssl) == 1;
-    $self->panic("Couldn't verify") unless $self->{_SSL_PEER_VERIFIED}; # sanity check
+    $self->panic() unless $self->{_SSL_PEER_VERIFIED}; # sanity check
+    $self->panic() if ($self->{SSL_verify} // 1) and Net::SSLeay::get_verify_result($ssl) != Net::SSLeay::X509_V_OK();
+    Net::SSLeay::X509_VERIFY_PARAM_free($vpm);
 
     if ($self->{debug}) {
         my $v = Net::SSLeay::version($ssl);