From 1aeca5f89e768df83d3f6f86e0d782e5a20fc1f6 Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem@fripost.org>
Date: Mon, 19 Oct 2015 17:14:43 +0200
Subject: Add an option 'SSL_protocols'.

---
 Changelog                 |  3 +++
 interimap.1               |  9 +++++++++
 interimap.sample          |  3 ++-
 lib/Net/IMAP/InterIMAP.pm | 37 +++++++++++++++++++++++++++++++------
 4 files changed, 45 insertions(+), 7 deletions(-)

diff --git a/Changelog b/Changelog
index f2b0bfc..cf7e678 100644
--- a/Changelog
+++ b/Changelog
@@ -1,6 +1,9 @@
 interimap (0.3) upstream;
 
   * Fix byte count for compression streams.
+  * Add an option 'SSL_protocols' to list SSL protocols to enable or
+    disable.  The default value, "!SSLv2 !SSLv3", enables only TLSv1
+    and above.
 
  -- Guilhem Moulin <guilhem@guilhem.org>  Mon, 28 Sep 2015 01:16:47 +0200
 
diff --git a/interimap.1 b/interimap.1
index 60493f3..595f4a8 100644
--- a/interimap.1
+++ b/interimap.1
@@ -304,6 +304,15 @@ Whether to redirect \fIcommand\fR's standard error to \(lq/dev/null\(rq
 for type \fItype\fR=tunnel.
 (Default: \(lqNO\(rq.)
 
+.TP
+.I SSL_protocols
+A space-separated list of SSL protocols to enable or disable (if
+prefixed with an exclamation mark \(oq!\(cq).  Known protocols are
+\(lqSSLv2\(rq, \(lqSSLv3\(rq, \(lqTLSv1\(rq, \(lqTLSv1.1\(rq, and
+\(lqTLSv1.2\(rq.  Enabling a protocol is a short-hand for disabling all
+other protocols.
+(Default: \(lq!SSLv2 !SSLv3\(rq, i.e., only enable TLSv1 and above.)
+
 .TP
 .I SSL_cipher_list
 The cipher list to send to the server.  Although the server determines
diff --git a/interimap.sample b/interimap.sample
index 6d52f91..c3919ce 100644
--- a/interimap.sample
+++ b/interimap.sample
@@ -20,7 +20,8 @@ password = xxxxxxxxxxxxxxxx
 # SSL options
 SSL_CApath = /etc/ssl/certs
 #SSL_verify = YES
-#SSL_cipherlist = EECDH+AES:EDH+AES:!MEDIUM:!LOW:!EXP:!aNULL:!eNULL:!SSLv2:!SSLv3:!TLSv1:!TLSv1.1
+#SSL_protocols = !SSLv2 !SSLv3 !TLSv1 !TLSv1.1
+#SSL_cipherlist = EECDH+AESGCM:!MEDIUM:!LOW:!EXP:!aNULL:!eNULL
 #SSL_fingerprint = sha256$62E436BB329C46A628314C49BDA7C2A2E86C57B2021B9A964B8FABB6540D3605
 
 # vim:ft=dosini
diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index 8b1f451..95bdfa8 100644
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -43,6 +43,8 @@ my $RE_ATOM_CHAR    = qr/[\x21\x23\x24\x26\x27\x2B-\x5B\x5E-\x7A\x7C-\x7E]/;
 my $RE_ASTRING_CHAR = qr/[\x21\x23\x24\x26\x27\x2B-\x5B\x5D-\x7A\x7C-\x7E]/;
 my $RE_TEXT_CHAR    = qr/[\x01-\x09\x0B\x0C\x0E-\x7F]/;
 
+my $RE_SSL_PROTO = qr/(?:SSLv[23]|TLSv1|TLSv1\.[0-2])/;
+
 # Map each option to a regexp validating its values.
 my %OPTIONS = (
     host => qr/\A(\P{Control}+)\z/,
@@ -56,6 +58,7 @@ my %OPTIONS = (
     command => qr/\A(\P{Control}+)\z/,
     'null-stderr' => qr/\A(YES|NO)\z/i,
     compress => qr/\A($RE_ATOM_CHAR+(?: $RE_ATOM_CHAR+)*)\z/,
+    SSL_protocols => qr/\A(!?$RE_SSL_PROTO(?: !?$RE_SSL_PROTO)*)\z/,
     SSL_fingerprint => qr/\A((?:[A-Za-z0-9]+\$)?\p{AHex}+)\z/,
     SSL_cipherlist => qr/\A(\P{Control}+)\z/,
     SSL_verify => qr/\A(YES|NO)\z/i,
@@ -1460,20 +1463,42 @@ sub _ssl_verify($$$) {
     return $ok; # 1=accept cert, 0=reject
 }
 
+my %SSL_proto = (
+    'SSLv2' => Net::SSLeay::OP_NO_SSLv2(),
+    'SSLv3' => Net::SSLeay::OP_NO_SSLv3(),
+    'TLSv1' => Net::SSLeay::OP_NO_TLSv1(),
+    'TLSv1.1' => Net::SSLeay::OP_NO_TLSv1_1(),
+    'TLSv1.2' => Net::SSLeay::OP_NO_TLSv1_2()
+);
 
 # $self->_start_ssl($socket)
 #   Upgrade the $socket to SSL/TLS.
 sub _start_ssl($$) {
     my ($self, $socket) = @_;
     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();
+
+    $self->{SSL_protocols} //= q{!SSLv2 !SSLv3};
+    my ($proto_include, $proto_exclude) = (0, 0);
+    foreach (split /\s+/, $self->{SSL_protocols}) {
+        my $neg = s/^!// ? 1 : 0;
+        s/\.0$//;
+        ($neg ? $proto_exclude : $proto_include) |= $SSL_proto{$_} // $self->panic("Unknown SSL protocol: $_");
+    }
+    if ($proto_include != 0) {
+        # exclude all protocols except those explictly included
+        my $x = 0;
+        $x |= $_ foreach values %SSL_proto;
+        $x &= ~ $proto_include;
+        $proto_exclude |= $x;
+    }
+    my @proto_exclude = grep { ($proto_exclude & $SSL_proto{$_}) != 0 } keys %SSL_proto;
+    $self->log("Disabling SSL protocol: ".join(', ', sort @proto_exclude)) if $self->{debug};
+    $ssl_options |= $SSL_proto{$_} foreach @proto_exclude;
+    $ssl_options |= Net::SSLeay::OP_NO_COMPRESSION();
 
     # https://www.openssl.org/docs/manmaster/ssl/SSL_CTX_set_options.html
-    Net::SSLeay::CTX_set_options($ctx,
-        Net::SSLeay::OP_SINGLE_ECDH_USE() |
-        Net::SSLeay::OP_SINGLE_DH_USE() |
-        Net::SSLeay::OP_NO_SSLv2() |
-        Net::SSLeay::OP_NO_SSLv3() |
-        Net::SSLeay::OP_NO_COMPRESSION() );
+    Net::SSLeay::CTX_set_options($ctx, $ssl_options);
 
     # https://www.openssl.org/docs/manmaster/ssl/SSL_CTX_set_mode.html
     Net::SSLeay::CTX_set_mode($ctx,
-- 
cgit v1.2.3