diff options
Diffstat (limited to 'tests/starttls-injection')
-rwxr-xr-x | tests/starttls-injection/imapd | 77 | ||||
l--------- | tests/starttls-injection/interimap.remote | 1 | ||||
-rw-r--r-- | tests/starttls-injection/remote.conf | 6 | ||||
-rw-r--r-- | tests/starttls-injection/t | 16 |
4 files changed, 100 insertions, 0 deletions
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 : |