diff options
| -rw-r--r-- | Changelog | 2 | ||||
| -rw-r--r-- | lib/Net/IMAP/InterIMAP.pm | 45 |
2 files changed, 46 insertions, 1 deletions
@@ -26,6 +26,8 @@ interimap (0.2) upstream; in our case since the TCP keepalive time is usually much higher than the IMAP timeout. * Set X.509 certificate purpose to 'SSL Server' for SSL_verify=YES. + * Display the certificate chain, SSL protocol and cipher in debug + mode. -- Guilhem Moulin <guilhem@guilhem.org> Wed, 09 Sep 2015 00:44:35 +0200 diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index 53fddec..f54f239 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -1364,6 +1364,35 @@ sub _proxify($$$$) { } +# $self->_ssl_verify($self, $preverify_ok, $x509_ctx) +# SSL verify callback function, see +# https://www.openssl.org/docs/manmaster/ssl/SSL_CTX_set_verify.html +sub _ssl_verify($$$) { + my ($self, $ok, $x509_ctx) = @_; + return 0 unless $x509_ctx; # reject + + my $depth = Net::SSLeay::X509_STORE_CTX_get_error_depth($x509_ctx); + my $cert = Net::SSLeay::X509_STORE_CTX_get_current_cert($x509_ctx) + or $self->_ssl_error("Can't get current certificate"); + if ($self->{debug}) { + $self->log("[$depth] preverify=$ok"); + $self->log(' Issuer Name: ', Net::SSLeay::X509_NAME_oneline(Net::SSLeay::X509_get_issuer_name($cert))); + $self->log(' Subject Name: ', Net::SSLeay::X509_NAME_oneline(Net::SSLeay::X509_get_subject_name($cert))); + } + + if ($depth == 0) { + if ($self->{debug}) { + my $algo = 'sha256'; + my $type = Net::SSLeay::EVP_get_digestbyname($algo) + or $self->_ssl_error("Can't find MD value for name '$algo'"); + $self->log('Peer certificate fingerprint: ' + .$algo.'$'.unpack('H*', Net::SSLeay::X509_digest($cert, $type))); + } + } + return $ok; # 1=accept cert, 0=reject +} + + # $self->_start_ssl($socket) # Upgrade the $socket to SSL/TLS. sub _start_ssl($$) { @@ -1397,7 +1426,7 @@ sub _start_ssl($$) { Net::SSLeay::CTX_load_verify_locations($ctx, $file, $path) or $self->_ssl_error("Can't load verify locations"); } - Net::SSLeay::CTX_set_verify($ctx, Net::SSLeay::VERIFY_PEER()); + Net::SSLeay::CTX_set_verify($ctx, Net::SSLeay::VERIFY_PEER(), sub($$) {$self->_ssl_verify(@_)}); Net::SSLeay::CTX_set_purpose($ctx, Net::SSLeay::X509_PURPOSE_SSL_SERVER()) or $self->_ssl_error("Can't set purpose"); } @@ -1409,6 +1438,20 @@ sub _start_ssl($$) { 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; + if ($self->{debug}) { + my $v = Net::SSLeay::version($ssl); + $self->log(sprintf('SSL protocol: %s (0x%x)', ($v == 0x0002 ? 'SSLv2' : + $v == 0x0300 ? 'SSLv3' : + $v == 0x0301 ? 'TLSv1' : + $v == 0x0302 ? 'TLSv1.1' : + $v == 0x0303 ? 'TLSv1.2' : + '??'), + $v)); + $self->log(sprintf('SSL cipher: %s (%d bits)' + , Net::SSLeay::get_cipher($ssl) + , Net::SSLeay::get_cipher_bits($ssl))); + } + if (defined (my $fpr = $self->{SSL_fingerprint})) { # ensure we're talking to the right server (my $algo, $fpr) = $fpr =~ /^([^\$]+)\$(.*)/ ? ($1, $2) : ('sha256', $fpr); |