From 17b263c49df682fc45f0e50cceb01db4366ad9a7 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Thu, 10 Dec 2020 14:28:29 +0100 Subject: libinterimap: show the matching pinned SPKI in --debug mode. --- lib/Net/IMAP/InterIMAP.pm | 1 + 1 file changed, 1 insertion(+) (limited to 'lib/Net/IMAP/InterIMAP.pm') diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index 1a71f59..849dc0f 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -1635,6 +1635,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; } -- cgit v1.2.3 From 84d1829fd0f955cf9fb7add54f60fc314b0d42b1 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Thu, 10 Dec 2020 15:26:46 +0100 Subject: libinterimap: factor out hostname/IP parsing. Also, document that enclosing 'host' value in square brackets forces its interpretation as an IP literal (hence skips name resolution). --- lib/Net/IMAP/InterIMAP.pm | 61 ++++++++++++++++++++++++++++++++--------------- 1 file changed, 42 insertions(+), 19 deletions(-) (limited to 'lib/Net/IMAP/InterIMAP.pm') 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; -- cgit v1.2.3 From 265f133600e9812726a52ea3067409ed3578e882 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Thu, 10 Dec 2020 19:39:10 +0100 Subject: libinterimap: make SSL_verify check the hostname as well. More precisely, ensure that the certificate Subject Alternative Name (SAN) or Subject CommonName (CN) matches the hostname or IP literal specified by the 'host' option. Previously it was only verifying the chain of trust. This bumps the minimum Net::SSLeay version to 1.83 and OpenSSL version 1.0.2. --- lib/Net/IMAP/InterIMAP.pm | 32 +++++++++++++++++++++++++++----- 1 file changed, 27 insertions(+), 5 deletions(-) (limited to 'lib/Net/IMAP/InterIMAP.pm') diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index e3a539d..a0efcc1 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 @@ -1691,6 +1691,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(); @@ -1733,25 +1734,46 @@ 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; + 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 + my $host = $self->{host} // $self->panic(); + my ($hostip, $hostipfam) = _parse_hostip($host); + 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"); $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); -- cgit v1.2.3 From 4ed6f0982cc0553e31e7beadf441beb8573a07d4 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Thu, 10 Dec 2020 21:52:44 +0100 Subject: libinterimap: add support for the TLS SNI (Server Name Indication) extension. This is controlled by the new 'SSL_hostname' option. The default value of that option is the value of the 'host' option when it is hostname, and the empty string (which disables SNI) when it is an IP literal. --- lib/Net/IMAP/InterIMAP.pm | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) (limited to 'lib/Net/IMAP/InterIMAP.pm') diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index a0efcc1..e3a5d31 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -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/, @@ -1739,6 +1740,8 @@ sub _start_ssl($$) { $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) { # for X509_VERIFY_PARAM_set1_{ip,host}() $self->panic("Failed requirement libssl >=1.0.2") if $openssl_version < 0x1000200f; @@ -1751,8 +1754,6 @@ sub _start_ssl($$) { } # verify DNS hostname or IP literal - my $host = $self->{host} // $self->panic(); - my ($hostip, $hostipfam) = _parse_hostip($host); if (defined $hostipfam) { my $addr = Socket::inet_pton($hostipfam, $hostip) // $self->panic(); $self->_ssl_error("X509_VERIFY_PARAM_set1_ip()") @@ -1770,6 +1771,16 @@ sub _start_ssl($$) { 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() 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(); -- cgit v1.2.3 From dc7282c9b9ee45fbc457f1d17cf8368fb9d36926 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Thu, 10 Dec 2020 22:50:00 +0100 Subject: typofix --- lib/Net/IMAP/InterIMAP.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lib/Net/IMAP/InterIMAP.pm') diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index e3a5d31..fff1570 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -1617,7 +1617,7 @@ sub _proxify($$$$) { return $socket; } else { - $self->error("Unsupported proxy protocol $proto"); + $self->fail("Unsupported proxy protocol $proto"); } } -- cgit v1.2.3