From 567fc180a3e76716816ea9af5a066bad2ea8c01a Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Thu, 10 May 2018 03:35:13 +0200 Subject: Improve ESEARCH response parsing for full RFC 4466 compatibility. --- lib/Net/IMAP/InterIMAP.pm | 51 +++++++++++++++++++++++++++++++++++++---------- 1 file changed, 40 insertions(+), 11 deletions(-) (limited to 'lib/Net/IMAP') diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index 3270108..67b3ce5 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -597,7 +597,7 @@ sub incapable($@) { # Issue an UID SEARCH command with the given $criterion. For the "normal" # UID SEARCH command from RFC 3501, return the list of matching UIDs; # for the extended UID SEARCH command from RFC 4731 (ensuring ESEARCH -# capability is the caller's responsibility), return an "UID" +# capability is the caller's responsibility), return an optional "UID" # indicator followed by a hash containing search data pairs. sub search($$) { my ($self, $crit) = @_; @@ -1946,7 +1946,7 @@ sub _send($$;&) { } else { my $set = $$command =~ /\AUID (?:FETCH|STORE) ([0-9:,*]+)/ ? $1 - : $$command =~ /\AUID SEARCH / ? "\"$tag\"" # RFC 4466's tag-string + : $$command =~ /\AUID SEARCH / ? $tag # for RFC 4466's tag-string : undef; $self->_recv($tag, $callback, $cmd, $set); } @@ -2234,6 +2234,21 @@ sub _envelope($$) { return \@envelope; } +# Parse and consume an RFC 4466 tagged-ext-comp plus a trailing parenthesis +sub _tagged_ext_comp($$$) { + my ($self, $stream, $ret) = @_; + my $v = $$stream =~ s/\A\(// ? $self->_tagged_ext_comp(\$_, []) + : $self->_astring(\$_); + push @$ret, $v; + if ($$stream =~ s/\A\)//) { + return $ret; + } elsif ($$stream =~ s/\A //) { + $self->_tagged_ext_comp(\$_, $ret) + } else { + $self->panic($$stream); + } +} + # $self->_resp($buf, [$callback, $cmd, $set] ) # Parse an untagged response line or a continuation request line. # (The trailing CRLF must be removed.) The internal cache is @@ -2288,16 +2303,30 @@ sub _resp($$;&$$) { elsif (/\ASEARCH((?: [0-9]+)*)\z/) { $callback->(split(/ /, ($1 =~ s/^ //r))) if defined $callback and $cmd eq 'SEARCH'; } - elsif (defined $set and s/\AESEARCH \(TAG \Q$set\E\)( UID)?//) { - my $uid = $1; - my %ret; # RFC 4731 + elsif (s/\AESEARCH( |\z)/$1/) { + my $tag = $1 if s/\A \(TAG \"($RE_ASTRING_CHAR+)\"\)//; + my $uid = s/\A UID// ? "UID" : undef; + my @ret; while ($_ ne '') { - $self->fail("RFC 4731 violation in ESEARCH response") - # XXX RFC 4466's tagged-ext-comp unsupported - unless s/\A ($RE_ATOM_CHAR+) ([0-9,:]+)//; - $ret{uc $1} = $2; + # RFC 4466 "tagged-ext-label" is a valid RFC 3501 "atom" + s/\A ($RE_ATOM_CHAR+) // or $self->panic(); + my $label = uc($1); + my $value; + if (s/\A([0-9,:]+)//) { + # RFC 4466 tagged-ext-simple + $value = $1; + } elsif (s/\A\(//) { + # RFC 4466 "(" [tagged-ext-comp] ")" + $value = s/\A\)// ? [] : $self->_tagged_ext_comp(\$_, []); + } else { + $self->panic(); + } + # don't use a hash since some extensions might give more + # than one response for a same key + push @ret, $label => $value; } - $callback->($uid, %ret) if defined $callback and $cmd eq 'SEARCH'; + $callback->($uid, @ret) if defined $callback and $cmd eq 'SEARCH' + and defined $set and $set eq $tag; } elsif (s/\ALIST \((\\?$RE_ATOM_CHAR+(?: \\?$RE_ATOM_CHAR+)*)?\) ("(?:\\[\x22\x5C]|[\x01-\x09\x0B\x0C\x0E-\x21\x23-\x5B\x5D-\x7F])"|NIL) //) { my ($delim, $attrs) = ($2, $1); @@ -2306,7 +2335,7 @@ sub _resp($$;&$$) { $self->panic($_) unless $_ eq ''; $mailbox = 'INBOX' if uc $mailbox eq 'INBOX'; # INBOX is case-insensitive undef $delim if uc $delim eq 'NIL'; - $delim =~ s/\A"(.*)"\Z/$1/ if defined $delim; + $delim =~ s/\A"(.*)"\z/$1/ if defined $delim; $self->_update_cache_for($mailbox, DELIMITER => $delim); $self->_update_cache_for($mailbox, LIST_ATTRIBUTES => \@attrs); $callback->($mailbox, $delim, @attrs) if defined $callback and $cmd eq 'LIST'; -- cgit v1.2.3 From dd7edb8eac0c11fb8168f5028c8b6d8706cc8fdb Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Sun, 20 Jan 2019 19:55:33 +0100 Subject: pullimap, interimap: Use $XDG_CONFIG_HOME/$NAME/config as config file. --- Changelog | 4 ++++ README | 2 +- interimap | 35 +++++++++++++++-------------------- interimap.md | 10 +++++----- lib/Net/IMAP/InterIMAP.pm | 36 +++++++++++++++++++++++++++++++----- pullimap | 35 +++++++++++++++-------------------- pullimap.md | 10 +++++----- 7 files changed, 76 insertions(+), 56 deletions(-) (limited to 'lib/Net/IMAP') diff --git a/Changelog b/Changelog index 7939fa2..7f033c8 100644 --- a/Changelog +++ b/Changelog @@ -3,6 +3,10 @@ interimap (0.4) UNRELEASED * pullimap: replace non RFC 5321-compliant envelope sender addresses (received by the IMAP FETCH ENVELOPE command) with the null address <>. + * pullimap, interimap: take configuration filename (default: "config") + relative to $XDG_CONFIG_HOME/$NAME (or ~/.config/$NAME), to comply + with the XDG specification. Thus the previous default config file + $XDG_CONFIG_HOME/$NAME should become $XDG_CONFIG_HOME/$NAME/config. + Library: new API idle_start() and idle_stop(). + Add support for untagged ESEARCH responses from RFC 4731. + pullimap: Use extended SEARCH commands (RFC 4731) if supported by diff --git a/README b/README index 6c3ae34..70bf1df 100644 --- a/README +++ b/README @@ -52,7 +52,7 @@ the AUTHENTICATE command. For instance the following configuration snippet saves bandwidth and brings a significant speed gain compared to type=imaps. - local: $XDG_CONFIG_HOME/interimap: + local: $XDG_CONFIG_HOME/interimap/config: [remote] type = tunnel command = /usr/bin/ssh user@imap.example.net diff --git a/interimap b/interimap index 049b564..0f34bf9 100755 --- a/interimap +++ b/interimap @@ -30,7 +30,7 @@ use Fcntl qw/F_GETFD F_SETFD FD_CLOEXEC/; use List::Util 'first'; use lib 'lib'; -use Net::IMAP::InterIMAP qw/read_config compact_set/; +use Net::IMAP::InterIMAP qw/xdg_basedir read_config compact_set/; # Clean up PATH $ENV{PATH} = join ':', qw{/usr/bin /bin}; @@ -63,20 +63,24 @@ my $COMMAND = do { }; usage(1) if defined $COMMAND and (($COMMAND eq 'delete' and !@ARGV) or ($COMMAND eq 'rename' and $#ARGV != 1)); usage(1) if defined $COMMAND and (defined $CONFIG{watch} or defined $CONFIG{notify}); -usage(1) if $CONFIG{target} and !(defined $COMMAND and ($COMMAND eq 'delete'or $COMMAND eq 'rename')); +usage(1) if $CONFIG{target} and !(defined $COMMAND and ($COMMAND eq 'delete' or $COMMAND eq 'rename')); $CONFIG{watch} = $CONFIG{notify} ? 900 : 60 if (defined $CONFIG{watch} or $CONFIG{notify}) and !$CONFIG{watch}; @ARGV = map {uc $_ eq 'INBOX' ? 'INBOX' : $_ } @ARGV; # INBOX is case-insensitive die "Invalid mailbox name $_" foreach grep !/\A([\x01-\x7F]+)\z/, @ARGV; -my $CONF = read_config( delete $CONFIG{config} // $NAME - , [qw/_ local remote/] - , database => qr/\A(\P{Control}+)\z/ - , logfile => qr/\A(\/\P{Control}+)\z/ - , 'list-mailbox' => qr/\A([\x01-\x09\x0B\x0C\x0E-\x7F]+)\z/ - , 'list-select-opts' => qr/\A([\x21\x23\x24\x26\x27\x2B-\x5B\x5E-\x7A\x7C-\x7E]+)\z/ - , 'ignore-mailbox' => qr/\A([\x01-\x09\x0B\x0C\x0E-\x7F]+)\z/ - ); +my $CONF = do { + my $conffile = delete($CONFIG{config}) // "config"; + $conffile = xdg_basedir( XDG_CONFIG_HOME => ".config", $NAME, $conffile ); + read_config( $conffile + , [qw/_ local remote/] + , database => qr/\A(\P{Control}+)\z/ + , logfile => qr/\A(\/\P{Control}+)\z/ + , 'list-mailbox' => qr/\A([\x01-\x09\x0B\x0C\x0E-\x7F]+)\z/ + , 'list-select-opts' => qr/\A([\x21\x23\x24\x26\x27\x2B-\x5B\x5E-\x7A\x7C-\x7E]+)\z/ + , 'ignore-mailbox' => qr/\A([\x01-\x09\x0B\x0C\x0E-\x7F]+)\z/ + ); +}; my ($DBFILE, $LOGGER_FD); { @@ -84,16 +88,7 @@ my ($DBFILE, $LOGGER_FD); $DBFILE //= $CONF->{remote}->{host}.'.db' if defined $CONF->{remote}; $DBFILE //= $CONF->{local}->{host}. '.db' if defined $CONF->{local}; die "Missing option database" unless defined $DBFILE; - - unless ($DBFILE =~ /\A\//) { - my $dir = ($ENV{XDG_DATA_HOME} // "$ENV{HOME}/.local/share") .'/'. $NAME; - $dir =~ /\A(\/\p{Print}+)\z/ or die "Insecure $dir"; - $dir = $1; - $DBFILE = $dir .'/'. $DBFILE; - unless (-d $dir) { - mkdir $dir, 0700 or die "Can't mkdir $dir: $!\n"; - } - } + $DBFILE = xdg_basedir( XDG_DATA_HOME => ".local/share", $NAME, $DBFILE ); if (defined $CONF->{_} and defined $CONF->{_}->{logfile}) { require 'POSIX.pm'; diff --git a/interimap.md b/interimap.md index 4a321f1..ca83dba 100644 --- a/interimap.md +++ b/interimap.md @@ -140,8 +140,8 @@ Options `--config=`*FILE* : Specify an alternate [configuration file](#configuration-file). - Relative paths start from *$XDG_CONFIG_HOME*, or *~/.config* if the - `XDG_CONFIG_HOME` environment variable is unset. + Relative paths start from *$XDG_CONFIG_HOME/interimap*, or *~/.config/interimap* + if the `XDG_CONFIG_HOME` environment variable is unset. `--target={local,remote,database}` @@ -192,9 +192,9 @@ Configuration file ================== Unless told otherwise by the `--config=FILE` command-line option, -`interimap` reads its configuration from *$XDG_CONFIG_HOME/interimap* -(or *~/.config/interimap* if the `XDG_CONFIG_HOME` environment variable -is unset) as an [INI file]. +`interimap` reads its configuration from *$XDG_CONFIG_HOME/interimap/config* +(or *~/.config/interimap/config* if the `XDG_CONFIG_HOME` environment +variable is unset) as an [INI file]. The syntax of the configuration file is a series of `OPTION=VALUE` lines organized under some `[SECTION]`; lines starting with a ‘#’ or ‘;’ character are ignored as comments. diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index 67b3ce5..7b0a2be 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -22,7 +22,7 @@ use strict; use Compress::Raw::Zlib qw/Z_OK Z_FULL_FLUSH Z_SYNC_FLUSH MAX_WBITS/; use Config::Tiny (); -use Errno 'EINTR'; +use Errno qw/EEXIST EINTR/; use Fcntl qw/F_GETFD F_SETFD FD_CLOEXEC/; use Net::SSLeay (); use List::Util qw/all first/; @@ -35,7 +35,7 @@ BEGIN { Net::SSLeay::SSLeay_add_ssl_algorithms(); Net::SSLeay::randomize(); - our @EXPORT_OK = qw/read_config compact_set $IMAP_text $IMAP_cond + our @EXPORT_OK = qw/xdg_basedir read_config compact_set $IMAP_text $IMAP_cond slurp is_dirty has_new_mails/; } @@ -76,6 +76,35 @@ my $CRLF = "\x0D\x0A"; ############################################################################# # Utilities +# xdg_basedir($xdg_variable, $default, $subdir, $path) +# Return $path if $path is absolute. Otherwise, return +# "$ENV{$xdg_variable}/$subdir/$path" (resp. "~/$default/$subdir/path" +# if the "$xdg_variable" environment variable is not set). +# An error is raised if "$ENV{$xdg_variable}" (resp. "~/$default") is +# not an existing absolute directory. +# If "$ENV{$xdg_variable}/$subdir" doesn't exist, it is created with +# mode 0700. +sub xdg_basedir($$$$) { + my ($xdg_variable, $default, $subdir, $path) = @_; + $path =~ /\A(\p{Print}+)\z/ or die "Insecure $path"; + $path = $1; + return $path if $path =~ /\A\//; + + my $basedir = $ENV{$xdg_variable}; + unless (defined $basedir) { + my @getent = getpwuid($>); + $basedir = $getent[7] ."/". $default; + } + die "No such directory: ", $basedir unless -d $basedir; + $basedir .= "/".$subdir; + $basedir =~ /\A(\/\p{Print}+)\z/ or die "Insecure $basedir"; + $basedir = $1; + unless (mkdir ($basedir, 0700)) { + die "Couldn't create $basedir: $!\n" unless $! == EEXIST; + } + return $basedir ."/". $path; +} + # read_config($conffile, $sections, %opts) # Read $conffile's default section, then each section in the array # reference $section (which takes precedence). %opts extends %OPTIONS @@ -85,9 +114,6 @@ sub read_config($$%) { my $sections = shift; my %opts = (%OPTIONS, @_); - $conffile = ($ENV{XDG_CONFIG_HOME} // "$ENV{HOME}/.config") .'/'. $conffile - unless $conffile =~ /\A\//; # relative path - die "No such config file $conffile\n" unless defined $conffile and -f $conffile and -r $conffile; diff --git a/pullimap b/pullimap index 736bbff..e666114 100755 --- a/pullimap +++ b/pullimap @@ -31,7 +31,7 @@ use List::Util 'first'; use Socket qw/PF_INET PF_INET6 SOCK_STREAM/; use lib 'lib'; -use Net::IMAP::InterIMAP qw/read_config compact_set/; +use Net::IMAP::InterIMAP qw/xdg_basedir read_config compact_set/; # Clean up PATH $ENV{PATH} = join ':', qw{/usr/bin /bin}; @@ -59,15 +59,19 @@ usage(1) unless $#ARGV == 0 and $ARGV[0] ne '_'; ####################################################################### # Read and validate configuration # -my $CONF = read_config( delete $CONFIG{config} // $NAME, - , [$ARGV[0]] - , statefile => qr/\A(\P{Control}+)\z/ - , mailbox => qr/\A([\x01-\x7F]+)\z/ - , 'deliver-method' => qr/\A([ls]mtp:\[.*\]:\d+)\z/ - , 'deliver-ehlo' => qr/\A(\P{Control}+)\z/ - , 'deliver-rcpt' => qr/\A(\P{Control}+)\z/ - , 'purge-after' => qr/\A(\d*)\z/ - )->{$ARGV[0]}; +my $CONF = do { + my $conffile = delete($CONFIG{config}) // "config"; + $conffile = xdg_basedir( XDG_CONFIG_HOME => ".config", $NAME, $conffile ); + read_config( $conffile + , [$ARGV[0]] + , statefile => qr/\A(\P{Control}+)\z/ + , mailbox => qr/\A([\x01-\x7F]+)\z/ + , 'deliver-method' => qr/\A([ls]mtp:\[.*\]:\d+)\z/ + , 'deliver-ehlo' => qr/\A(\P{Control}+)\z/ + , 'deliver-rcpt' => qr/\A(\P{Control}+)\z/ + , 'purge-after' => qr/\A(\d*)\z/ + )->{$ARGV[0]}; +}; my ($MAILBOX, $STATE); do { @@ -75,16 +79,7 @@ do { my $statefile = $CONF->{statefile} // $ARGV[0]; die "Missing option statefile" unless defined $statefile; - $statefile = $statefile =~ /\A(\p{Print}+)\z/ ? $1 : die "Insecure $statefile"; - - unless ($statefile =~ /\A\//) { - my $dir = ($ENV{XDG_DATA_HOME} // "$ENV{HOME}/.local/share") .'/'. $NAME; - $dir = $dir =~ /\A(\/\p{Print}+)\z/ ? $1 : die "Insecure $dir"; - $statefile = $dir .'/'. $statefile; - unless (-d $dir) { - mkdir $dir, 0700 or die "Can't mkdir $dir: $!\n"; - } - } + $statefile = xdg_basedir( XDG_DATA_HOME => ".local/share", $NAME, $statefile ); sysopen($STATE, $statefile, O_CREAT|O_RDWR|O_DSYNC, 0600) or die "Can't open $statefile: $!"; # XXX we need to pack the struct flock manually: not portable! diff --git a/pullimap.md b/pullimap.md index 06035ac..eac8efa 100644 --- a/pullimap.md +++ b/pullimap.md @@ -32,8 +32,8 @@ Options `--config=`*FILE* : Specify an alternate [configuration file](#configuration-file). - Relative paths start from *$XDG_CONFIG_HOME*, or *~/.config* if the - `XDG_CONFIG_HOME` environment variable is unset. + Relative paths start from *$XDG_CONFIG_HOME/pullimap*, or *~/.config/pullimap* + if the `XDG_CONFIG_HOME` environment variable is unset. `--idle`[`=`*seconds*] @@ -74,9 +74,9 @@ Configuration file ================== Unless told otherwise by the `--config=FILE` command-line option, -`pullimap` reads its configuration from *$XDG_CONFIG_HOME/pullimap* (or -*~/.config/pullimap* if the `XDG_CONFIG_HOME` environment variable is -unset) as an [INI file]. +`pullimap` reads its configuration from *$XDG_CONFIG_HOME/pullimap/config* +(or *~/.config/pullimap/config* if the `XDG_CONFIG_HOME` environment variable +is unset) as an [INI file]. The syntax of the configuration file is a series of `OPTION=VALUE` lines organized under some `[SECTION]`; lines starting with a ‘#’ or ‘;’ character are ignored as comments. -- cgit v1.2.3 From 452ae91f06bec4c21e7ba7b7bc4309b089f7afe3 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Sun, 20 Jan 2019 19:55:58 +0100 Subject: Specify minimum Perl and Net::SSLeay versions. --- Changelog | 1 + INSTALL | 4 ++-- interimap | 1 + lib/Net/IMAP/InterIMAP.pm | 2 +- pullimap | 1 + 5 files changed, 6 insertions(+), 3 deletions(-) (limited to 'lib/Net/IMAP') diff --git a/Changelog b/Changelog index 7f033c8..c8a0d51 100644 --- a/Changelog +++ b/Changelog @@ -13,6 +13,7 @@ interimap (0.4) UNRELEASED the server to search old mail and EXPUNGE them. - Ensure the lower bound of UID ranges is at least 1. - Fix manpage generation with pandoc >=2.1. + - Specify minimum Perl and Net::SSLeay versions. -- Guilhem Moulin Tue, 06 Dec 2016 17:37:01 +0100 diff --git a/INSTALL b/INSTALL index 458b7c2..69afb26 100644 --- a/INSTALL +++ b/INSTALL @@ -1,4 +1,4 @@ -InterIMAP depends on the following Perl modules: +InterIMAP depends on Perl >=5.20 and the following Perl modules: - Compress::Raw::Zlib (core module) - Config::Tiny @@ -8,7 +8,7 @@ InterIMAP depends on the following Perl modules: - Getopt::Long (core module) - MIME::Base64 (core module) if authentication is required - List::Util (core module) - - Net::SSLeay + - Net::SSLeay >=1.73 - POSIX (core module) - Socket (core module) - Time::HiRes (core module) if 'logfile' is set diff --git a/interimap b/interimap index 0f34bf9..41a0cb9 100755 --- a/interimap +++ b/interimap @@ -18,6 +18,7 @@ # along with this program. If not, see . #---------------------------------------------------------------------- +use v5.14.2; use strict; use warnings; diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index 7b0a2be..f783ea7 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -24,7 +24,7 @@ use Compress::Raw::Zlib qw/Z_OK Z_FULL_FLUSH Z_SYNC_FLUSH MAX_WBITS/; use Config::Tiny (); use Errno qw/EEXIST EINTR/; use Fcntl qw/F_GETFD F_SETFD FD_CLOEXEC/; -use Net::SSLeay (); +use Net::SSLeay 1.73 (); use List::Util qw/all first/; use POSIX ':signal_h'; use Socket qw/SOCK_STREAM IPPROTO_TCP AF_INET AF_INET6 SOCK_RAW :addrinfo/; diff --git a/pullimap b/pullimap index e666114..e044df5 100755 --- a/pullimap +++ b/pullimap @@ -21,6 +21,7 @@ use strict; use warnings; +use v5.20.2; our $VERSION = '0.3'; my $NAME = 'pullimap'; -- cgit v1.2.3 From 522666e8e2556d89c25013ce17d6db49e75443ef Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Mon, 21 Jan 2019 23:59:55 +0100 Subject: Net::IMAP::InterIMAP: add support for TLSv1.3 (on recent enough Net::SSLeay). Also, change "SSL_protocols" default value from "!SSLv2 !SSLv3" to "!SSLv2 !SSLv3 !TLSv1 !TLSv1.1". I.e., only enable TLSv1.2 and later, which is the default in Debian's OpenSSL as of 1.1.1-2, cf. https://tracker.debian.org/news/998835/accepted-openssl-111-2-source-into-unstable/ . --- Changelog | 3 +++ interimap.md | 7 ++++--- lib/Net/IMAP/InterIMAP.pm | 27 +++++++++++++++++---------- pullimap.md | 7 ++++--- 4 files changed, 28 insertions(+), 16 deletions(-) (limited to 'lib/Net/IMAP') diff --git a/Changelog b/Changelog index b4fb931..9fa46dd 100644 --- a/Changelog +++ b/Changelog @@ -7,6 +7,9 @@ interimap (0.4) UNRELEASED relative to $XDG_CONFIG_HOME/$NAME (or ~/.config/$NAME), to comply with the XDG specification. Thus the previous default config file $XDG_CONFIG_HOME/$NAME should become $XDG_CONFIG_HOME/$NAME/config. + * Library: add support for TLSv1.3 (on recent enough Net::SSLeay), and + change "SSL_protocols" default value from "!SSLv2 !SSLv3" to "!SSLv2 + !SSLv3 !TLSv1 !TLSv1.1". + Library: new API idle_start() and idle_stop(). + Add support for untagged ESEARCH responses from RFC 4731. + pullimap: Use extended SEARCH commands (RFC 4731) if supported by diff --git a/interimap.md b/interimap.md index 1831d39..4d85eaf 100644 --- a/interimap.md +++ b/interimap.md @@ -332,9 +332,10 @@ Valid options are: : A space-separated list of SSL protocols to enable or disable (if prefixed with an exclamation mark `!`. Known protocols are `SSLv2`, - `SSLv3`, `TLSv1`, `TLSv1.1`, and `TLSv1.2`. Enabling a protocol is - a short-hand for disabling all other protocols. - (Default: `!SSLv2 !SSLv3`, i.e., only enable TLSv1 and above.) + `SSLv3`, `TLSv1`, `TLSv1.1`, `TLSv1.2`, and `TLSv1.3`. Enabling a + protocol is a short-hand for disabling all other protocols. + (Default: `!SSLv2 !SSLv3 !TLSv1 !TLSv1.1`, i.e., only enable TLSv1.2 + and above.) *SSL_cipher_list* diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index f783ea7..3d8bd97 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -45,7 +45,7 @@ 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])/; +my $RE_SSL_PROTO = qr/(?:SSLv[23]|TLSv1|TLSv1\.[0-3])/; # Map each option to a regexp validating its values. my %OPTIONS = ( @@ -1599,13 +1599,19 @@ 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() -); +my %SSL_proto; +BEGIN { + sub _append_ssl_proto($$) { + my ($k, $v) = @_; + $SSL_proto{$k} = $v if defined $v; + } + _append_ssl_proto( "SSLv2", eval { Net::SSLeay::OP_NO_SSLv2() } ); + _append_ssl_proto( "SSLv3", eval { Net::SSLeay::OP_NO_SSLv3() } ); + _append_ssl_proto( "TLSv1", eval { Net::SSLeay::OP_NO_TLSv1() } ); + _append_ssl_proto( "TLSv1.1", eval { Net::SSLeay::OP_NO_TLSv1_1() } ); + _append_ssl_proto( "TLSv1.2", eval { Net::SSLeay::OP_NO_TLSv1_2() } ); + _append_ssl_proto( "TLSv1.3", eval { Net::SSLeay::OP_NO_TLSv1_3() } ); +} # $self->_start_ssl($socket) # Upgrade the $socket to SSL/TLS. @@ -1614,7 +1620,7 @@ sub _start_ssl($$) { 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}; + $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; @@ -1629,7 +1635,7 @@ sub _start_ssl($$) { $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}; + $self->log("Disabling SSL protocols: ".join(', ', sort @proto_exclude)) if $self->{debug}; $ssl_options |= $SSL_proto{$_} foreach @proto_exclude; $ssl_options |= Net::SSLeay::OP_NO_COMPRESSION(); @@ -1675,6 +1681,7 @@ sub _start_ssl($$) { $v == 0x0301 ? 'TLSv1' : $v == 0x0302 ? 'TLSv1.1' : $v == 0x0303 ? 'TLSv1.2' : + $v == 0x0304 ? 'TLSv1.3' : '??'), $v)); $self->log(sprintf('SSL cipher: %s (%d bits)' diff --git a/pullimap.md b/pullimap.md index eac8efa..a367dd1 100644 --- a/pullimap.md +++ b/pullimap.md @@ -198,9 +198,10 @@ Valid options are: : A space-separated list of SSL protocols to enable or disable (if prefixed with an exclamation mark `!`. Known protocols are `SSLv2`, - `SSLv3`, `TLSv1`, `TLSv1.1`, and `TLSv1.2`. Enabling a protocol is - a short-hand for disabling all other protocols. - (Default: `!SSLv2 !SSLv3`, i.e., only enable TLSv1 and above.) + `SSLv3`, `TLSv1`, `TLSv1.1`, `TLSv1.2`, and `TLSv1.3`. Enabling a + protocol is a short-hand for disabling all other protocols. + (Default: `!SSLv2 !SSLv3 !TLSv1 !TLSv1.1`, i.e., only enable TLSv1.2 + and above.) *SSL_cipher_list* -- cgit v1.2.3 From e85db0b140eb2c56fa46231829a1bfe6f98ede7d Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Sun, 20 Jan 2019 20:29:58 +0100 Subject: Bump version number. --- interimap | 4 ++-- lib/Net/IMAP/InterIMAP.pm | 2 +- pullimap | 4 ++-- 3 files changed, 5 insertions(+), 5 deletions(-) (limited to 'lib/Net/IMAP') diff --git a/interimap b/interimap index 7ac6b05..deb0949 100755 --- a/interimap +++ b/interimap @@ -22,7 +22,7 @@ use v5.14.2; use strict; use warnings; -our $VERSION = '0.3'; +our $VERSION = '0.4'; my $NAME = 'interimap'; use Getopt::Long qw/:config posix_default no_ignore_case gnu_compat bundling auto_version/; @@ -32,7 +32,7 @@ use Fcntl qw/F_GETFD F_SETFD FD_CLOEXEC/; use List::Util 'first'; use lib 'lib'; -use Net::IMAP::InterIMAP qw/xdg_basedir read_config compact_set/; +use Net::IMAP::InterIMAP 0.0.4 qw/xdg_basedir read_config compact_set/; # Clean up PATH $ENV{PATH} = join ':', qw{/usr/bin /bin}; diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index 3d8bd97..8280fb2 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.3; +package Net::IMAP::InterIMAP v0.0.4; use warnings; use strict; diff --git a/pullimap b/pullimap index b752b14..233172f 100755 --- a/pullimap +++ b/pullimap @@ -22,7 +22,7 @@ use strict; use warnings; use v5.20.2; -our $VERSION = '0.3'; +our $VERSION = '0.4'; my $NAME = 'pullimap'; use Errno 'EINTR'; @@ -32,7 +32,7 @@ use List::Util 'first'; use Socket qw/PF_INET PF_INET6 SOCK_STREAM/; use lib 'lib'; -use Net::IMAP::InterIMAP qw/xdg_basedir read_config compact_set/; +use Net::IMAP::InterIMAP 0.0.4 qw/xdg_basedir read_config compact_set/; # Clean up PATH $ENV{PATH} = join ':', qw{/usr/bin /bin}; -- cgit v1.2.3 From 64dd58fb503c5ee31da3bcbe52313c723730a122 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Sun, 20 Jan 2019 20:42:56 +0100 Subject: Bump copyright years. --- README | 4 ++-- interimap | 2 +- lib/Net/IMAP/InterIMAP.pm | 2 +- pullimap | 2 +- 4 files changed, 5 insertions(+), 5 deletions(-) (limited to 'lib/Net/IMAP') diff --git a/README b/README index cb34ef1..06f328f 100644 --- a/README +++ b/README @@ -82,6 +82,6 @@ usage with regular INET sockets (type=imaps or type=imap). _______________________________________________________________________ -InterIMAP is Copyright© 2015 Guilhem Moulin ⟨guilhem@fripost.org⟩, and -licensed for use under the GNU General Public License version 3 or +InterIMAP is Copyright© 2015-2018 Guilhem Moulin ⟨guilhem@fripost.org⟩, +and licensed for use under the GNU General Public License version 3 or later. See ‘COPYING’ for specific terms and distribution information. diff --git a/interimap b/interimap index deb0949..454d311 100755 --- a/interimap +++ b/interimap @@ -2,7 +2,7 @@ #---------------------------------------------------------------------- # Fast bidirectional synchronization for QRESYNC-capable IMAP servers -# Copyright © 2015,2016 Guilhem Moulin +# Copyright © 2015-2018 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 diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index 8280fb2..a773f08 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 Guilhem Moulin +# Copyright © 2015-2018 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 diff --git a/pullimap b/pullimap index 233172f..495b99e 100755 --- a/pullimap +++ b/pullimap @@ -2,7 +2,7 @@ #---------------------------------------------------------------------- # Pull mails from an IMAP mailbox and deliver them to a SMTP session -# Copyright © 2016 Guilhem Moulin +# Copyright © 2016-2018 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