14 files changed, 210 insertions, 6 deletions
diff --git a/Changelog b/Changelog
index 43648d0..6ee44fc 100644
--- a/Changelog
+++ b/Changelog
@@ -1,3 +1,18 @@
+interimap (0.5.2) upstream;
+
+ - Makefile: remove 'smart' extension from pandoc call to generate
+   manuals (it's no longer supported by pandoc 2.9 which generates \[lq]
+   and \[rq] in the groff output anyway).
+ - libinterimap: fix response injection vulnerability after STARTTLS.
+   For background see https://gitlab.com/muttmua/mutt/-/issues/248 .
+ - libinterimap: abort on PREAUTH greeting received on plaintext
+   connections (set "STARTTLS = NO" to ignore).  This is similar to
+   CVE-2020-12398 and CVE-2020-14093.
+ * libinterimap: fail when a capability to ENABLE is missing from the
+   server's CAPABILITY listing.
+
+ -- Guilhem Moulin <guilhem@fripost.org>  Mon, 03 Aug 2020 20:50:41 +0200
+
 interimap (0.5.1) upstream;
 
  + pullimap: also compare RFC 5322 date and envelope information in
diff --git a/Makefile b/Makefile
index 35f1334..9e28dbc 100644
--- a/Makefile
+++ b/Makefile
@@ -13,7 +13,7 @@ html: $(HTML_FILES)
 
 # upper case the headers and remove the links
 $(MANUAL_FILES): $(BUILD_DOCDIR)/%: ./doc/%.md
-	pandoc -f markdown -t json -- "$<" | ./pandoc2man.jq | pandoc -s -f json -t man+smart -o "$@"
+	pandoc -f markdown -t json -- "$<" | ./pandoc2man.jq | pandoc -s -f json -t man -o "$@"
 
 test:
 	@./tests/run-all
diff --git a/doc/template.html b/doc/template.html
index 0d497db..d825cde 100644
--- a/doc/template.html
+++ b/doc/template.html
@@ -19,10 +19,18 @@ $endif$
     span.smallcaps{font-variant: small-caps;}
     span.underline{text-decoration: underline;}
     div.column{display: inline-block; vertical-align: top; width: 50%;}
-    pre{tab-size: 4; -moz-tab-size: 4;}
     table{width: 100%; margin-bottom: 3ex;}
     table > thead > tr.header > th{border-bottom: 2px solid #ddd; padding: 8px;}
     table > tbody > tr        > td{border-bottom: 1px solid #ddd; padding: 6px;}
+    pre {
+      padding: 16px;
+      font-size: 85%;
+      line-height: 1.45;
+      background-color: #f6f8fa;
+      border-radius: 6px;
+      tab-size: 4;
+      -moz-tab-size: 4;
+    }
     @media only screen and (min-width: 600px) {
       .parent {
         float: right;
diff --git a/interimap b/interimap
index 6448d2b..670f746 100755
--- a/interimap
+++ b/interimap
@@ -22,7 +22,7 @@ use v5.14.2;
 use strict;
 use warnings;
 
-our $VERSION = '0.5.1';
+our $VERSION = '0.5.2';
 my $NAME = 'interimap';
 my $DATABASE_VERSION = 1;
 use Getopt::Long qw/:config posix_default no_ignore_case gnu_compat
diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index 1bff06e..b01e1a9 100644
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -464,6 +464,7 @@ sub new($%) {
             $self->logger('S: xxx ', $IMAP_text);
             $self->{debug} = $dbg;
         }
+        $self->{_STATE} = 'AUTH';
 
         unless ($IMAP_text =~ /\A\Q$IMAP_cond\E \[CAPABILITY /) {
             # refresh the CAPABILITY list since the previous one had only pre-login capabilities
@@ -471,7 +472,15 @@ sub new($%) {
             $self->capabilities();
         }
     }
-    $self->{_STATE} = 'AUTH';
+    elsif ($IMAP_cond eq 'PREAUTH') {
+        if ($self->{type} eq 'imap' and $self->{STARTTLS} != 0) {
+            $self->fail("PREAUTH greeting on plaintext connection? MiTM in action? Aborting, set \"STARTTLS = NO\" to ignore.");
+        }
+        $self->{_STATE} = 'AUTH';
+    }
+    else {
+        $self->panic();
+    }
 
     # Don't send the COMPRESS command before STARTTLS or AUTH, as per RFC 4978
     if ($self->{compress} // 1 and
@@ -506,6 +515,7 @@ sub new($%) {
                    : ($self->{enable});
     if (@extensions) {
         $self->fail("Server did not advertise ENABLE (RFC 5161) capability.") unless $self->_capable('ENABLE');
+        $self->fail("Server did not advertise $_ capability.") foreach grep { !$self->_capable($_) } @extensions;
         $self->_send('ENABLE '.join(' ',@extensions));
         my @enabled = @{$self->{_ENABLED} // []};
         $self->fail("Couldn't ENABLE $_") foreach
@@ -1653,6 +1663,11 @@ 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();
 
+    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}) {
@@ -1679,7 +1694,7 @@ sub _start_ssl($$) {
     Net::SSLeay::CTX_set_mode($ctx,
         Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE() |
         Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER() |
-        Net::SSLeay::MODE_AUTO_RETRY() | # don't fail SSL_read on renegociation
+        Net::SSLeay::MODE_AUTO_RETRY() | # don't fail SSL_read on renegotiation
         Net::SSLeay::MODE_RELEASE_BUFFERS() );
 
     if (defined (my $ciphers = $self->{SSL_cipherlist})) {
diff --git a/pullimap b/pullimap
index d1c607a..e4747eb 100755
--- a/pullimap
+++ b/pullimap
@@ -22,7 +22,7 @@ use v5.20.2;
 use strict;
 use warnings;
 
-our $VERSION = '0.5.1';
+our $VERSION = '0.5.2';
 my $NAME = 'pullimap';
 
 use Errno 'EINTR';
diff --git a/tests/list b/tests/list
index 402ec51..db77f50 100644
--- a/tests/list
+++ b/tests/list
@@ -38,6 +38,7 @@ repair  --repair
     auth-login              LOGIN
     auth-logindisabled      LOGINDISABLED
     auth-noplaintext        abort when STARTTLS is not offered
+    preauth-plaintext       abort on MiTM via PREAUTH greeting
 
 compress    COMPRESS=DEFLATE
 condstore   CONDSTORE
@@ -46,6 +47,7 @@ split-set   Split large sets to avoid extra-long command lines
 . SSL/TLS
     starttls-logindisabled  LOGINDISABLED STARTTLS
     starttls                STARTTLS
+    starttls-injection      STARTTLS response injection
     tls                     SSL/TLS handshake
     ... tls-verify-peer
     tls-pin-fingerprint     pubkey fingerprint pinning
diff --git a/tests/preauth-plaintext/imapd b/tests/preauth-plaintext/imapd
new file mode 100755
index 0000000..8f3ac30
--- /dev/null
+++ b/tests/preauth-plaintext/imapd
@@ -0,0 +1,44 @@
+#!/usr/bin/perl -T
+
+use warnings;
+use strict;
+
+use Errno qw/EINTR/;
+use Socket qw/INADDR_LOOPBACK AF_INET SOCK_STREAM pack_sockaddr_in
+    SOL_SOCKET SO_REUSEADDR SHUT_RDWR/;
+
+socket(my $S, AF_INET, SOCK_STREAM, 0) or die;
+setsockopt($S, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) or die;
+bind($S, pack_sockaddr_in(10143, INADDR_LOOPBACK)) or die "bind: $!\n";
+listen($S, 1) or die "listen: $!";
+
+while (1) {
+    my $sockaddr = accept(my $conn, $S) or do {
+        next if $! == EINTR;
+        die "accept: $!";
+    };
+
+    # minimum CAPABILITY list, see tests/snippets/dovecot/interimap-required-capabilities.conf
+    $conn->printflush("* PREAUTH [CAPABILITY IMAP4rev1 ENABLE UIDPLUS LIST-EXTENDED QRESYNC LIST-STATUS] IMAP4rev1 Server\r\n");
+    my $x;
+
+    $x = $conn->getline() // next;
+    $x =~ /\A(\S+) ENABLE QRESYNC\r\n/ or die;
+    $conn->printflush("* ENABLED QRESYNC\r\n$1 OK ENABLE completed\r\n");
+
+    $x = $conn->getline() // next;
+    $x =~ /\A(\S+) LIST .*\r\n/ or die;
+    $conn->print("* LIST (\\Noselect) \"~\" \"\"\r\n");
+    $conn->print("* LIST () \"~\" INBOX\r\n");
+    $conn->print("* STATUS INBOX (UIDNEXT 1 UIDVALIDITY 1 HIGHESTMODSEQ 1)\r\n");
+    $conn->printflush("$1 OK LIST completed\r\n");
+
+    close($conn);
+}
+
+END {
+    if (defined $S) {
+        shutdown($S, SHUT_RDWR) or warn "shutdown: $!";
+        close($S) or print STDERR "Can't close: $!\n";
+    }
+}
diff --git a/tests/preauth-plaintext/interimap.remote b/tests/preauth-plaintext/interimap.remote
new file mode 120000
index 0000000..ad49677
--- /dev/null
+++ b/tests/preauth-plaintext/interimap.remote
@@ -0,0 +1 @@
+../starttls/interimap.remote
+\ No newline at end of file
diff --git a/tests/preauth-plaintext/t b/tests/preauth-plaintext/t
new file mode 100644
index 0000000..427d57b
--- /dev/null
+++ b/tests/preauth-plaintext/t
@@ -0,0 +1,19 @@
+# Test IMAP MiTM via PREAUTH greeting
+# For background see CVE-2020-12398, CVE-2020-14093 and
+# https://gitlab.com/muttmua/mutt/commit/3e88866dc60b5fa6aaba6fd7c1710c12c1c3cd01
+
+env -i USER="remote" HOME="$HOME_remote" "$TESTDIR/imapd" & PID=$!
+trap "ptree_abort $PID" EXIT INT TERM
+
+! interimap --debug || error
+grep -Fx 'remote: ERROR: PREAUTH greeting on plaintext connection? MiTM in action? Aborting, set "STARTTLS = NO" to ignore.' <"$STDERR" || error
+! grep '^remote: C: ' <"$STDERR" || error "wrote command in MiTM'ed PREAUTH connection!"
+
+
+# Ignore the warning when STARTTLS is explicitely disabled
+echo "STARTTLS = NO" >>"$XDG_CONFIG_HOME/interimap/config"
+interimap --debug || true
+
+grep -Fx "remote: S: * STATUS INBOX (UIDNEXT 1 UIDVALIDITY 1 HIGHESTMODSEQ 1)" <"$STDERR" || error
+
+# vim: set filetype=sh :
diff --git a/tests/starttls-injection/imapd b/tests/starttls-injection/imapd
new file mode 100755
index 0000000..9000c8d
--- /dev/null
+++ b/tests/starttls-injection/imapd
@@ -0,0 +1,77 @@
+#!/usr/bin/perl -T
+
+use warnings;
+use strict;
+
+use Errno qw/EINTR/;
+use Net::SSLeay qw/die_now die_if_ssl_error/;
+use Socket qw/INADDR_LOOPBACK AF_INET SOCK_STREAM pack_sockaddr_in
+    SOL_SOCKET SO_REUSEADDR SHUT_RDWR/;
+
+BEGIN {
+    Net::SSLeay::load_error_strings();
+    Net::SSLeay::SSLeay_add_ssl_algorithms();
+    Net::SSLeay::randomize();
+}
+
+socket(my $S, AF_INET, SOCK_STREAM, 0) or die;
+setsockopt($S, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) or die;
+bind($S, pack_sockaddr_in(10143, INADDR_LOOPBACK)) or die "bind: $!\n";
+listen($S, 1) or die "listen: $!";
+
+my $CONFDIR = $ENV{HOME} =~ /\A(\p{Print}+)\z/ ? "$1/.dovecot/conf.d" : die;
+my $CTX = Net::SSLeay::CTX_new() or die_now("SSL_CTX_new");
+Net::SSLeay::CTX_set_mode($CTX,
+    Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE() |
+    Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER() |
+    Net::SSLeay::MODE_AUTO_RETRY() | # don't fail SSL_read on renegotiation
+    Net::SSLeay::MODE_RELEASE_BUFFERS() );
+Net::SSLeay::CTX_use_PrivateKey_file($CTX, "$CONFDIR/dovecot.key", &Net::SSLeay::FILETYPE_PEM)
+    or die_if_ssl_error("Can't load private key: $!");
+Net::SSLeay::CTX_use_certificate_file($CTX, "$CONFDIR/dovecot.pem", &Net::SSLeay::FILETYPE_PEM)
+    or die_if_ssl_error("Can't load certificate: $!");
+
+while (1) {
+    my $sockaddr = accept(my $conn, $S) or do {
+        next if $! == EINTR;
+        die "accept: $!";
+    };
+
+    $conn->printflush("* OK IMAP4rev1 Server\r\n");
+
+    $conn->getline() =~ /\A(\S+) CAPABILITY\r\n\z/ or die;
+    $conn->printflush("* CAPABILITY IMAP4rev1 STARTTLS\r\n");
+    $conn->printflush("$1 OK CAPABILITY completed\r\n");
+
+    $conn->getline() =~ /\A(\S+) STARTTLS\r\n\z/ or die;
+
+    # These responses preceed the TLS handshake hence are not authenticated!
+    $conn->print("$1 OK Begin TLS\r\n");
+    $conn->print("* CAPABILITY IMAP4rev1 LOGINDISABLED X-injected\r\n");
+    # Note: tag format must match Net::IMAP::InterIMAP->_cmd_init()
+    $conn->printf("%06d OK CAPABILITY injected\r\n", $1+1);
+    $conn->flush();
+
+    my $ssl = Net::SSLeay::new($CTX) or die_if_ssl_error("SSL_new");
+    Net::SSLeay::set_fd($ssl, $conn) or die_if_ssl_error("SSL_set_fd");
+    Net::SSLeay::accept($ssl) and die_if_ssl_error("SSL_accept");
+
+    Net::SSLeay::ssl_read_CRLF($ssl) =~ /\A(\S+) CAPABILITY\r\n\z/ or die_now("SSL_read");
+    Net::SSLeay::ssl_write_CRLF($ssl, "* CAPABILITY IMAP4rev1 AUTH=LOGIN\r\n$1 OK CAPABILITY completed");
+
+    Net::SSLeay::ssl_read_CRLF($ssl) =~ /\A(\S+) LOGIN .*\r\n\z/ or die_now("SSL_read");
+    Net::SSLeay::ssl_write_CRLF($ssl, "$1 OK [CAPABILITY IMAP4rev1] LOGIN completed");
+
+    Net::SSLeay::free($ssl);
+    close($conn);
+
+    last;
+}
+
+END {
+    Net::SSLeay::CTX_free($CTX) if defined $CTX;
+    if (defined $S) {
+        shutdown($S, SHUT_RDWR) or warn "shutdown: $!";
+        close($S) or print STDERR "Can't close: $!\n";
+    }
+}
diff --git a/tests/starttls-injection/interimap.remote b/tests/starttls-injection/interimap.remote
new file mode 120000
index 0000000..ad49677
--- /dev/null
+++ b/tests/starttls-injection/interimap.remote
@@ -0,0 +1 @@
+../starttls/interimap.remote
+\ No newline at end of file
diff --git a/tests/starttls-injection/remote.conf b/tests/starttls-injection/remote.conf
new file mode 100644
index 0000000..f23f3de
--- /dev/null
+++ b/tests/starttls-injection/remote.conf
@@ -0,0 +1,6 @@
+protocols = $protocols imap
+service imap-login {
+    inet_listener imap {
+        port = 0
+    }
+}
diff --git a/tests/starttls-injection/t b/tests/starttls-injection/t
new file mode 100644
index 0000000..d57aa7a
--- /dev/null
+++ b/tests/starttls-injection/t
@@ -0,0 +1,16 @@
+# Test unauthenticated response injection after the STARTTLS response
+# For background see https://gitlab.com/muttmua/mutt/-/issues/248
+
+env -i USER="remote" HOME="$HOME_remote" "$TESTDIR/imapd" & PID=$!
+trap "ptree_abort $PID" EXIT INT TERM
+
+! interimap --debug || error
+
+# Make sure we show a warning but ignore ignore (unauthenticated) injected responses
+! grep -E 'remote: S: .*[ -]injected$' <"$STDERR" || error "unauthenticated response injection"
+grep -Fx 'remote: WARNING: Truncating non-empty output buffer (unauthenticated response injection?)' <"$STDERR" || error
+
+! grep -Fx 'remote: ERROR: Logins are disabled.' <"$STDERR" || error "injected capability wasn't ignored"
+grep -Fx 'remote: ERROR: Server did not advertise ENABLE (RFC 5161) capability.' <"$STDERR" || error "injected capability wasn't ignored"
+
+# vim: set filetype=sh :