aboutsummaryrefslogtreecommitdiffstats
path: root/lib/Net
diff options
context:
space:
mode:
authorGuilhem Moulin <guilhem@fripost.org>2015-10-19 17:14:43 +0200
committerGuilhem Moulin <guilhem@fripost.org>2015-10-19 17:14:43 +0200
commit1aeca5f89e768df83d3f6f86e0d782e5a20fc1f6 (patch)
tree5ac7f716be88daa6a10668b8156b4a8eb4cdd173 /lib/Net
parenteb6b971fbd5ef3f9bd76770262da5808cf8c506a (diff)
Add an option 'SSL_protocols'.
Diffstat (limited to 'lib/Net')
-rw-r--r--lib/Net/IMAP/InterIMAP.pm37
1 files changed, 31 insertions, 6 deletions
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,