aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--interimap.14
-rw-r--r--lib/Net/IMAP/InterIMAP.pm43
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);
}