From fce1c73c8c942e6a87b8000f80da7dc735635296 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Fri, 11 Dec 2020 12:31:08 +0100 Subject: Update copyright years. --- lib/Net/IMAP/InterIMAP.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lib/Net') diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index fff1570..8b59ed2 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -1,6 +1,6 @@ #---------------------------------------------------------------------- # A minimal IMAP4 client for QRESYNC-capable servers -# Copyright © 2015-2019 Guilhem Moulin +# Copyright © 2015-2020 Guilhem Moulin # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by -- cgit v1.2.3 From e3b95b0da424e55682c8c7b025d9d272a4a35ffe Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Fri, 11 Dec 2020 15:09:15 +0100 Subject: libinterimap: remove default SSL_protocols value. Namely, use the system default instead of "!SSLv2 !SSLv3 !TLSv1 !TLSv1.1". As of Debian Buster (OpenSSL 1.1.1) this does not make a difference, however using the system default provides better compatibility with future libssl versions. --- lib/Net/IMAP/InterIMAP.pm | 38 ++++++++++++++++++++------------------ 1 file changed, 20 insertions(+), 18 deletions(-) (limited to 'lib/Net') diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index 8b59ed2..221b016 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -1694,32 +1694,34 @@ sub _start_ssl($$) { my ($self, $socket) = @_; my $openssl_version = Net::SSLeay::OPENSSL_VERSION_NUMBER(); 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(); if (defined $self->{_OUTBUF} and $self->{_OUTBUF} ne '') { $self->warn("Truncating non-empty output buffer (unauthenticated response injection?)"); undef $self->{_OUTBUF}; } - $self->{SSL_protocols} //= q{!SSLv2 !SSLv3 !TLSv1 !TLSv1.1}; - 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 protocols: ".join(', ', sort @proto_exclude)) if $self->{debug}; - $ssl_options |= $SSL_proto{$_} foreach @proto_exclude; + my $ssl_options = Net::SSLeay::OP_SINGLE_DH_USE() | Net::SSLeay::OP_SINGLE_ECDH_USE(); $ssl_options |= Net::SSLeay::OP_NO_COMPRESSION(); + if (defined (my $protos = $self->{SSL_protocols})) { + my ($proto_include, $proto_exclude) = (0, 0); + foreach (split /\s+/, $protos) { + 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 protocols: ".join(', ', sort @proto_exclude)) if $self->{debug}; + $ssl_options |= $SSL_proto{$_} foreach @proto_exclude; + } + # https://www.openssl.org/docs/manmaster/ssl/SSL_CTX_set_options.html Net::SSLeay::CTX_set_options($ctx, $ssl_options); -- cgit v1.2.3 From 7d7a28bc77908d05983a3c3fcfed79616a1614ce Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Fri, 11 Dec 2020 15:47:08 +0100 Subject: libinterimap: make $OPENSSL_VERSION global. --- lib/Net/IMAP/InterIMAP.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'lib/Net') diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index 221b016..5843b27 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -48,6 +48,7 @@ my $RE_LIST_CHAR = qr/[\x21\x23-\x27\x2A\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-3])/; +my $OPENSSL_VERSION = Net::SSLeay::OPENSSL_VERSION_NUMBER(); # Map each option to a regexp validating its values. my %OPTIONS = ( @@ -1692,7 +1693,6 @@ BEGIN { # Upgrade the $socket to SSL/TLS. sub _start_ssl($$) { my ($self, $socket) = @_; - my $openssl_version = Net::SSLeay::OPENSSL_VERSION_NUMBER(); my $ctx = Net::SSLeay::CTX_new() or $self->panic("Failed to create SSL_CTX $!"); if (defined $self->{_OUTBUF} and $self->{_OUTBUF} ne '') { @@ -1746,7 +1746,7 @@ sub _start_ssl($$) { my ($hostip, $hostipfam) = _parse_hostip($host); if ($self->{SSL_verify} // 1) { # for X509_VERIFY_PARAM_set1_{ip,host}() - $self->panic("Failed requirement libssl >=1.0.2") if $openssl_version < 0x1000200f; + $self->panic("Failed requirement libssl >=1.0.2") if $OPENSSL_VERSION < 0x1000200f; # verify certificate chain my ($file, $path) = ($self->{SSL_CAfile} // '', $self->{SSL_CApath} // ''); @@ -1777,7 +1777,7 @@ sub _start_ssl($$) { # always use 'SSL_hostname' when set, otherwise use 'host' (unless it's an IP) on OpenSSL >=0.9.8f my $servername = $self->{SSL_hostname} // (defined $hostipfam ? "" : $host); if ($servername ne "") { - $self->panic("Failed requirement libssl >=0.9.8f") if $openssl_version < 0x00908070; + $self->panic("Failed requirement libssl >=0.9.8f") if $OPENSSL_VERSION < 0x00908070; $self->_ssl_error("Can't set TLS servername extension (value $servername)") unless Net::SSLeay::set_tlsext_host_name($ssl, $servername) == 1; $self->log("Using SNI with name $servername") if $self->{debug}; -- cgit v1.2.3 From 35f4ecefa9c9ff55acfdb337b215e3d13345c86d Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Fri, 11 Dec 2020 16:23:12 +0100 Subject: libinterimap: use Net::SSLeay::get_version() to get the protocol version string. This avoids maintaing our own map. --- lib/Net/IMAP/InterIMAP.pm | 12 +++--------- 1 file changed, 3 insertions(+), 9 deletions(-) (limited to 'lib/Net') diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index 5843b27..e2b89ec 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -1789,15 +1789,9 @@ sub _start_ssl($$) { Net::SSLeay::X509_VERIFY_PARAM_free($vpm); 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 == 0x0304 ? 'TLSv1.3' : - '??'), - $v)); + $self->log(sprintf('SSL protocol: %s (0x%x)', + , Net::SSLeay::get_version($ssl) + , Net::SSLeay::version($ssl))); $self->log(sprintf('SSL cipher: %s (%d bits)' , Net::SSLeay::get_cipher($ssl) , Net::SSLeay::get_cipher_bits($ssl))); -- cgit v1.2.3 From feeb91998a29ca040f6e5dd103e09507a6355e32 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Fri, 11 Dec 2020 18:39:46 +0100 Subject: libinterimap: deprecate SSL_protocols and introduce SSL_protocol_{min,max}. Using the libssl interface simplifies our protocol black/whitelist greatly; this only allows simple min/max bounds, but holes are arguably not very useful here. Using the new settings bumps the required libssl version to 1.1.0. --- lib/Net/IMAP/InterIMAP.pm | 32 +++++++++++++++++++++++++++++--- 1 file changed, 29 insertions(+), 3 deletions(-) (limited to 'lib/Net') diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index e2b89ec..49ea343 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -63,7 +63,9 @@ my %OPTIONS = ( command => qr/\A(\P{Control}+)\z/, 'null-stderr' => qr/\A(YES|NO)\z/i, compress => qr/\A(YES|NO)\z/i, - SSL_protocols => qr/\A(!?$RE_SSL_PROTO(?: !?$RE_SSL_PROTO)*)\z/, + SSL_protocols => qr/\A(!?$RE_SSL_PROTO(?: !?$RE_SSL_PROTO)*)\z/, # TODO deprecated, remove in 0.6 + SSL_protocol_min => qr/\A(\P{Control}+)\z/, + SSL_protocol_max => qr/\A(\P{Control}+)\z/, SSL_fingerprint => qr/\A((?:[A-Za-z0-9]+\$)?\p{AHex}+(?: (?:[A-Za-z0-9]+\$)?\p{AHex}+)*)\z/, SSL_cipherlist => qr/\A(\P{Control}+)\z/, SSL_hostname => qr/\A(\P{Control}*)\z/, @@ -1676,7 +1678,7 @@ sub _ssl_verify($$$) { } my %SSL_proto; -BEGIN { +BEGIN { # TODO deprecated, remove in 0.6 sub _append_ssl_proto($$) { my ($k, $v) = @_; $SSL_proto{$k} = $v if defined $v; @@ -1689,6 +1691,15 @@ BEGIN { _append_ssl_proto( "TLSv1.3", eval { Net::SSLeay::OP_NO_TLSv1_3() } ); } +# see ssl/ssl_conf.c:protocol_from_string() in the OpenSSL source tree +my %SSL_protocol_versions = ( + "SSLv3" => eval { Net::SSLeay::SSL3_VERSION() } + , "TLSv1" => eval { Net::SSLeay::TLS1_VERSION() } + , "TLSv1.1" => eval { Net::SSLeay::TLS1_1_VERSION() } + , "TLSv1.2" => eval { Net::SSLeay::TLS1_2_VERSION() } + , "TLSv1.3" => eval { Net::SSLeay::TLS1_3_VERSION() } +); + # $self->_start_ssl($socket) # Upgrade the $socket to SSL/TLS. sub _start_ssl($$) { @@ -1703,7 +1714,22 @@ sub _start_ssl($$) { my $ssl_options = Net::SSLeay::OP_SINGLE_DH_USE() | Net::SSLeay::OP_SINGLE_ECDH_USE(); $ssl_options |= Net::SSLeay::OP_NO_COMPRESSION(); - if (defined (my $protos = $self->{SSL_protocols})) { + if (defined $self->{SSL_protocol_min} or defined $self->{SSL_protocol_max}) { + $self->panic("Failed requirement libssl >=1.1.0") if $OPENSSL_VERSION < 0x1010000f; + my ($min, $max) = @$self{qw/SSL_protocol_min SSL_protocol_max/}; + if (defined $min) { + my $v = $SSL_protocol_versions{$min} // $self->panic("Unknown protocol version: $min"); + $self->_ssl_error("CTX_set_min_proto_version()") unless Net::SSLeay::CTX_set_min_proto_version($ctx, $v) == 1; + $self->log("Minimum SSL/TLS protocol version: ", $min) if $self->{debug}; + } + if (defined $max) { + my $v = $SSL_protocol_versions{$max} // $self->panic("Unknown protocol version: $max"); + $self->_ssl_error("CTX_set_max_proto_version()") unless Net::SSLeay::CTX_set_max_proto_version($ctx, $v) == 1; + $self->log("Maximum SSL/TLS protocol version: ", $max) if $self->{debug}; + } + } elsif (defined (my $protos = $self->{SSL_protocols})) { # TODO deprecated, remove in 0.6 + $self->warn("SSL_protocols is deprecated and will be removed in a future release! ", + "Use SSL_protocol_{min,max} instead."); my ($proto_include, $proto_exclude) = (0, 0); foreach (split /\s+/, $protos) { my $neg = s/^!// ? 1 : 0; -- cgit v1.2.3 From ea120902dfe146cd7f04a289da9fa05a9e06e44c Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Fri, 11 Dec 2020 21:24:32 +0100 Subject: typofix, spelling --- lib/Net/IMAP/InterIMAP.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lib/Net') diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index 49ea343..2e36d6e 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -1371,7 +1371,7 @@ sub push_flag_updates($$@) { $modified->{$uid} //= [ 0, undef ]; } elsif (defined (my $m = $modified->{$uid})) { # received an untagged FETCH response, remove from the list of pending changes - # if the flag list was up to date (either implicitely or explicitely) + # if the flag list was up to date (either implicitely or explicitly) if (!defined $m->[1] or $m->[1] eq $flags) { delete $modified->{$uid}; push @ok, $uid; -- cgit v1.2.3 From 2d301be3df763be39d12d214779cf2320b426696 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Sun, 13 Dec 2020 12:31:32 +0100 Subject: Fix broken URLs. --- lib/Net/IMAP/InterIMAP.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'lib/Net') diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index 2e36d6e..6afca07 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -1627,7 +1627,7 @@ 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 +# https://www.openssl.org/docs/manmaster/man3/SSL_CTX_set_verify.html sub _ssl_verify($$$) { my ($self, $ok, $x509_ctx) = @_; return 0 unless $x509_ctx; # reject @@ -1748,10 +1748,10 @@ sub _start_ssl($$) { $ssl_options |= $SSL_proto{$_} foreach @proto_exclude; } - # https://www.openssl.org/docs/manmaster/ssl/SSL_CTX_set_options.html + # https://www.openssl.org/docs/manmaster/man3/SSL_CTX_set_options.html Net::SSLeay::CTX_set_options($ctx, $ssl_options); - # https://www.openssl.org/docs/manmaster/ssl/SSL_CTX_set_mode.html + # https://www.openssl.org/docs/manmaster/man3/SSL_CTX_set_mode.html Net::SSLeay::CTX_set_mode($ctx, Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE() | Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER() | -- cgit v1.2.3 From b70d9b261a6d2849efeb670b53e0ab726a58fb59 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Sun, 13 Dec 2020 15:07:30 +0100 Subject: Make error messages more uniform and consistent. --- lib/Net/IMAP/InterIMAP.pm | 52 +++++++++++++++++++++++------------------------ 1 file changed, 26 insertions(+), 26 deletions(-) (limited to 'lib/Net') diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index 6afca07..3745aad 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -328,19 +328,19 @@ sub new($%) { my $pid = fork // $self->panic("fork: $!"); unless ($pid) { # children - close($self->{S}) or $self->panic("Can't close: $!"); - open STDIN, '<&', $s or $self->panic("Can't dup: $!"); - open STDOUT, '>&', $s or $self->panic("Can't dup: $!"); + close($self->{S}) or $self->panic("close: $!"); + open STDIN, '<&', $s or $self->panic("dup: $!"); + open STDOUT, '>&', $s or $self->panic("dup: $!"); my $stderr2; if (($self->{'null-stderr'} // 0) and !($self->{debug} // 0)) { open $stderr2, '>&', *STDERR; - open STDERR, '>', '/dev/null' or $self->panic("Can't open /dev/null: $!"); + open STDERR, '>', '/dev/null' or $self->panic("open(/dev/null): $!"); } my $sigset = POSIX::SigSet::->new(SIGINT); my $oldsigset = POSIX::SigSet::->new(); - sigprocmask(SIG_BLOCK, $sigset, $oldsigset) // $self->panic("Can't block SIGINT: $!"); + sigprocmask(SIG_BLOCK, $sigset, $oldsigset) // $self->panic("sigprocmask: $!"); unless (exec $command) { my $err = $!; @@ -348,12 +348,12 @@ sub new($%) { close STDERR; open STDERR, '>&', $stderr2; } - $self->panic("Can't exec: $err"); + $self->panic("exec: $err"); } } # parent - close($s) or $self->panic("Can't close: $!"); + close($s) or $self->panic("close: $!"); } else { foreach (qw/host port/) { @@ -363,9 +363,9 @@ sub new($%) { : $self->_tcp_connect(@$self{qw/host port/}); if (defined $self->{keepalive}) { setsockopt($self->{S}, Socket::SOL_SOCKET, Socket::SO_KEEPALIVE, 1) - or $self->fail("Can't setsockopt SO_KEEPALIVE: $!"); + or $self->fail("setsockopt SO_KEEPALIVE: $!"); setsockopt($self->{S}, Socket::IPPROTO_TCP, Socket::TCP_KEEPIDLE, 60) - or $self->fail("Can't setsockopt TCP_KEEPIDLE: $!"); + or $self->fail("setsockopt TCP_KEEPIDLE: $!"); } } @@ -1493,9 +1493,9 @@ sub _tcp_connect($$$) { # https://stackoverflow.com/questions/8284243/how-do-i-set-so-rcvtimeo-on-a-socket-in-perl my $timeout = pack('l!l!', 30, 0); setsockopt($s, Socket::SOL_SOCKET, Socket::SO_RCVTIMEO, $timeout) - or $self->fail("Can't setsockopt SO_RCVTIMEO: $!"); + or $self->fail("setsockopt SO_RCVTIMEO: $!"); setsockopt($s, Socket::SOL_SOCKET, Socket::SO_SNDTIMEO, $timeout) - or $self->fail("Can't setsockopt SO_RCVTIMEO: $!"); + or $self->fail("setsockopt SO_RCVTIMEO: $!"); until (connect($s, $ai->{addr})) { next if $! == EINTR; # try again if connect(2) was interrupted by a signal @@ -1512,7 +1512,7 @@ sub _xwrite($$$) { while ($length > 0) { my $n = syswrite($_[0], $_[1], $length, $offset); - $self->fail("Can't write: $!") unless defined $n and $n > 0; + $self->fail("write: $!") unless defined $n and $n > 0; $offset += $n; $length -= $n; } @@ -1524,7 +1524,7 @@ sub _xread($$$) { my $offset = 0; my $buf; while ($length > 0) { - my $n = sysread($fh, $buf, $length, $offset) // $self->fail("Can't read: $!"); + my $n = sysread($fh, $buf, $length, $offset) // $self->fail("read: $!"); $self->fail("0 bytes read (got EOF)") unless $n > 0; # EOF $offset += $n; $length -= $n; @@ -1582,7 +1582,7 @@ sub _proxify($$$$) { my ($err, $ipaddr) = getnameinfo($_->{addr}, NI_NUMERICHOST, NIx_NOSERV); $err eq '' ? [$ipaddr,$_->{family}] : undef } @res; - $self->fail("Can't getnameinfo") unless defined $addr; + $self->fail("getnameinfo") unless defined $addr; ($hostip, $fam) = @$addr; } @@ -1704,7 +1704,7 @@ my %SSL_protocol_versions = ( # 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 $ctx = Net::SSLeay::CTX_new() or $self->panic("SSL_CTX_new(): $!"); if (defined $self->{_OUTBUF} and $self->{_OUTBUF} ne '') { $self->warn("Truncating non-empty output buffer (unauthenticated response injection?)"); @@ -1749,6 +1749,7 @@ sub _start_ssl($$) { } # https://www.openssl.org/docs/manmaster/man3/SSL_CTX_set_options.html + # TODO 0.6: move SSL_CTX_set_options() and SSL_CTX_set_mode() before SSL_CTX_set_{min,max}_proto_version() Net::SSLeay::CTX_set_options($ctx, $ssl_options); # https://www.openssl.org/docs/manmaster/man3/SSL_CTX_set_mode.html @@ -1758,9 +1759,8 @@ sub _start_ssl($$) { Net::SSLeay::MODE_AUTO_RETRY() | # don't fail SSL_read on renegotiation Net::SSLeay::MODE_RELEASE_BUFFERS() ); - if (defined (my $ciphers = $self->{SSL_cipherlist})) { - Net::SSLeay::CTX_set_cipher_list($ctx, $ciphers) - or $self->_ssl_error("Can't set cipher list"); + if (defined (my $str = $self->{SSL_cipherlist})) { + $self->_ssl_error("SSL_CTX_set_cipher_list()") unless Net::SSLeay::CTX_set_cipher_list($ctx, $str) == 1; } my $vpm = Net::SSLeay::X509_VERIFY_PARAM_new() or $self->_ssl_error("X509_VERIFY_PARAM_new()"); @@ -1777,8 +1777,8 @@ sub _start_ssl($$) { # verify certificate chain my ($file, $path) = ($self->{SSL_CAfile} // '', $self->{SSL_CApath} // ''); if ($file ne '' or $path ne '') { - Net::SSLeay::CTX_load_verify_locations($ctx, $file, $path) - or $self->_ssl_error("Can't load verify locations"); + $self->_ssl_error("SSL_CTX_load_verify_locations()") + unless Net::SSLeay::CTX_load_verify_locations($ctx, $file, $path) == 1; } # verify DNS hostname or IP literal @@ -1797,14 +1797,14 @@ sub _start_ssl($$) { Net::SSLeay::CTX_set_verify($ctx, Net::SSLeay::VERIFY_PEER(), sub($$) {$self->_ssl_verify(@_)}); $self->_ssl_error("CTX_SSL_set1_param()") unless Net::SSLeay::CTX_set1_param($ctx, $vpm) == 1; - 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"); + my $ssl = Net::SSLeay::new($ctx) or $self->fail("SSL_new()"); + $self->fail("SSL_set_fd()") unless Net::SSLeay::set_fd($ssl, fileno($socket)) == 1; - # always use 'SSL_hostname' when set, otherwise use 'host' (unless it's an IP) on OpenSSL >=0.9.8f + # always use 'SSL_hostname' when set, otherwise use 'host' (unless it's an IP) my $servername = $self->{SSL_hostname} // (defined $hostipfam ? "" : $host); if ($servername ne "") { $self->panic("Failed requirement libssl >=0.9.8f") if $OPENSSL_VERSION < 0x00908070; - $self->_ssl_error("Can't set TLS servername extension (value $servername)") + $self->_ssl_error("SSL_set_tlsext_host_name($servername)") unless Net::SSLeay::set_tlsext_host_name($ssl, $servername) == 1; $self->log("Using SNI with name $servername") if $self->{debug}; } @@ -1852,7 +1852,7 @@ sub _getline($;$) { $n = sysread($stdout, $buf, $BUFSIZE, 0); } - $self->_ssl_error("Can't read: $!") unless defined $n; + $self->_ssl_error("read: $!") unless defined $n; $self->_ssl_error("0 bytes read (got EOF)") unless $n > 0; # EOF $self->{_OUTRAWCOUNT} += $n; @@ -2065,7 +2065,7 @@ sub _cmd_flush($;$$) { my $written = defined $ssl ? Net::SSLeay::write_partial($ssl, $offset, $length, $self->{_INBUF}) : syswrite($stdin, $self->{_INBUF}, $length, $offset); - $self->_ssl_error("Can't write: $!") unless defined $written and $written > 0; + $self->_ssl_error("write: $!") unless defined $written and $written > 0; $offset += $written; $length -= $written; -- cgit v1.2.3 From f3f064a4e0e74088daea091bc62a8141f0e6c0bb Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Sun, 13 Dec 2020 16:00:53 +0100 Subject: Explicitly set SSL_verify=1 (default) only once. --- lib/Net/IMAP/InterIMAP.pm | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'lib/Net') diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index 3745aad..5bdd954 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -1641,7 +1641,7 @@ sub _ssl_verify($$$) { $self->log(' Subject Name: ', Net::SSLeay::X509_NAME_oneline(Net::SSLeay::X509_get_subject_name($cert))); } - $ok = 1 unless $self->{SSL_verify} // 1; + $ok = 1 unless $self->{SSL_verify} // die; # safety check, always set if ($depth == 0 and !exists $self->{_SSL_PEER_VERIFIED}) { if ($self->{debug}) { my $algo = 'sha256'; @@ -1705,6 +1705,7 @@ my %SSL_protocol_versions = ( sub _start_ssl($$) { my ($self, $socket) = @_; my $ctx = Net::SSLeay::CTX_new() or $self->panic("SSL_CTX_new(): $!"); + $self->{SSL_verify} //= 1; # default is to perform certificate verification if (defined $self->{_OUTBUF} and $self->{_OUTBUF} ne '') { $self->warn("Truncating non-empty output buffer (unauthenticated response injection?)"); @@ -1770,7 +1771,7 @@ sub _start_ssl($$) { my $host = $self->{host} // $self->panic(); my ($hostip, $hostipfam) = _parse_hostip($host); - if ($self->{SSL_verify} // 1) { + if ($self->{SSL_verify}) { # for X509_VERIFY_PARAM_set1_{ip,host}() $self->panic("Failed requirement libssl >=1.0.2") if $OPENSSL_VERSION < 0x1000200f; @@ -1811,7 +1812,7 @@ sub _start_ssl($$) { $self->_ssl_error("Can't initiate TLS/SSL handshake") unless Net::SSLeay::connect($ssl) == 1; $self->panic() unless $self->{_SSL_PEER_VERIFIED}; # sanity check - $self->panic() if ($self->{SSL_verify} // 1) and Net::SSLeay::get_verify_result($ssl) != Net::SSLeay::X509_V_OK(); + $self->panic() if $self->{SSL_verify} and Net::SSLeay::get_verify_result($ssl) != Net::SSLeay::X509_V_OK(); Net::SSLeay::X509_VERIFY_PARAM_free($vpm); if ($self->{debug}) { -- cgit v1.2.3 From 8c43ed9baa905d907a6aad77de2282a852ba69a9 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Sun, 13 Dec 2020 17:43:52 +0100 Subject: libinterimap: use default locations for trusted CA certificates when neither CAfile nor CApath are set. In particular, OpenSSL's default locations can be overridden by the SSL_CERT_FILE resp. SSL_CERT_DIR environment variables, see SSL_CTX_load_verify_locations(3ssl). This bumps the minimum OpenSSL version to 1.1.0 (when SSL_verify is used). --- lib/Net/IMAP/InterIMAP.pm | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) (limited to 'lib/Net') diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index 5bdd954..89e5cba 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -1776,10 +1776,14 @@ sub _start_ssl($$) { $self->panic("Failed requirement libssl >=1.0.2") if $OPENSSL_VERSION < 0x1000200f; # verify certificate chain - my ($file, $path) = ($self->{SSL_CAfile} // '', $self->{SSL_CApath} // ''); - if ($file ne '' or $path ne '') { + if (defined $self->{SSL_CAfile} or defined $self->{SSL_CApath}) { $self->_ssl_error("SSL_CTX_load_verify_locations()") - unless Net::SSLeay::CTX_load_verify_locations($ctx, $file, $path) == 1; + unless Net::SSLeay::CTX_load_verify_locations($ctx, + $self->{SSL_CAfile} // '', $self->{SSL_CApath} // '') == 1; + } else { + $self->log("Using default locations for trusted CA certificates") if $self->{debug}; + $self->_ssl_error("SSL_CTX_set_default_verify_paths()") + unless Net::SSLeay::CTX_set_default_verify_paths($ctx) == 1; } # verify DNS hostname or IP literal -- cgit v1.2.3 From 0a358b8e929be3cbf9586e2a9146c209903f6896 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Sun, 13 Dec 2020 18:15:39 +0100 Subject: libinterimap: _start_ssl() now fails immediately with OpenSSL <1.1.0. It could in principle still work with earlier versions if the new settings SSL_protocol_{min,max} are not used, however it's cumbersome to do individual checks for specific settings, let alone maintain test coverage with multiple OpenSSL versions. --- lib/Net/IMAP/InterIMAP.pm | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) (limited to 'lib/Net') diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index 89e5cba..99d3a0e 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -48,7 +48,6 @@ my $RE_LIST_CHAR = qr/[\x21\x23-\x27\x2A\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-3])/; -my $OPENSSL_VERSION = Net::SSLeay::OPENSSL_VERSION_NUMBER(); # Map each option to a regexp validating its values. my %OPTIONS = ( @@ -1704,6 +1703,11 @@ my %SSL_protocol_versions = ( # Upgrade the $socket to SSL/TLS. sub _start_ssl($$) { my ($self, $socket) = @_; + # need OpenSSL 1.1.0 or later for SSL_CTX_set_min_proto_version(3ssl), see + # https://www.openssl.org/docs/man1.1.0/man3/SSL_CTX_set_min_proto_version.html + $self->panic("SSL/TLS functions require OpenSSL 1.1.0 or later") + if Net::SSLeay::OPENSSL_VERSION_NUMBER() < 0x1010000f; + my $ctx = Net::SSLeay::CTX_new() or $self->panic("SSL_CTX_new(): $!"); $self->{SSL_verify} //= 1; # default is to perform certificate verification @@ -1716,7 +1720,6 @@ sub _start_ssl($$) { $ssl_options |= Net::SSLeay::OP_NO_COMPRESSION(); if (defined $self->{SSL_protocol_min} or defined $self->{SSL_protocol_max}) { - $self->panic("Failed requirement libssl >=1.1.0") if $OPENSSL_VERSION < 0x1010000f; my ($min, $max) = @$self{qw/SSL_protocol_min SSL_protocol_max/}; if (defined $min) { my $v = $SSL_protocol_versions{$min} // $self->panic("Unknown protocol version: $min"); @@ -1772,9 +1775,6 @@ sub _start_ssl($$) { my $host = $self->{host} // $self->panic(); my ($hostip, $hostipfam) = _parse_hostip($host); if ($self->{SSL_verify}) { - # for X509_VERIFY_PARAM_set1_{ip,host}() - $self->panic("Failed requirement libssl >=1.0.2") if $OPENSSL_VERSION < 0x1000200f; - # verify certificate chain if (defined $self->{SSL_CAfile} or defined $self->{SSL_CApath}) { $self->_ssl_error("SSL_CTX_load_verify_locations()") @@ -1808,7 +1808,6 @@ sub _start_ssl($$) { # always use 'SSL_hostname' when set, otherwise use 'host' (unless it's an IP) my $servername = $self->{SSL_hostname} // (defined $hostipfam ? "" : $host); if ($servername ne "") { - $self->panic("Failed requirement libssl >=0.9.8f") if $OPENSSL_VERSION < 0x00908070; $self->_ssl_error("SSL_set_tlsext_host_name($servername)") unless Net::SSLeay::set_tlsext_host_name($ssl, $servername) == 1; $self->log("Using SNI with name $servername") if $self->{debug}; -- cgit v1.2.3 From 43516b78b6b626bb6df522e4f1c5166989d79eb5 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Sun, 13 Dec 2020 23:47:15 +0100 Subject: typofix --- lib/Net/IMAP/InterIMAP.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lib/Net') diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index 99d3a0e..856c5c8 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -1732,7 +1732,7 @@ sub _start_ssl($$) { $self->log("Maximum SSL/TLS protocol version: ", $max) if $self->{debug}; } } elsif (defined (my $protos = $self->{SSL_protocols})) { # TODO deprecated, remove in 0.6 - $self->warn("SSL_protocols is deprecated and will be removed in a future release! ", + $self->warn("SSL_protocols is deprecated and will be removed in a future release! " . "Use SSL_protocol_{min,max} instead."); my ($proto_include, $proto_exclude) = (0, 0); foreach (split /\s+/, $protos) { -- cgit v1.2.3 From 57988c83bb4b3f1780f045880ac4a8f36a51c55c Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Thu, 17 Dec 2020 17:38:17 +0100 Subject: libinterimap: new option SSL_ciphersuites to set the TLSv1.3 ciphersuites. Also, clarify that SSL_cipherlist only applies to TLSv1.2 and below. See SSL_CTX_set_cipher_list(3ssl). --- lib/Net/IMAP/InterIMAP.pm | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'lib/Net') diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index 856c5c8..09f510f 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -67,6 +67,7 @@ my %OPTIONS = ( SSL_protocol_max => qr/\A(\P{Control}+)\z/, SSL_fingerprint => qr/\A((?:[A-Za-z0-9]+\$)?\p{AHex}+(?: (?:[A-Za-z0-9]+\$)?\p{AHex}+)*)\z/, SSL_cipherlist => qr/\A(\P{Control}+)\z/, + SSL_ciphersuites => qr/\A(\P{Control}*)\z/, # "an empty list is permissible" SSL_hostname => qr/\A(\P{Control}*)\z/, SSL_verify => qr/\A(YES|NO)\z/i, SSL_CApath => qr/\A(\P{Control}+)\z/, @@ -1766,6 +1767,9 @@ sub _start_ssl($$) { if (defined (my $str = $self->{SSL_cipherlist})) { $self->_ssl_error("SSL_CTX_set_cipher_list()") unless Net::SSLeay::CTX_set_cipher_list($ctx, $str) == 1; } + if (defined (my $str = $self->{SSL_ciphersuites})) { + $self->_ssl_error("SSL_CTX_set_ciphersuites()") unless Net::SSLeay::CTX_set_ciphersuites($ctx, $str) == 1; + } my $vpm = Net::SSLeay::X509_VERIFY_PARAM_new() or $self->_ssl_error("X509_VERIFY_PARAM_new()"); my $purpose = Net::SSLeay::X509_PURPOSE_SSL_SERVER(); -- cgit v1.2.3 From 9cbaed6527c3030819976dbe41bfb4392d6a6fa2 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Sat, 26 Dec 2020 23:11:11 +0100 Subject: Prepare new release v0.5.5. --- lib/Net/IMAP/InterIMAP.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lib/Net') diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index 09f510f..0c4fc89 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -16,7 +16,7 @@ # along with this program. If not, see . #---------------------------------------------------------------------- -package Net::IMAP::InterIMAP v0.0.5; +package Net::IMAP::InterIMAP v0.5.5; use v5.20.0; use warnings; use strict; -- cgit v1.2.3