diff options
| -rw-r--r-- | interimap.1 | 4 | ||||
| -rw-r--r-- | lib/Net/IMAP/InterIMAP.pm | 43 |
2 files changed, 24 insertions, 23 deletions
diff --git a/interimap.1 b/interimap.1 index d0c5474..60493f3 100644 --- a/interimap.1 +++ b/interimap.1 @@ -317,8 +317,8 @@ Fingerprint of the server certificate (or its public key) in the form \fIALGO\fR$\fIDIGEST_HEX\fR, where \fIALGO\fR is the used algorithm (default \(lqsha256\(rq). Attempting to connect to a server with a non-matching certificate -fingerprint causes \fBInterIMAP\fR to abort the connection immediately -after the SSL/TLS handshake. +fingerprint causes \fBInterIMAP\fR to abort the connection during the +SSL/TLS handshake. .TP .I SSL_verify diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index f54f239..bf33294 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -1380,7 +1380,8 @@ sub _ssl_verify($$$) { $self->log(' Subject Name: ', Net::SSLeay::X509_NAME_oneline(Net::SSLeay::X509_get_subject_name($cert))); } - if ($depth == 0) { + $ok = 1 unless $self->{SSL_verify} // 1; + if ($depth == 0 and !exists $self->{_SSL_PEER_VERIFIED}) { if ($self->{debug}) { my $algo = 'sha256'; my $type = Net::SSLeay::EVP_get_digestbyname($algo) @@ -1388,6 +1389,21 @@ sub _ssl_verify($$$) { $self->log('Peer certificate fingerprint: ' .$algo.'$'.unpack('H*', Net::SSLeay::X509_digest($cert, $type))); } + + if (defined (my $fpr = $self->{SSL_fingerprint})) { + (my $algo, $fpr) = $fpr =~ /^([^\$]+)\$(.*)/ ? ($1, $2) : ('sha256', $fpr); + my $digest = pack 'H*', ($fpr =~ tr/://rd); + + my $type = Net::SSLeay::EVP_get_digestbyname($algo) + or $self->_ssl_error("Can't find MD value for name '$algo'"); + + if (Net::SSLeay::X509_digest($cert, $type) ne $digest and + Net::SSLeay::X509_pubkey_digest($cert, $type) ne $digest) { + $self->warn("Fingerprint doesn't match! MiTM in action?"); + $ok = 0; + } + } + $self->{_SSL_PEER_VERIFIED} = $ok; } return $ok; # 1=accept cert, 0=reject } @@ -1426,17 +1442,18 @@ 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(), sub($$) {$self->_ssl_verify(@_)}); - Net::SSLeay::CTX_set_purpose($ctx, Net::SSLeay::X509_PURPOSE_SSL_SERVER()) - or $self->_ssl_error("Can't set purpose"); } else { - Net::SSLeay::CTX_set_verify($ctx, Net::SSLeay::VERIFY_NONE()); + 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(@_)}); 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 if ($self->{debug}) { my $v = Net::SSLeay::version($ssl); @@ -1452,22 +1469,6 @@ sub _start_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); - my $digest = pack 'H*', ($fpr =~ tr/://rd); - - my $type = Net::SSLeay::EVP_get_digestbyname($algo) - or $self->_ssl_error("Can't find MD value for name '$algo'"); - - my $cert = Net::SSLeay::get_peer_certificate($ssl) - or $self->_ssl_error("Can't get peer certificate"); - - $self->fail("Fingerprint doesn't match! MiTM in action?") - if Net::SSLeay::X509_digest($cert, $type) ne $digest and - Net::SSLeay::X509_pubkey_digest($cert, $type) ne $digest; - } - @$self{qw/_SSL _SSL_CTX/} = ($ssl, $ctx); } |