user/dev discussion of public-inbox itself
 help / color / mirror / code / Atom feed
From: Eric Wong <e@yhbt.net>
To: meta@public-inbox.org
Subject: [PATCH 03/82] preliminary imap server implementation
Date: Wed, 10 Jun 2020 07:04:00 +0000	[thread overview]
Message-ID: <20200610070519.18252-4-e@yhbt.net> (raw)
In-Reply-To: <20200610070519.18252-1-e@yhbt.net>

It shares a bit of code with NNTP.  It's copy+pasted for now
since this provides new ground to experiment with APIs for
dealing with slow storage and many inboxes.
---
 Documentation/public-inbox-imapd.pod |  91 +++++
 MANIFEST                             |   7 +
 lib/PublicInbox/Daemon.pm            |  24 +-
 lib/PublicInbox/IMAP.pm              | 523 +++++++++++++++++++++++++++
 lib/PublicInbox/IMAPD.pm             |  15 +
 lib/PublicInbox/IMAPdeflate.pm       | 119 ++++++
 lib/PublicInbox/Smsg.pm              |   8 +-
 script/public-inbox-imapd            |  14 +
 t/imapd-tls.t                        | 209 +++++++++++
 t/imapd.t                            | 149 ++++++++
 10 files changed, 1146 insertions(+), 13 deletions(-)
 create mode 100644 Documentation/public-inbox-imapd.pod
 create mode 100644 lib/PublicInbox/IMAP.pm
 create mode 100644 lib/PublicInbox/IMAPD.pm
 create mode 100644 lib/PublicInbox/IMAPdeflate.pm
 create mode 100644 script/public-inbox-imapd
 create mode 100644 t/imapd-tls.t
 create mode 100644 t/imapd.t

diff --git a/Documentation/public-inbox-imapd.pod b/Documentation/public-inbox-imapd.pod
new file mode 100644
index 00000000000..02027f4f254
--- /dev/null
+++ b/Documentation/public-inbox-imapd.pod
@@ -0,0 +1,91 @@
+=head1 NAME
+
+public-inbox-imapd - IMAP server for sharing public-inboxes
+
+=head1 SYNOPSIS
+
+B<public-inbox-imapd> [OPTIONS]
+
+=head1 DESCRIPTION
+
+public-inbox-imapd provides a read-only IMAP daemon for
+public-inbox.  It uses options and environment variables common
+to all L<public-inbox-daemon(8)> implementations.
+
+Like L<public-inbox-nntpd(1)> and L<public-inbox-httpd(1)>,
+C<public-inbox-imapd> will never require write access
+to the directory where the public-inboxes are stored, so it
+may be run as a different user than the user running
+L<public-inbox-watch(1)>, L<public-inbox-mda(1)>, or
+L<git-fetch(1)>.
+
+=head1 OPTIONS
+
+See common options in L<public-inbox-daemon(8)/OPTIONS>.
+Additionally, IMAP-specific behavior for certain options
+are supported and documented below.
+
+=over
+
+=item -l, --listen PROTO://ADDRESS/?cert=/path/to/cert,key=/path/to/key
+
+In addition to the normal C<-l>/C<--listen> switch described in
+L<public-inbox-daemon(8)>, the C<PROTO> prefix (e.g. C<imap://> or
+C<imaps://>) may be specified to force a given protocol.
+
+For STARTTLS and IMAPS support, the C<cert> and C<key> may be specified
+on a per-listener basis after a C<?> character and separated by C<,>.
+These directives are per-directive, and it's possible to use a different
+cert for every listener.
+
+=item --cert /path/to/cert
+
+The default TLS certificate for optional STARTTLS and IMAPS support
+if the C<cert> option is not given with C<--listen>.
+
+If using systemd-compatible socket activation and a TCP listener on port
+993 is inherited, it is automatically IMAPS when this option is given.
+When a listener on port 143 is inherited and this option is given, it
+automatically gets STARTTLS support.
+
+=item --key /path/to/key
+
+The default private TLS certificate key for optional STARTTLS and IMAPS
+support if the C<key> option is not given with C<--listen>.  The private
+key may concatenated into the path used by C<--cert>, in which case this
+option is not needed.
+
+=back
+
+=head1 CONFIGURATION
+
+C<public-inbox-imapd> uses the same configuration knobs
+as L<public-inbox-nntpd(1)>, see L<public-inbox-nntpd(1)>
+and L<public-inbox-config(5)>.
+
+=over 8
+
+=item publicinbox.<name>.newsgroup
+
+The newsgroup name maps to an IMAP folder name.
+
+=back
+
+=head1 CONTACT
+
+Feedback welcome via plain-text mail to L<mailto:meta@public-inbox.org>
+
+The mail archives are hosted at L<https://public-inbox.org/meta/>,
+L<nntp://news.public-inbox.org/inbox.comp.mail.public-inbox.meta>,
+L<nntp://hjrcffqmbrq6wope.onion/inbox.comp.mail.public-inbox.meta>
+
+=head1 COPYRIGHT
+
+Copyright 2020 all contributors L<mailto:meta@public-inbox.org>
+
+License: AGPL-3.0+ L<https://www.gnu.org/licenses/agpl-3.0.txt>
+
+=head1 SEE ALSO
+
+L<git(1)>, L<git-config(1)>, L<public-inbox-daemon(8)>,
+L<public-inbox-config(5)>, L<public-inbox-nntpd(1)>
diff --git a/MANIFEST b/MANIFEST
index 24f95faa942..73b874b42a0 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -26,6 +26,7 @@ Documentation/public-inbox-convert.pod
 Documentation/public-inbox-daemon.pod
 Documentation/public-inbox-edit.pod
 Documentation/public-inbox-httpd.pod
+Documentation/public-inbox-imapd.pod
 Documentation/public-inbox-index.pod
 Documentation/public-inbox-init.pod
 Documentation/public-inbox-learn.pod
@@ -124,6 +125,9 @@ lib/PublicInbox/HTTPD.pm
 lib/PublicInbox/HTTPD/Async.pm
 lib/PublicInbox/HlMod.pm
 lib/PublicInbox/Hval.pm
+lib/PublicInbox/IMAP.pm
+lib/PublicInbox/IMAPD.pm
+lib/PublicInbox/IMAPdeflate.pm
 lib/PublicInbox/Import.pm
 lib/PublicInbox/Inbox.pm
 lib/PublicInbox/InboxWritable.pm
@@ -193,6 +197,7 @@ script/public-inbox-compact
 script/public-inbox-convert
 script/public-inbox-edit
 script/public-inbox-httpd
+script/public-inbox-imapd
 script/public-inbox-index
 script/public-inbox-init
 script/public-inbox-learn
@@ -257,6 +262,8 @@ t/httpd-https.t
 t/httpd-unix.t
 t/httpd.t
 t/hval.t
+t/imapd-tls.t
+t/imapd.t
 t/import.t
 t/inbox.t
 t/index-git-times.t
diff --git a/lib/PublicInbox/Daemon.pm b/lib/PublicInbox/Daemon.pm
index 4ff7cad4939..2f63bd73b4a 100644
--- a/lib/PublicInbox/Daemon.pm
+++ b/lib/PublicInbox/Daemon.pm
@@ -1,6 +1,6 @@
 # Copyright (C) 2015-2020 all contributors <meta@public-inbox.org>
 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
-# contains common daemon code for the nntpd and httpd servers.
+# contains common daemon code for the httpd, imapd, and nntpd servers.
 # This may be used for read-only IMAP server if we decide to implement it.
 package PublicInbox::Daemon;
 use strict;
@@ -29,8 +29,8 @@ my %tls_opt; # scheme://sockname => args for IO::Socket::SSL->start_SSL
 my $reexec_pid;
 my ($uid, $gid);
 my ($default_cert, $default_key);
-my %KNOWN_TLS = ( 443 => 'https', 563 => 'nntps' );
-my %KNOWN_STARTTLS = ( 119 => 'nntp' );
+my %KNOWN_TLS = ( 443 => 'https', 563 => 'nntps', 993 => 'imaps' );
+my %KNOWN_STARTTLS = ( 119 => 'nntp', 143 => 'imap' );
 
 sub accept_tls_opt ($) {
 	my ($opt_str) = @_;
@@ -123,7 +123,7 @@ sub daemon_prepare ($) {
 			$tls_opt{"$scheme://$l"} = accept_tls_opt($1);
 		} elsif (defined($default_cert)) {
 			$tls_opt{"$scheme://$l"} = accept_tls_opt('');
-		} elsif ($scheme =~ /\A(?:nntps|https)\z/) {
+		} elsif ($scheme =~ /\A(?:https|imaps|imaps)\z/) {
 			die "$orig specified w/o cert=\n";
 		}
 		# TODO: use scheme to load either NNTP.pm or HTTP.pm
@@ -584,13 +584,13 @@ sub defer_accept ($$) {
 }
 
 sub daemon_loop ($$$$) {
-	my ($refresh, $post_accept, $nntpd, $af_default) = @_;
+	my ($refresh, $post_accept, $tlsd, $af_default) = @_;
 	my %post_accept;
 	while (my ($k, $v) = each %tls_opt) {
-		if ($k =~ s!\A(?:nntps|https)://!!) {
+		if ($k =~ s!\A(?:https|imaps|nntps)://!!) {
 			$post_accept{$k} = tls_start_cb($v, $post_accept);
-		} elsif ($nntpd) { # STARTTLS, $k eq '' is OK
-			$nntpd->{accept_tls} = $v;
+		} elsif ($tlsd) { # STARTTLS, $k eq '' is OK
+			$tlsd->{accept_tls} = $v;
 		}
 	}
 	my $sig = {
@@ -620,8 +620,8 @@ sub daemon_loop ($$$$) {
 	@listeners = map {;
 		my $tls_cb = $post_accept{sockname($_)};
 
-		# NNTPS, HTTPS, HTTP, and POP3S are client-first traffic
-		# NNTP and POP3 are server-first
+		# NNTPS, HTTPS, HTTP, IMAPS and POP3S are client-first traffic
+		# IMAP, NNTP and POP3 are server-first
 		defer_accept($_, $tls_cb ? 'dataready' : $af_default);
 
 		# this calls epoll_create:
@@ -639,12 +639,12 @@ sub daemon_loop ($$$$) {
 }
 
 sub run ($$$;$) {
-	my ($default, $refresh, $post_accept, $nntpd) = @_;
+	my ($default, $refresh, $post_accept, $tlsd) = @_;
 	local $SIG{PIPE} = 'IGNORE';
 	daemon_prepare($default);
 	my $af_default = $default =~ /:8080\z/ ? 'httpready' : undef;
 	my $for_destroy = daemonize();
-	daemon_loop($refresh, $post_accept, $nntpd, $af_default);
+	daemon_loop($refresh, $post_accept, $tlsd, $af_default);
 	PublicInbox::DS->Reset;
 	# ->DESTROY runs when $for_destroy goes out-of-scope
 }
diff --git a/lib/PublicInbox/IMAP.pm b/lib/PublicInbox/IMAP.pm
new file mode 100644
index 00000000000..c0636066b9f
--- /dev/null
+++ b/lib/PublicInbox/IMAP.pm
@@ -0,0 +1,523 @@
+# Copyright (C) 2020 all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+#
+# Each instance of this represents an IMAP client connected to
+# public-inbox-imapd.  Much of this was taken from NNTP, but
+# further refined while experimenting on future ideas to handle
+# slow storage.
+#
+# data notes:
+# * NNTP article numbers are UIDs and message sequence numbers (MSNs)
+# * Message sequence numbers (MSNs) can be stable since we're read-only.
+#   Most IMAP clients use UIDs (I hope), and we can return a dummy
+#   message if a client requests a non-existent MSN.
+
+package PublicInbox::IMAP;
+use strict;
+use base qw(PublicInbox::DS);
+use fields qw(imapd logged_in ibx long_cb -login_tag);
+use PublicInbox::Eml;
+use PublicInbox::DS qw(now);
+use PublicInbox::Syscall qw(EPOLLIN EPOLLONESHOT);
+use Errno qw(EAGAIN);
+my $Address;
+for my $mod (qw(Email::Address::XS Mail::Address)) {
+	eval "require $mod" or next;
+	$Address = $mod and last;
+}
+die "neither Email::Address::XS nor Mail::Address loaded: $@" if !$Address;
+
+sub LINE_MAX () { 512 } # does RFC 3501 have a limit like RFC 977?
+
+my %FETCH_NEED_BLOB = ( # for future optimization
+	'BODY.PEEK[HEADER]' => 1,
+	'BODY.PEEK[TEXT]' => 1,
+	'BODY.PEEK[]' => 1,
+	'BODY[HEADER]' => 1,
+	'BODY[TEXT]' => 1,
+	'BODY[]' => 1,
+	'RFC822.HEADER' => 1,
+	'RFC822.SIZE' => 1, # needs CRLF conversion :<
+	'RFC822.TEXT' => 1,
+	BODY => 1,
+	BODYSTRUCTURE => 1,
+	ENVELOPE => 1,
+	FLAGS => 0,
+	INTERNALDATE => 0,
+	RFC822 => 1,
+	UID => 0,
+);
+my %FETCH_ATT = map { $_ => [ $_ ] } keys %FETCH_NEED_BLOB;
+
+# aliases (RFC 3501 section 6.4.5)
+$FETCH_ATT{FAST} = [ qw(FLAGS INTERNALDATE RFC822.SIZE) ];
+$FETCH_ATT{ALL} = [ @{$FETCH_ATT{FAST}}, 'ENVELOPE' ];
+$FETCH_ATT{FULL} = [ @{$FETCH_ATT{ALL}}, 'BODY' ];
+
+for my $att (keys %FETCH_ATT) {
+	my %h = map { $_ => 1 } @{$FETCH_ATT{$att}};
+	$FETCH_ATT{$att} = \%h;
+}
+
+sub greet ($) {
+	my ($self) = @_;
+	my $capa = capa($self);
+	$self->write(\"* OK [$capa] public-inbox-imapd ready\r\n");
+}
+
+sub new ($$$) {
+	my ($class, $sock, $imapd) = @_;
+	my $self = fields::new($class);
+	my $ev = EPOLLIN;
+	my $wbuf;
+	if ($sock->can('accept_SSL') && !$sock->accept_SSL) {
+		return CORE::close($sock) if $! != EAGAIN;
+		$ev = PublicInbox::TLS::epollbit();
+		$wbuf = [ \&PublicInbox::DS::accept_tls_step, \&greet ];
+	}
+	$self->SUPER::new($sock, $ev | EPOLLONESHOT);
+	$self->{imapd} = $imapd;
+	if ($wbuf) {
+		$self->{wbuf} = $wbuf;
+	} else {
+		greet($self);
+	}
+	$self->update_idle_time;
+	$self;
+}
+
+sub capa ($) {
+	my ($self) = @_;
+	my $capa = 'CAPABILITY IMAP4rev1';
+	if ($self->{logged_in}) {
+		$capa .= ' COMPRESS=DEFLATE';
+	} else {
+		if (!($self->{sock} // $self)->can('accept_SSL') &&
+			$self->{imapd}->{accept_tls}) {
+			$capa .= ' STARTTLS';
+		}
+		$capa .= ' AUTH=ANONYMOUS';
+	}
+}
+
+sub login_success ($$) {
+	my ($self, $tag) = @_;
+	$self->{logged_in} = 1;
+	my $capa = capa($self);
+	"$tag OK [$capa] Logged in\r\n";
+}
+
+sub auth_challenge_ok ($) {
+	my ($self) = @_;
+	my $tag = delete($self->{-login_tag}) or return;
+	login_success($self, $tag);
+}
+
+sub cmd_login ($$$$) {
+	my ($self, $tag) = @_; # ignore ($user, $password) = ($_[2], $_[3])
+	login_success($self, $tag);
+}
+
+sub cmd_logout ($$) {
+	my ($self, $tag) = @_;
+	delete $self->{logged_in};
+	$self->write(\"* BYE logging out\r\n$tag OK logout completed\r\n");
+	$self->shutdn; # PublicInbox::DS::shutdn
+	undef;
+}
+
+sub cmd_authenticate ($$$) {
+	my ($self, $tag) = @_; # $method = $_[2], should be "ANONYMOUS"
+	$self->{-login_tag} = $tag;
+	"+\r\n"; # challenge
+}
+
+sub cmd_capability ($$) {
+	my ($self, $tag) = @_;
+	'* '.capa($self)."\r\n$tag OK\r\n";
+}
+
+sub cmd_noop ($$) { "$_[1] OK NOOP completed\r\n" }
+
+sub cmd_examine ($$$) {
+	my ($self, $tag, $mailbox) = @_;
+	my $ibx = $self->{imapd}->{groups}->{$mailbox} or
+		return "$tag NO Mailbox doesn't exist: $mailbox\r\n";
+	my $mm = $ibx->mm;
+	my $max = $mm->num_highwater // 0;
+	# RFC 3501 2.3.1.1 -  "A good UIDVALIDITY value to use in
+	# this case is a 32-bit representation of the creation
+	# date/time of the mailbox"
+	my $uidvalidity = $mm->created_at or return "$tag BAD UIDVALIDITY\r\n";
+	my $uidnext = $max + 1;
+
+	# XXX: do we need this? RFC 5162/7162
+	my $ret = $self->{ibx} ? "* OK [CLOSED] previous closed\r\n" : '';
+	$self->{ibx} = $ibx;
+	$ret .= <<EOF;
+* $max EXISTS\r
+* $max RECENT\r
+* FLAGS (\\Seen)\r
+* OK [PERMANENTFLAGS ()] Read-only mailbox\r
+EOF
+	$ret .= "* OK [UNSEEN $max]\r\n" if $max;
+	$ret .= "* OK [UIDNEXT $uidnext]\r\n" if defined $uidnext;
+	$ret .= "* OK [UIDVALIDITY $uidvalidity]\r\n" if defined $uidvalidity;
+	$ret .= "$tag OK [READ-ONLY] EXAMINE/SELECT complete\r\n";
+}
+
+sub _esc ($) {
+	my ($v) = @_;
+	if (!defined($v)) {
+		'NIL';
+	} elsif ($v =~ /[{"\r\n%*\\\[]/) { # literal string
+		'{' . length($v) . "}\r\n" . $v;
+	} else { # quoted string
+		qq{"$v"}
+	}
+}
+
+sub addr_envelope ($$;$) {
+	my ($eml, $x, $y) = @_;
+	my $v = $eml->header_raw($x) //
+		($y ? $eml->header_raw($y) : undef) // return 'NIL';
+
+	my @x = $Address->parse($v) or return 'NIL';
+	'(' . join('',
+		map { '(' . join(' ',
+				_esc($_->name), 'NIL',
+				_esc($_->user), _esc($_->host)
+			) . ')'
+		} @x) .
+	')';
+}
+
+sub eml_envelope ($) {
+	my ($eml) = @_;
+	'(' . join(' ',
+		_esc($eml->header_raw('Date')),
+		_esc($eml->header_raw('Subject')),
+		addr_envelope($eml, 'From'),
+		addr_envelope($eml, 'Sender', 'From'),
+		addr_envelope($eml, 'Reply-To', 'From'),
+		addr_envelope($eml, 'To'),
+		addr_envelope($eml, 'Cc'),
+		addr_envelope($eml, 'Bcc'),
+		_esc($eml->header_raw('In-Reply-To')),
+		_esc($eml->header_raw('Message-ID')),
+	) . ')';
+}
+
+sub uid_fetch_cb { # called by git->cat_async
+	my ($bref, $oid, $type, $size, $fetch_m_arg) = @_;
+	my ($self, undef, $ibx, undef, undef, $msgs, $want) = @$fetch_m_arg;
+	my $smsg = shift @$msgs or die 'BUG: no smsg';
+	$smsg->{blob} eq $oid or die "BUG: $smsg->{blob} != $oid";
+	$$bref =~ s/(?<!\r)\n/\r\n/sg; # make strict clients happy
+
+	# fixup old bug from import (pre-a0c07cba0e5d8b6a)
+	$$bref =~ s/\A[\r\n]*From [^\r\n]*\r\n//s;
+
+	$self->msg_more("* $smsg->{num} FETCH (UID $smsg->{num}");
+
+	$want->{'RFC822.SIZE'} and
+		$self->msg_more(' RFC822.SIZE '.length($$bref));
+	$want->{INTERNALDATE} and
+		$self->msg_more(' INTERNALDATE "'.$smsg->internaldate.'"');
+	$want->{FLAGS} and $self->msg_more(' FLAGS ()');
+	for ('RFC822', 'BODY[]', 'BODY.PEEK[]') {
+		next unless $want->{$_};
+		$self->msg_more(" $_ {".length($$bref)."}\r\n");
+		$self->msg_more($$bref);
+	}
+
+	my $eml = PublicInbox::Eml->new($bref);
+
+	$want->{ENVELOPE} and
+		$self->msg_more(' ENVELOPE '.eml_envelope($eml));
+
+	for my $f ('RFC822.HEADER', 'BODY[HEADER]', 'BODY.PEEK[HEADER]') {
+		next unless $want->{$f};
+		$self->msg_more(" $f {".length(${$eml->{hdr}})."}\r\n");
+		$self->msg_more(${$eml->{hdr}});
+	}
+	for my $f ('RFC822.TEXT', 'BODY[TEXT]') {
+		next unless $want->{$f};
+		$self->msg_more(" $f {".length($$bref)."}\r\n");
+		$self->msg_more($$bref);
+	}
+	# TODO BODY/BODYSTRUCTURE, specific headers
+	$self->msg_more(")\r\n");
+}
+
+sub uid_fetch_m { # long_response
+	my ($self, $tag, $ibx, $beg, $end, $msgs, $want) = @_;
+	if (!@$msgs) { # refill
+		@$msgs = @{$ibx->over->query_xover($$beg, $end)};
+		if (!@$msgs) {
+			$self->write(\"$tag OK Fetch done\r\n");
+			return;
+		}
+		$$beg = $msgs->[-1]->{num} + 1;
+	}
+	my $git = $ibx->git;
+	$git->cat_async_begin; # TODO: actually make async
+	$git->cat_async($msgs->[0]->{blob}, \&uid_fetch_cb, \@_);
+	$git->cat_async_wait;
+	1;
+}
+
+sub cmd_uid_fetch ($$$;@) {
+	my ($self, $tag, $range, @want) = @_;
+	my $ibx = $self->{ibx} or return "$tag BAD No mailbox selected\r\n";
+	if ($want[0] =~ s/\A\(//s) {
+		$want[-1] =~ s/\)\z//s or return "$tag BAD no rparen\r\n";
+	}
+	my %want = map {;
+		my $x = $FETCH_ATT{uc($_)} or return "$tag BAD param: $_\r\n";
+		%$x;
+	} @want;
+	my ($beg, $end);
+	my $msgs = [];
+	if ($range =~ /\A([0-9]+):([0-9]+)\z/s) {
+		($beg, $end) = ($1, $2);
+	} elsif ($range =~ /\A([0-9]+):\*\z/s) {
+		($beg, $end) =  ($1, $ibx->mm->num_highwater // 0);
+	} elsif ($range =~ /\A[0-9]+\z/) {
+		my $smsg = $ibx->over->get_art($range) or return "$tag OK\r\n";
+		push @$msgs, $smsg;
+		($beg, $end) = ($range, 0);
+	} else {
+		return "$tag BAD\r\n";
+	}
+	long_response($self, \&uid_fetch_m, $tag, $ibx,
+				\$beg, $end, $msgs, \%want);
+}
+
+sub uid_search_all { # long_response
+	my ($self, $tag, $ibx, $num) = @_;
+	my $uids = $ibx->mm->ids_after($num);
+	if (scalar(@$uids)) {
+		$self->msg_more(join(' ', '', @$uids));
+	} else {
+		$self->write(\"\r\n$tag OK\r\n");
+		undef;
+	}
+}
+
+sub uid_search_uid_range { # long_response
+	my ($self, $tag, $ibx, $beg, $end) = @_;
+	my $uids = $ibx->mm->msg_range($beg, $end, 'num');
+	if (@$uids) {
+		$self->msg_more(join('', map { " $_->[0]" } @$uids));
+	} else {
+		$self->write(\"\r\n$tag OK\r\n");
+		undef;
+	}
+}
+
+sub cmd_uid_search ($$$;) {
+	my ($self, $tag, $arg, @rest) = @_;
+	my $ibx = $self->{ibx} or return "$tag BAD No mailbox selected\r\n";
+	$arg = uc($arg);
+	if ($arg eq 'ALL' && !@rest) {
+		$self->msg_more('* SEARCH');
+		my $num = 0;
+		long_response($self, \&uid_search_all, $tag, $ibx, \$num);
+	} elsif ($arg eq 'UID' && scalar(@rest) == 1) {
+		if ($rest[0] =~ /\A([0-9]+):([0-9]+|\*)\z/s) {
+			my ($beg, $end) = ($1, $2);
+			$end = ($ibx->mm->minmax)[1] if $end eq '*';
+			$self->msg_more('* SEARCH');
+			long_response($self, \&uid_search_uid_range,
+					$tag, $ibx, \$beg, $end);
+		} elsif ($rest[0] =~ /\A[0-9]+\z/s) {
+			my $uid = $rest[0];
+			$uid = $ibx->over->get_art($uid) ? " $uid" : '';
+			"* SEARCH$uid\r\n$tag OK\r\n";
+		} else {
+			"$tag BAD\r\n";
+		}
+	} else {
+		"$tag BAD\r\n";
+	}
+}
+
+sub args_ok ($$) { # duplicated from PublicInbox::NNTP
+	my ($cb, $argc) = @_;
+	my $tot = prototype $cb;
+	my ($nreq, undef) = split(';', $tot);
+	$nreq = ($nreq =~ tr/$//) - 1;
+	$tot = ($tot =~ tr/$//) - 1;
+	($argc <= $tot && $argc >= $nreq);
+}
+
+# returns 1 if we can continue, 0 if not due to buffered writes or disconnect
+sub process_line ($$) {
+	my ($self, $l) = @_;
+	my ($tag, $req, @args) = split(/[ \t]+/, $l);
+	if (@args && uc($req) eq 'UID') {
+		$req .= "_".(shift @args);
+	}
+	my $res = eval {
+		if (my $cmd = $self->can('cmd_'.lc($req // ''))) {
+			$cmd->($self, $tag, @args);
+		} else { # this is weird
+			auth_challenge_ok($self) //
+				"$tag BAD Error in IMAP command $req: ".
+				"Unknown command\r\n";
+		}
+	};
+	my $err = $@;
+	if ($err && $self->{sock}) {
+		$l =~ s/\r?\n//s;
+		err($self, 'error from: %s (%s)', $l, $err);
+		$res = "$tag BAD program fault - command not performed\r\n";
+	}
+	return 0 unless defined $res;
+	$self->write($res);
+}
+
+sub long_step {
+	my ($self) = @_;
+	# wbuf is unset or empty, here; {long} may add to it
+	my ($fd, $cb, $t0, @args) = @{$self->{long_cb}};
+	my $more = eval { $cb->($self, @args) };
+	if ($@ || !$self->{sock}) { # something bad happened...
+		delete $self->{long_cb};
+		my $elapsed = now() - $t0;
+		if ($@) {
+			err($self,
+			    "%s during long response[$fd] - %0.6f",
+			    $@, $elapsed);
+		}
+		out($self, " deferred[$fd] aborted - %0.6f", $elapsed);
+		$self->close;
+	} elsif ($more) { # $self->{wbuf}:
+		$self->update_idle_time;
+
+		# COMPRESS users all share the same DEFLATE context.
+		# Flush it here to ensure clients don't see
+		# each other's data
+		$self->zflush;
+
+		# no recursion, schedule another call ASAP, but only after
+		# all pending writes are done.  autovivify wbuf:
+		my $new_size = push(@{$self->{wbuf}}, \&long_step);
+
+		# wbuf may be populated by $cb, no need to rearm if so:
+		$self->requeue if $new_size == 1;
+	} else { # all done!
+		delete $self->{long_cb};
+		my $elapsed = now() - $t0;
+		my $fd = fileno($self->{sock});
+		out($self, " deferred[$fd] done - %0.6f", $elapsed);
+		my $wbuf = $self->{wbuf}; # do NOT autovivify
+
+		$self->requeue unless $wbuf && @$wbuf;
+	}
+}
+
+sub err ($$;@) {
+	my ($self, $fmt, @args) = @_;
+	printf { $self->{imapd}->{err} } $fmt."\n", @args;
+}
+
+sub out ($$;@) {
+	my ($self, $fmt, @args) = @_;
+	printf { $self->{imapd}->{out} } $fmt."\n", @args;
+}
+
+sub long_response ($$;@) {
+	my ($self, $cb, @args) = @_; # cb returns true if more, false if done
+
+	my $sock = $self->{sock} or return;
+	# make sure we disable reading during a long response,
+	# clients should not be sending us stuff and making us do more
+	# work while we are stream a response to them
+	$self->{long_cb} = [ fileno($sock), $cb, now(), @args ];
+	long_step($self); # kick off!
+	undef;
+}
+
+# callback used by PublicInbox::DS for any (e)poll (in/out/hup/err)
+sub event_step {
+	my ($self) = @_;
+
+	return unless $self->flush_write && $self->{sock};
+
+	$self->update_idle_time;
+	# only read more requests if we've drained the write buffer,
+	# otherwise we can be buffering infinitely w/o backpressure
+
+	my $rbuf = $self->{rbuf} // (\(my $x = ''));
+	my $r = 1;
+
+	if (index($$rbuf, "\n") < 0) {
+		my $off = length($$rbuf);
+		$r = $self->do_read($rbuf, LINE_MAX, $off) or return;
+	}
+	while ($r > 0 && $$rbuf =~ s/\A[ \t]*([^\n]*?)\r?\n//) {
+		my $line = $1;
+		return $self->close if $line =~ /[[:cntrl:]]/s;
+		my $t0 = now();
+		my $fd = fileno($self->{sock});
+		$r = eval { process_line($self, $line) };
+		my $pending = $self->{wbuf} ? ' pending' : '';
+		out($self, "[$fd] %s - %0.6f$pending", $line, now() - $t0);
+	}
+
+	return $self->close if $r < 0;
+	my $len = length($$rbuf);
+	return $self->close if ($len >= LINE_MAX);
+	$self->rbuf_idle($rbuf);
+	$self->update_idle_time;
+
+	# maybe there's more pipelined data, or we'll have
+	# to register it for socket-readiness notifications
+	$self->requeue unless $self->{wbuf};
+}
+
+sub compressed { undef }
+
+sub zflush {} # overridden by IMAPdeflate
+
+# RFC 4978
+sub cmd_compress ($$$) {
+	my ($self, $tag, $alg) = @_;
+	return "$tag BAD DEFLATE only\r\n" if uc($alg) ne "DEFLATE";
+	return "$tag BAD COMPRESS active\r\n" if $self->compressed;
+
+	# CRIME made TLS compression obsolete
+	# return "$tag NO [COMPRESSIONACTIVE]\r\n" if $self->tls_compressed;
+
+	PublicInbox::IMAPdeflate->enable($self, $tag);
+	$self->requeue;
+	undef
+}
+
+sub cmd_starttls ($$) {
+	my ($self, $tag) = @_;
+	my $sock = $self->{sock} or return;
+	if ($sock->can('stop_SSL') || $self->compressed) {
+		return "$tag BAD TLS or compression already enabled\r\n";
+	}
+	my $opt = $self->{imapd}->{accept_tls} or
+		return "$tag BAD can not initiate TLS negotiation\r\n";
+	$self->write(\"$tag OK begin TLS negotiation now\r\n");
+	$self->{sock} = IO::Socket::SSL->start_SSL($sock, %$opt);
+	$self->requeue if PublicInbox::DS::accept_tls_step($self);
+	undef;
+}
+
+# for graceful shutdown in PublicInbox::Daemon:
+sub busy {
+	my ($self, $now) = @_;
+	($self->{rbuf} || $self->{wbuf} || $self->not_idle_long($now));
+}
+
+# we're read-only, so SELECT and EXAMINE do the same thing
+no warnings 'once';
+*cmd_select = \&cmd_examine;
+
+1;
diff --git a/lib/PublicInbox/IMAPD.pm b/lib/PublicInbox/IMAPD.pm
new file mode 100644
index 00000000000..1011d6a413b
--- /dev/null
+++ b/lib/PublicInbox/IMAPD.pm
@@ -0,0 +1,15 @@
+# Copyright (C) 2020 all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+
+# represents an IMAPD (currently a singleton),
+# see script/public-inbox-imapd for how it is used
+package PublicInbox::IMAPD;
+use strict;
+use parent qw(PublicInbox::NNTPD);
+
+sub new {
+	my ($class) = @_;
+	$class->SUPER::new; # PublicInbox::NNTPD->new
+}
+
+1;
diff --git a/lib/PublicInbox/IMAPdeflate.pm b/lib/PublicInbox/IMAPdeflate.pm
new file mode 100644
index 00000000000..9366db7a7fc
--- /dev/null
+++ b/lib/PublicInbox/IMAPdeflate.pm
@@ -0,0 +1,119 @@
+# Copyright (C) 2020 all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+# TODO: reduce duplication from PublicInbox::NNTPdeflate
+
+# RFC 4978
+package PublicInbox::IMAPdeflate;
+use strict;
+use warnings;
+use 5.010_001;
+use base qw(PublicInbox::IMAP);
+use Compress::Raw::Zlib;
+use Hash::Util qw(unlock_hash); # dependency of fields for perl 5.10+, anyways
+
+my %IN_OPT = (
+	-Bufsize => 1024,
+	-WindowBits => -15, # RFC 1951
+	-AppendOutput => 1,
+);
+
+# global deflate context and buffer
+my $zbuf = \(my $buf = '');
+my $zout;
+{
+	my $err;
+	($zout, $err) = Compress::Raw::Zlib::Deflate->new(
+		# nnrpd (INN) and Compress::Raw::Zlib favor MemLevel=9,
+		# the zlib C library and git use MemLevel=8 as the default
+		# -MemLevel => 9,
+		-Bufsize => 65536, # same as nnrpd
+		-WindowBits => -15, # RFC 1951
+		-AppendOutput => 1,
+	);
+	$err == Z_OK or die "Failed to initialize zlib deflate stream: $err";
+}
+
+sub enable {
+	my ($class, $self, $tag) = @_;
+	my ($in, $err) = Compress::Raw::Zlib::Inflate->new(%IN_OPT);
+	if ($err != Z_OK) {
+		$self->err("Inflate->new failed: $err");
+		$self->write(\"$tag BAD failed to activate compression\r\n");
+		return;
+	}
+	unlock_hash(%$self);
+	$self->write(\"$tag OK DEFLATE active\r\n");
+	bless $self, $class;
+	$self->{zin} = $in;
+}
+
+# overrides PublicInbox::NNTP::compressed
+sub compressed { 1 }
+
+# $_[1] may be a reference or not
+sub do_read ($$$$) {
+	my ($self, $rbuf, $len, $off) = @_;
+
+	my $zin = $self->{zin} or return; # closed
+	my $doff;
+	my $dbuf = delete($self->{dbuf}) // '';
+	$doff = length($dbuf);
+	my $r = PublicInbox::DS::do_read($self, \$dbuf, $len, $doff) or return;
+
+	# assert(length($$rbuf) == $off) as far as NNTP.pm is concerned
+	# -ConsumeInput is true, so $dbuf is automatically emptied
+	my $err = $zin->inflate($dbuf, $rbuf);
+	if ($err == Z_OK) {
+		$self->{dbuf} = $dbuf if $dbuf ne '';
+		$r = length($$rbuf) and return $r;
+		# nothing ready, yet, get more, later
+		$self->requeue;
+	} else {
+		delete $self->{zin};
+		$self->close;
+	}
+	0;
+}
+
+# override PublicInbox::DS::msg_more
+sub msg_more ($$) {
+	my $self = $_[0];
+
+	# $_[1] may be a reference or not for ->deflate
+	my $err = $zout->deflate($_[1], $zbuf);
+	$err == Z_OK or die "->deflate failed $err";
+	1;
+}
+
+sub zflush ($) {
+	my ($self) = @_;
+
+	my $deflated = $zbuf;
+	$zbuf = \(my $next = '');
+
+	my $err = $zout->flush($deflated, Z_FULL_FLUSH);
+	$err == Z_OK or die "->flush failed $err";
+
+	# We can still let the lower socket layer do buffering:
+	PublicInbox::DS::msg_more($self, $$deflated);
+}
+
+# compatible with PublicInbox::DS::write, so $_[1] may be a reference or not
+sub write ($$) {
+	my $self = $_[0];
+	return PublicInbox::DS::write($self, $_[1]) if ref($_[1]) eq 'CODE';
+
+	my $deflated = $zbuf;
+	$zbuf = \(my $next = '');
+
+	# $_[1] may be a reference or not for ->deflate
+	my $err = $zout->deflate($_[1], $deflated);
+	$err == Z_OK or die "->deflate failed $err";
+	$err = $zout->flush($deflated, Z_FULL_FLUSH);
+	$err == Z_OK or die "->flush failed $err";
+
+	# We can still let the socket layer do buffering:
+	PublicInbox::DS::write($self, $deflated);
+}
+
+1;
diff --git a/lib/PublicInbox/Smsg.pm b/lib/PublicInbox/Smsg.pm
index e8f9c9a3681..725d4206282 100644
--- a/lib/PublicInbox/Smsg.pm
+++ b/lib/PublicInbox/Smsg.pm
@@ -131,14 +131,20 @@ sub populate {
 my @DoW = qw(Sun Mon Tue Wed Thu Fri Sat);
 my @MoY = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
 
-sub date ($) {
+sub date ($) { # for NNTP
 	my ($self) = @_;
 	my $ds = $self->{ds};
 	return unless defined $ds;
 	my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($ds);
 	"$DoW[$wday], " . sprintf("%02d $MoY[$mon] %04d %02d:%02d:%02d +0000",
 				$mday, $year+1900, $hour, $min, $sec);
+}
 
+sub internaldate { # for IMAP
+	my ($self) = @_;
+	my ($sec, $min, $hour, $mday, $mon, $year) = gmtime($self->{ts} // 0);
+	sprintf("%02d-$MoY[$mon]-%04d %02d:%02d:%02d +0000",
+				$mday, $year+1900, $hour, $min, $sec);
 }
 
 our $REPLY_RE = qr/^re:\s+/i;
diff --git a/script/public-inbox-imapd b/script/public-inbox-imapd
new file mode 100644
index 00000000000..63f865f53f0
--- /dev/null
+++ b/script/public-inbox-imapd
@@ -0,0 +1,14 @@
+#!perl -w
+# Copyright (C) 2020 all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+#
+# Standalone read-only IMAP server for public-inbox.
+use strict;
+use PublicInbox::Daemon;
+use PublicInbox::IMAPdeflate; # loads PublicInbox::IMAP
+use PublicInbox::IMAPD;
+my $imapd = PublicInbox::IMAPD->new;
+PublicInbox::Daemon::run('0.0.0.0:143',
+	sub { $imapd->refresh_groups }, # refresh
+	sub ($$$) { PublicInbox::IMAP->new($_[0], $imapd) }, # post_accept
+	$imapd);
diff --git a/t/imapd-tls.t b/t/imapd-tls.t
new file mode 100644
index 00000000000..9f5abfe048e
--- /dev/null
+++ b/t/imapd-tls.t
@@ -0,0 +1,209 @@
+# Copyright (C) 2020 all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+use strict;
+use warnings;
+use Test::More;
+use Socket qw(IPPROTO_TCP SOL_SOCKET);
+use PublicInbox::TestCommon;
+# IO::Poll is part of the standard library, but distros may split it off...
+require_mods(qw(DBD::SQLite IO::Socket::SSL Mail::IMAPClient IO::Poll));
+Mail::IMAPClient->can('starttls') or
+	plan skip_all => 'Mail::IMAPClient does not support TLS';
+my $cert = 'certs/server-cert.pem';
+my $key = 'certs/server-key.pem';
+unless (-r $key && -r $cert) {
+	plan skip_all =>
+		"certs/ missing for $0, run $^X ./create-certs.perl in certs/";
+}
+use_ok 'PublicInbox::TLS';
+use_ok 'IO::Socket::SSL';
+use PublicInbox::InboxWritable;
+require PublicInbox::SearchIdx;
+my $version = 1; # v2 needs newer git
+require_git('2.6') if $version >= 2;
+my ($tmpdir, $for_destroy) = tmpdir();
+my $err = "$tmpdir/stderr.log";
+my $out = "$tmpdir/stdout.log";
+my $inboxdir = "$tmpdir";
+my $pi_config = "$tmpdir/pi_config";
+my $group = 'test-imapd-tls';
+my $addr = $group . '@example.com';
+my $starttls = tcp_server();
+my $imaps = tcp_server();
+my $ibx = PublicInbox::Inbox->new({
+	inboxdir => $inboxdir,
+	name => 'imapd-tls',
+	version => $version,
+	-primary_address => $addr,
+	indexlevel => 'basic',
+});
+$ibx = PublicInbox::InboxWritable->new($ibx, {nproc=>1});
+$ibx->init_inbox(0);
+{
+	open my $fh, '>', $pi_config or BAIL_OUT "open: $!";
+	print $fh <<EOF
+[publicinbox "imapd-tls"]
+	inboxdir = $inboxdir
+	address = $addr
+	indexlevel = basic
+	newsgroup = $group
+EOF
+	;
+	close $fh or BAIL_OUT "close: $!\n";
+}
+
+{
+	my $im = $ibx->importer(0);
+	ok($im->add(eml_load('t/data/0001.patch')), 'message added');
+	$im->done;
+	if ($version == 1) {
+		my $s = PublicInbox::SearchIdx->new($ibx, 1);
+		$s->index_sync;
+	}
+}
+
+my $imaps_addr = $imaps->sockhost . ':' . $imaps->sockport;
+my $starttls_addr = $starttls->sockhost . ':' . $starttls->sockport;
+my $env = { PI_CONFIG => $pi_config };
+my $td;
+
+# Mail::IMAPClient ->compress creates cyclic reference:
+# https://rt.cpan.org/Ticket/Display.html?id=132654
+my $compress_logout = sub {
+	my ($c) = @_;
+	ok($c->logout, 'logout ok after ->compress');
+	# all documented in Mail::IMAPClient manpage:
+	for (qw(Readmoremethod Readmethod Prewritemethod)) {
+		$c->$_(undef);
+	}
+};
+
+
+for my $args (
+	[ "--cert=$cert", "--key=$key",
+		"-limaps://$imaps_addr",
+		"-limap://$starttls_addr" ],
+) {
+	for ($out, $err) {
+		open my $fh, '>', $_ or BAIL_OUT "truncate: $!";
+	}
+	my $cmd = [ '-imapd', '-W0', @$args, "--stdout=$out", "--stderr=$err" ];
+	$td = start_script($cmd, $env, { 3 => $starttls, 4 => $imaps });
+	my %o = (
+		SSL_hostname => 'server.local',
+		SSL_verifycn_name => 'server.local',
+		SSL_verify_mode => SSL_VERIFY_PEER(),
+		SSL_ca_file => 'certs/test-ca.pem',
+	);
+	# start negotiating a slow TLS connection
+	my $slow = tcp_connect($imaps, Blocking => 0);
+	$slow = IO::Socket::SSL->start_SSL($slow, SSL_startHandshake => 0, %o);
+	my $slow_done = $slow->connect_SSL;
+	my @poll;
+	if ($slow_done) {
+		diag('W: connect_SSL early OK, slow client test invalid');
+		use PublicInbox::Syscall qw(EPOLLIN EPOLLOUT);
+		@poll = (fileno($slow), EPOLLIN | EPOLLOUT);
+	} else {
+		@poll = (fileno($slow), PublicInbox::TLS::epollbit());
+	}
+	# we should call connect_SSL much later...
+	my %imaps_opt = (User => 'a', Password => 'b',
+			Server => $imaps->sockhost,
+			Port => $imaps->sockport);
+	# IMAPS
+	my $c = Mail::IMAPClient->new(%imaps_opt, Ssl => [ %o ]);
+	ok($c && $c->IsAuthenticated, 'authenticated');
+	ok($c->select($group), 'SELECT works');
+	ok(!(scalar $c->has_capability('STARTTLS')),
+		'starttls not advertised with IMAPS');
+	ok(!$c->starttls, "starttls fails");
+	ok($c->has_capability('COMPRESS'), 'compress advertised');
+	ok($c->compress, 'compression enabled with IMAPS');
+	ok(!$c->starttls, 'starttls still fails');
+	ok($c->noop, 'noop succeeds');
+	$compress_logout->($c);
+
+	# STARTTLS
+	my %imap_opt = (Server => $starttls->sockhost,
+			Port => $starttls->sockport);
+	$c = Mail::IMAPClient->new(%imap_opt);
+	ok(scalar $c->has_capability('STARTTLS'),
+		'starttls advertised');
+	ok($c->Starttls([ %o ]), 'set starttls options');
+	ok($c->starttls, '->starttls works');
+	ok(!(scalar($c->has_capability('STARTTLS'))),
+		'starttls not advertised');
+	ok(!$c->starttls, '->starttls again fails');
+	ok(!(scalar($c->has_capability('STARTTLS'))),
+		'starttls still not advertised');
+	ok($c->examine($group), 'EXAMINE works');
+	ok($c->noop, 'NOOP works');
+	ok($c->compress, 'compression enabled with IMAPS');
+	ok($c->noop, 'NOOP works after compress');
+	$compress_logout->($c);
+
+	# STARTTLS with bad hostname
+	$o{SSL_hostname} = $o{SSL_verifycn_name} = 'server.invalid';
+	$c = Mail::IMAPClient->new(%imap_opt);
+	ok(scalar $c->has_capability('STARTTLS'), 'starttls advertised');
+	ok($c->Starttls([ %o ]), 'set starttls options');
+	ok(!$c->starttls, '->starttls fails with bad hostname');
+
+	$c = Mail::IMAPClient->new(%imap_opt);
+	ok($c->noop, 'NOOP still works from plain IMAP');
+
+	# IMAPS with bad hostname
+	$c = Mail::IMAPClient->new(%imaps_opt, Ssl => [ %o ]);
+	is($c, undef, 'IMAPS fails with bad hostname');
+
+	# make hostname valid
+	$o{SSL_hostname} = $o{SSL_verifycn_name} = 'server.local';
+	$c = Mail::IMAPClient->new(%imaps_opt, Ssl => [ %o ]);
+	ok($c, 'IMAPS succeeds again with valid hostname');
+
+	# slow TLS connection did not block the other fast clients while
+	# connecting, finish it off:
+	until ($slow_done) {
+		IO::Poll::_poll(-1, @poll);
+		$slow_done = $slow->connect_SSL and last;
+		@poll = (fileno($slow), PublicInbox::TLS::epollbit());
+	}
+	$slow->blocking(1);
+	ok(sysread($slow, my $greet, 4096) > 0, 'slow got a greeting');
+	like($greet, qr/\A\* OK \[CAPABILITY IMAP4rev1 /, 'got greeting');
+	is(syswrite($slow, "1 LOGOUT\r\n"), 10, 'slow wrote LOGOUT');
+	ok(sysread($slow, my $end, 4096) > 0, 'got end');
+	is(sysread($slow, my $eof, 4096), 0, 'got EOF');
+
+	SKIP: {
+		skip 'TCP_DEFER_ACCEPT is Linux-only', 2 if $^O ne 'linux';
+		my $var = eval { Socket::TCP_DEFER_ACCEPT() } // 9;
+		defined(my $x = getsockopt($imaps, IPPROTO_TCP, $var)) or die;
+		ok(unpack('i', $x) > 0, 'TCP_DEFER_ACCEPT set on IMAPS');
+		defined($x = getsockopt($starttls, IPPROTO_TCP, $var)) or die;
+		is(unpack('i', $x), 0, 'TCP_DEFER_ACCEPT is 0 on plain IMAP');
+	};
+	SKIP: {
+		skip 'SO_ACCEPTFILTER is FreeBSD-only', 2 if $^O ne 'freebsd';
+		if (system('kldstat -m accf_data >/dev/null')) {
+			skip 'accf_data not loaded? kldload accf_data', 2;
+		}
+		require PublicInbox::Daemon;
+		my $var = PublicInbox::Daemon::SO_ACCEPTFILTER();
+		my $x = getsockopt($imaps, SOL_SOCKET, $var);
+		like($x, qr/\Adataready\0+\z/, 'got dataready accf for IMAPS');
+		$x = getsockopt($starttls, IPPROTO_TCP, $var);
+		is($x, undef, 'no BSD accept filter for plain IMAP');
+	};
+
+	$c = undef;
+	$td->kill;
+	$td->join;
+	is($?, 0, 'no error in exited process');
+	open my $fh, '<', $err or BAIL_OUT "open $err failed: $!";
+	my $eout = do { local $/; <$fh> };
+	unlike($eout, qr/wide/i, 'no Wide character warnings');
+}
+
+done_testing;
diff --git a/t/imapd.t b/t/imapd.t
new file mode 100644
index 00000000000..f28a663bf9d
--- /dev/null
+++ b/t/imapd.t
@@ -0,0 +1,149 @@
+#!perl -w
+# Copyright (C) 2020 all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+use strict;
+use Test::More;
+use PublicInbox::TestCommon;
+require_mods(qw(DBD::SQLite Mail::IMAPClient));
+my $level = '-Lbasic';
+SKIP: {
+	require_mods('Search::Xapian', 1);
+	$level = '-Lmedium';
+};
+
+my @V = (1);
+#push(@V, 2) if require_git('2.6', 1);
+
+my ($tmpdir, $for_destroy) = tmpdir();
+my $home = "$tmpdir/home";
+local $ENV{HOME} = $home;
+
+for my $V (@V) {
+	my $addr = "i$V\@example.com";
+	my $name = "i$V";
+	my $url = "http://example.com/i$V";
+	my $inboxdir = "$tmpdir/$name";
+	my $folder = "inbox.i$V";
+	my $cmd = ['-init', "-V$V", $level, $name, $inboxdir, $url, $addr];
+	run_script($cmd) or BAIL_OUT("init $name");
+	xsys(qw(git config), "--file=$ENV{HOME}/.public-inbox/config",
+			"publicinbox.$name.newsgroup", $folder) == 0 or
+			BAIL_OUT("setting newsgroup $V");
+	if ($V == 1) {
+		xsys(qw(git config), "--file=$ENV{HOME}/.public-inbox/config",
+			'publicinboxmda.spamcheck', 'none') == 0 or
+			BAIL_OUT("config: $?");
+	}
+	open(my $fh, '<', 't/utf8.eml') or BAIL_OUT("open t/utf8.eml: $!");
+	my $env = { ORIGINAL_RECIPIENT => $addr };
+	run_script(['-mda', '--no-precheck'], $env, { 0 => $fh }) or
+		BAIL_OUT('-mda delivery');
+	if ($V == 1) {
+		run_script(['-index', $inboxdir]) or BAIL_OUT("index $?");
+	}
+}
+my $sock = tcp_server();
+my $err = "$tmpdir/stderr.log";
+my $out = "$tmpdir/stdout.log";
+my $cmd = [ '-imapd', '-W0', "--stdout=$out", "--stderr=$err" ];
+my $td = start_script($cmd, undef, { 3 => $sock }) or BAIL_OUT("-imapd: $?");
+my %mic_opt = (
+	Server => $sock->sockhost,
+	Port => $sock->sockport,
+	Uid => 1,
+);
+my $mic = Mail::IMAPClient->new(%mic_opt);
+my $pre_login_capa = $mic->capability;
+is(grep(/\AAUTH=ANONYMOUS\z/, @$pre_login_capa), 1,
+	'AUTH=ANONYMOUS advertised pre-login');
+
+$mic->User('lorelei');
+$mic->Password('Hunter2');
+ok($mic->login && $mic->IsAuthenticated, 'LOGIN works');
+my $post_login_capa = $mic->capability;
+ok(join("\n", @$pre_login_capa) ne join("\n", @$post_login_capa),
+	'got different capabilities post-login');
+
+$mic_opt{Authmechanism} = 'ANONYMOUS';
+$mic_opt{Authcallback} = sub { '' };
+$mic = Mail::IMAPClient->new(%mic_opt);
+ok($mic && $mic->login && $mic->IsAuthenticated, 'AUTHENTICATE ANONYMOUS');
+my $post_auth_anon_capa = $mic->capability;
+is_deeply($post_auth_anon_capa, $post_login_capa,
+	'auth anon has same capabilities');
+my $e;
+ok(!$mic->examine('foo') && ($e = $@), 'EXAMINE non-existent');
+like($e, qr/\bNO\b/, 'got a NO on EXAMINE for non-existent');
+ok(!$mic->select('foo') && ($e = $@), 'EXAMINE non-existent');
+like($e, qr/\bNO\b/, 'got a NO on EXAMINE for non-existent');
+ok($mic->select('inbox.i1'), 'SELECT succeeds');
+ok($mic->examine('inbox.i1'), 'EXAMINE succeeds');
+
+my $ret = $mic->search('all') or BAIL_OUT "SEARCH FAIL $@";
+is_deeply($ret, [ 1 ], 'search all works');
+$ret = $mic->search('uid 1') or BAIL_OUT "SEARCH FAIL $@";
+is_deeply($ret, [ 1 ], 'search UID 1 works');
+$ret = $mic->search('uid 1:1') or BAIL_OUT "SEARCH FAIL $@";
+is_deeply($ret, [ 1 ], 'search UID 1:1 works');
+$ret = $mic->search('uid 1:*') or BAIL_OUT "SEARCH FAIL $@";
+is_deeply($ret, [ 1 ], 'search UID 1:* works');
+
+is_deeply(scalar $mic->flags('1'), [], '->flags works');
+
+for my $r ('1:*', '1') {
+	$ret = $mic->fetch_hash($r, 'RFC822') or BAIL_OUT "FETCH $@";
+	is_deeply([keys %$ret], [1]);
+	like($ret->{1}->{RFC822}, qr/\r\n\r\nThis is a test/, 'read full');
+
+	# ensure Mail::IMAPClient behaves
+	my $str = $mic->message_string($r) or BAIL_OUT "->message_string: $@";
+	is($str, $ret->{1}->{RFC822}, '->message_string works as expected');
+
+	my $sz = $mic->fetch_hash($r, 'RFC822.size') or BAIL_OUT "FETCH $@";
+	is($sz->{1}->{'RFC822.SIZE'}, length($ret->{1}->{RFC822}),
+		'RFC822.SIZE');
+
+	$ret = $mic->fetch_hash($r, 'RFC822.HEADER') or BAIL_OUT "FETCH $@";
+	is_deeply([keys %$ret], [1]);
+	like($ret->{1}->{'RFC822.HEADER'},
+		qr/^Message-ID: <testmessage\@example\.com>/ms, 'read header');
+
+	$ret = $mic->fetch_hash($r, 'INTERNALDATE') or BAIL_OUT "FETCH $@";
+	is($ret->{1}->{'INTERNALDATE'}, '01-Jan-1970 00:00:00 +0000',
+		'internaldate matches');
+	ok(!$mic->fetch_hash($r, 'INFERNALDATE'), 'bogus attribute fails');
+
+	my $envelope = $mic->get_envelope($r) or BAIL_OUT("get_envelope: $@");
+	is($envelope->{bcc}, 'NIL', 'empty bcc');
+	is($envelope->{messageid}, '<testmessage@example.com>', 'messageid');
+	is(scalar @{$envelope->{to}}, 1, 'one {to} header');
+	# *sigh* too much to verify...
+	#use Data::Dumper; diag Dumper($envelope);
+
+	$ret = $mic->fetch_hash($r, 'FLAGS') or BAIL_OUT "FETCH $@";
+	is_deeply($ret->{1}->{FLAGS}, '', 'no flags');
+}
+
+# Mail::IMAPClient ->compress creates cyclic reference:
+# https://rt.cpan.org/Ticket/Display.html?id=132654
+my $compress_logout = sub {
+	my ($c) = @_;
+	ok($c->logout, 'logout ok after ->compress');
+	# all documented in Mail::IMAPClient manpage:
+	for (qw(Readmoremethod Readmethod Prewritemethod)) {
+		$c->$_(undef);
+	}
+};
+
+is_deeply([$mic->has_capability('COMPRESS')], ['DEFLATE'], 'deflate cap');
+ok($mic->compress, 'compress enabled');
+$compress_logout->($mic);
+
+$td->kill;
+$td->join;
+is($?, 0, 'no error in exited process');
+open my $fh, '<', $err or BAIL_OUT("open $err failed: $!");
+my $eout = do { local $/; <$fh> };
+unlike($eout, qr/wide/i, 'no Wide character warnings');
+
+done_testing;

  parent reply	other threads:[~2020-06-10  7:05 UTC|newest]

Thread overview: 84+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2020-06-10  7:03 [PATCH 00/82] public-inbox-imapd: read-only IMAP server Eric Wong
2020-06-10  7:03 ` [PATCH 01/82] doc: add some IMAP standards Eric Wong
2020-06-10  7:03 ` [PATCH 02/82] nntpd: restrict allowed newsgroup names Eric Wong
2020-06-10  7:04 ` Eric Wong [this message]
2020-06-10  7:04 ` [PATCH 04/82] inboxidle: new class to detect inbox changes Eric Wong
2020-06-10  7:04 ` [PATCH 05/82] imap: support IDLE Eric Wong
2020-06-10  7:04 ` [PATCH 06/82] msgmap: split ->max into its own method Eric Wong
2020-06-10  7:04 ` [PATCH 07/82] imap: delay InboxIdle start, support refresh Eric Wong
2020-06-10  7:04 ` [PATCH 08/82] imap: implement STATUS command Eric Wong
2020-06-10  7:04 ` [PATCH 09/82] imap: use Text::ParseWords::parse_line to handle quoted words Eric Wong
2020-06-10  7:04 ` [PATCH 10/82] imap: support LIST command Eric Wong
2020-06-10  7:04 ` [PATCH 11/82] t/imapd: support FakeInotify and KQNotify Eric Wong
2020-06-10  7:04 ` [PATCH 12/82] imap: support fetch for BODYSTRUCTURE and BODY Eric Wong
2020-06-10  7:04 ` [PATCH 13/82] eml: each_part: single part $idx is 1 Eric Wong
2020-06-10  7:04 ` [PATCH 14/82] imap: allow fetch of partial of BODY[...] and headers Eric Wong
2020-06-10  7:04 ` [PATCH 15/82] imap: always include `resp-text' in responses Eric Wong
2020-06-10  7:04 ` [PATCH 16/82] imap: split out unit tests and benchmarks Eric Wong
2020-06-10  7:04 ` [PATCH 17/82] imap: fix multi-message partial header fetches Eric Wong
2020-06-10  7:04 ` [PATCH 18/82] imap: simplify partial fetch structure Eric Wong
2020-06-10  7:04 ` [PATCH 19/82] imap: support sequence number FETCH Eric Wong
2020-06-10  7:04 ` [PATCH 20/82] imap: do not include ".PEEK" in responses Eric Wong
2020-06-10  7:04 ` [PATCH 21/82] imap: support the CLOSE command Eric Wong
2020-06-10  7:04 ` [PATCH 22/82] imap: speed up HEADER.FIELDS[.NOT] range fetches Eric Wong
2020-06-10  7:04 ` [PATCH 23/82] git: async: flatten the inflight array Eric Wong
2020-06-10  7:04 ` [PATCH 24/82] git: do our own read buffering for cat-file Eric Wong
2020-06-10  7:04 ` [PATCH 25/82] imap: use git-cat-file asynchronously Eric Wong
2020-06-10  7:04 ` [PATCH 26/82] git: idle rbuf for async Eric Wong
2020-06-10  7:04 ` [PATCH 27/82] imap: support LSUB command Eric Wong
2020-06-10  7:04 ` [PATCH 28/82] imap: FETCH: support comma-delimited ranges Eric Wong
2020-06-10  7:04 ` [PATCH 29/82] add imapd compression test Eric Wong
2020-06-10  7:04 ` [PATCH 30/82] testcommon: tcp_(server|connect): BAIL_OUT on failure Eric Wong
2020-06-10  7:04 ` [PATCH 31/82] *deflate: drop invalid comment about rbuf Eric Wong
2020-06-10  7:04 ` [PATCH 32/82] imap: fix pipelining with async git Eric Wong
2020-06-10  7:04 ` [PATCH 33/82] git: cat_async: provide requested OID + "missing" on missing blobs Eric Wong
2020-06-10  7:04 ` [PATCH 34/82] git: move async_cat reference to PublicInbox::Git Eric Wong
2020-06-10  7:04 ` [PATCH 35/82] git: async: automatic retry on alternates change Eric Wong
2020-06-10  7:04 ` [PATCH 36/82] imapclient: wrapper for Mail::IMAPClient Eric Wong
2020-06-10  7:04 ` [PATCH 37/82] xt: add imapd-validate and imapd-mbsync-oimap Eric Wong
2020-06-10  7:04 ` [PATCH 38/82] imap: support out-of-bounds ranges Eric Wong
2020-06-10  7:04 ` [PATCH 39/82] xt/perf-imap-list: time refresh_inboxlist Eric Wong
2020-06-10  7:04 ` [PATCH 40/82] imap: case-insensitive mailbox name comparisons Eric Wong
2020-06-10  7:04 ` [PATCH 41/82] imap: break giant inboxes into sub-inboxes of 50K messages Eric Wong
2020-06-10  7:04 ` [PATCH 42/82] imap: start doing iterative config reloading Eric Wong
2020-06-10  7:04 ` [PATCH 43/82] imap: require ".$UID_MIN-$UID_END" suffix Eric Wong
2020-06-10  7:04 ` [PATCH 44/82] imapd: ensure LIST is sorted alphabetically, for now Eric Wong
2020-06-10  7:04 ` [PATCH 45/82] imap: omit $UID_END from mailbox name, use index Eric Wong
2020-06-10  7:04 ` [PATCH 46/82] t/config.t: always compare against git bool behavior Eric Wong
2020-06-10  7:04 ` [PATCH 47/82] xt/*: show some tunable parameters Eric Wong
2020-06-10  7:04 ` [PATCH 48/82] imap: STATUS and LIST are case-insensitive, too Eric Wong
2020-06-10  7:04 ` [PATCH 49/82] imap: EXAMINE/STATUS: return correct counts Eric Wong
2020-06-10  7:04 ` [PATCH 50/82] imap: avoid uninitialized warnings on incomplete commands Eric Wong
2020-06-10  7:04 ` [PATCH 51/82] imap: start parsing out queries for SQLite and Xapian Eric Wong
2020-06-10  7:04 ` [PATCH 52/82] imap: SEARCH: clamp results to the 50K UID range Eric Wong
2020-06-10  7:04 ` [PATCH 53/82] imap: allow UID range search on timestamps Eric Wong
2020-06-10  7:04 ` [PATCH 54/82] over: get_art: use dbh->prepare_cached Eric Wong
2020-06-10  7:04 ` [PATCH 55/82] search: index byte size of a message for IMAP search Eric Wong
2020-06-10  7:04 ` [PATCH 56/82] search: index UID for IMAP search, too Eric Wong
2020-06-10  7:04 ` [PATCH 57/82] imap: remove dummies from sequence number FETCH Eric Wong
2020-06-10  7:04 ` [PATCH 58/82] imap: compile UID FETCH to opcodes Eric Wong
2020-06-10  7:04 ` [PATCH 59/82] imap: UID FETCH: optimize for smsg-only case Eric Wong
2020-06-10  7:04 ` [PATCH 60/82] imap: UID FETCH: optimize (UID FLAGS) harder Eric Wong
2020-06-10  7:04 ` [PATCH 61/82] imap: IDLE: avoid extraneous wakeups, keep-alive Eric Wong
2020-06-10  7:04 ` [PATCH 62/82] imap: 30 minute auto-logout timer Eric Wong
2020-06-10  7:05 ` [PATCH 63/82] imap: split ->logged_in attribute into a separate class Eric Wong
2020-06-10  7:05 ` [PATCH 64/82] searchidx: v1 (re)-index uses git asynchronously Eric Wong
2020-06-10  7:05 ` [PATCH 65/82] index: account for CRLF conversion when storing bytes Eric Wong
2020-06-10  7:05 ` [PATCH 66/82] imap: rely on smsg->{bytes} for RFC822.SIZE Eric Wong
2020-06-10  7:05 ` [PATCH 67/82] imap: UID FETCH requires at least one data item Eric Wong
2020-06-10  7:05 ` [PATCH 68/82] imap: LIST shows "INBOX" in all caps Eric Wong
2020-06-10  7:05 ` [PATCH 69/82] imap: support 8000 octet lines Eric Wong
2020-06-10  7:05 ` [PATCH 70/82] imap: reinstate some message sequence number support Eric Wong
2020-06-10  7:05 ` [PATCH 71/82] imap: cleanup ->{uid_base} usage Eric Wong
2020-06-10  7:05 ` [PATCH 72/82] imap: FETCH: more granular CRLF conversion Eric Wong
2020-06-10  7:05 ` [PATCH 73/82] imap: further speed up HEADER.FIELDS FETCH requests Eric Wong
2020-06-10  7:05 ` [PATCH 74/82] imap: FETCH: try to make fake MSNs sequentially Eric Wong
2020-06-10  7:05 ` [PATCH 75/82] imap: STATUS/EXAMINE: rely on SQLite overview Eric Wong
2020-06-10  7:05 ` [PATCH 76/82] imap: UID SEARCH: support multiple ranges Eric Wong
2020-06-10  7:05 ` [PATCH 77/82] imap: wire up Xapian, MSN SEARCH and multi sequence-sets Eric Wong
2020-06-10  7:05 ` [PATCH 78/82] imap: misc cleanups and notes Eric Wong
2020-06-10  7:05 ` [PATCH 79/82] imapd: don't bother sorting LIST output Eric Wong
2020-06-10  7:05 ` [PATCH 80/82] imap: remove non-UID SEARCH for now Eric Wong
2020-06-10  7:05 ` [PATCH 81/82] over: uid_range: remove LIMIT Eric Wong
2020-06-10  7:05 ` [PATCH 82/82] imap: FETCH: proper MSN => UID mapping for requests Eric Wong
2020-06-12 23:49 ` [PATCH 83/82] imap: introduce memory-efficient uo2m mapping Eric Wong

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://public-inbox.org/README

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20200610070519.18252-4-e@yhbt.net \
    --to=e@yhbt.net \
    --cc=meta@public-inbox.org \
    --subject='Re: [PATCH 03/82] preliminary imap server implementation' \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link

Code repositories for project(s) associated with this inbox:

	https://80x24.org/public-inbox.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).