* [PATCH 0/2] preliminary POP3 daemon
@ 2022-07-19 2:49 Eric Wong
2022-07-19 2:49 ` [PATCH 1/2] public-inbox-pop3d - a mostly read-only POP3 server Eric Wong
` (3 more replies)
0 siblings, 4 replies; 10+ messages in thread
From: Eric Wong @ 2022-07-19 2:49 UTC (permalink / raw)
To: meta
Only tested with mpop and getmail as far as real-world clients
go. mpop is pretty strict and fast, too; getmail was ignoring
sequence number bugs :x
...And now I think I know where IMAP inherited horrible message
sequence number idea from :P
The on-disk storage aspect still has me a little nervous :x
over.sqlite3 is totally overkill (and thus slower than optimal)
for this, but I don't think it's worth a schema version change,
either.
Lot more code cleanups and maybe some optimizations on the way.
Eric Wong (2):
public-inbox-pop3d - a mostly read-only POP3 server
pop3: implement IN-USE from RESP-CODES (RFC 2449)
Documentation/public-inbox-config.pod | 12 +-
Documentation/public-inbox-pop3d.pod | 122 +++++++
Documentation/standards.perl | 12 +-
MANIFEST | 5 +
lib/PublicInbox/Config.pm | 5 +-
lib/PublicInbox/Daemon.pm | 8 +-
lib/PublicInbox/Inbox.pm | 10 +-
lib/PublicInbox/POP3.pm | 444 ++++++++++++++++++++++++++
lib/PublicInbox/POP3D.pm | 231 ++++++++++++++
script/public-inbox-pop3d | 8 +
t/pop3d.t | 254 +++++++++++++++
11 files changed, 1094 insertions(+), 17 deletions(-)
create mode 100644 Documentation/public-inbox-pop3d.pod
create mode 100644 lib/PublicInbox/POP3.pm
create mode 100644 lib/PublicInbox/POP3D.pm
create mode 100755 script/public-inbox-pop3d
create mode 100644 t/pop3d.t
^ permalink raw reply [flat|nested] 10+ messages in thread
* [PATCH 1/2] public-inbox-pop3d - a mostly read-only POP3 server
2022-07-19 2:49 [PATCH 0/2] preliminary POP3 daemon Eric Wong
@ 2022-07-19 2:49 ` Eric Wong
2022-07-19 2:49 ` [PATCH 2/2] pop3: implement IN-USE from RESP-CODES (RFC 2449) Eric Wong
` (2 subsequent siblings)
3 siblings, 0 replies; 10+ messages in thread
From: Eric Wong @ 2022-07-19 2:49 UTC (permalink / raw)
To: meta
Old account expiry has not been implemented, but it seems to
work well with both mpop(1) and getmail(1). The strictness of
mpop was particularly helpful in ironing out bugs in our
implementation of (dreaded) message sequence numbers.
"EXPIRE 0" (RFC 2449) can theoretically save numerous "DELE"
commands, but that's untested by real-world clients. mpop
supports PIPELINING which is effective in hiding latency,
and the core networking functionality is already well-tested
from our NNTP and IMAP implementations.
Configuration requires "publicinbox.pop3state" to point to
a directory writable by the otherwise read-only daemon.
See public-inbox-pop3d(1) manpage for more usage details.
---
Documentation/public-inbox-config.pod | 12 +-
Documentation/public-inbox-pop3d.pod | 122 +++++++
Documentation/standards.perl | 12 +-
MANIFEST | 5 +
lib/PublicInbox/Config.pm | 5 +-
lib/PublicInbox/Daemon.pm | 8 +-
lib/PublicInbox/Inbox.pm | 10 +-
lib/PublicInbox/POP3.pm | 443 ++++++++++++++++++++++++++
lib/PublicInbox/POP3D.pm | 231 ++++++++++++++
script/public-inbox-pop3d | 8 +
t/pop3d.t | 254 +++++++++++++++
11 files changed, 1093 insertions(+), 17 deletions(-)
create mode 100644 Documentation/public-inbox-pop3d.pod
create mode 100644 lib/PublicInbox/POP3.pm
create mode 100644 lib/PublicInbox/POP3D.pm
create mode 100755 script/public-inbox-pop3d
create mode 100644 t/pop3d.t
diff --git a/Documentation/public-inbox-config.pod b/Documentation/public-inbox-config.pod
index 43e54ed4..ed99b188 100644
--- a/Documentation/public-inbox-config.pod
+++ b/Documentation/public-inbox-config.pod
@@ -67,10 +67,12 @@ may be any newsgroup name with hierarchies delimited by C<.>.
For example, the newsgroup for L<mailto:meta@public-inbox.org>
is: C<inbox.comp.mail.public-inbox.meta>
-It also configures the folder hierarchy used by L<public-inbox-imapd(1)>.
+It also configures the folder hierarchy used by L<public-inbox-imapd(1)>
+as well as L<public-inbox-pop3d(1)>
Omitting this for a given inbox will prevent the inbox from
-being served by L<public-inbox-nntpd(1)> and/or L<public-inbox-imapd(1)>.
+being served by L<public-inbox-nntpd(1)>,
+L<public-inbox-imapd(1)>, and/or L<public-inbox-pop3d(1)>
Default: none, optional
@@ -226,6 +228,10 @@ L<public-inbox-nntpd(1)> instance.
Default: none
+=item publicinbox.pop3state
+
+See L<public-inbox-pop3d(1)/publicinbox.pop3state>
+
=item publicinbox.<name>.feedmax
The size of an Atom feed for the inbox. If specified more than
@@ -463,7 +469,7 @@ L<http://4uok3hntl7oi7b4uf4rtfwefqeexfzil2w6kgk2jn5z2f764irre7byd.onion/meta/>
=head1 COPYRIGHT
-Copyright 2016-2021 all contributors L<mailto:meta@public-inbox.org>
+Copyright all contributors L<mailto:meta@public-inbox.org>
License: AGPL-3.0+ L<https://www.gnu.org/licenses/agpl-3.0.txt>
diff --git a/Documentation/public-inbox-pop3d.pod b/Documentation/public-inbox-pop3d.pod
new file mode 100644
index 00000000..0404c2a7
--- /dev/null
+++ b/Documentation/public-inbox-pop3d.pod
@@ -0,0 +1,122 @@
+=head1 NAME
+
+public-inbox-pop3d - POP3 server for sharing public-inboxes
+
+=head1 SYNOPSIS
+
+ public-inbox-pop3d [OPTIONS]
+
+=head1 DESCRIPTION
+
+public-inbox-pop3d provides a POP3 daemon for public-inbox.
+It uses options and environment variables common to all
+read-only L<public-inbox-daemon(8)> implementations,
+but requires additional read-write storage to keep track
+of deleted messages on a per-user basis.
+
+Like L<public-inbox-imapd(1)>, C<public-inbox-pop3d> will never
+require write access to the directory where the public-inboxes
+are stored.
+
+It is designed for anonymous access, thus the password is
+always C<anonymous> (all lower-case).
+
+Usernames are of the format:
+
+ C<$UUID@$NEWSGROUP_NAME>
+
+Where C<$UUID> is the output of the L<uuidgen(1)> command. Dash
+(C<->) characters in UUIDs are ignored, and C<[A-F]> hex
+characters are case-insensitive. Users should keep their UUIDs
+private to prevent others from deleting unretrieved messages.
+Users may switch to a new UUID at any time to retrieve
+previously-retrieved messages.
+
+Historical slices of 50K messages are available
+by suffixing the integer L<$SLICE>, where C<0> is the oldest.
+
+ C<$UUID@$NEWSGROUP_NAME.$SLICE>
+
+It may be run as a different user than the user running
+L<public-inbox-watch(1)>, L<public-inbox-mda(1)>, or
+L<public-inbox-fetch(1)>.
+
+To save storage, L</publicinbox.pop3state> only stores
+the highest-numbered deleted message
+
+=head1 OPTIONS
+
+See common options in L<public-inbox-daemon(8)/OPTIONS>.
+
+=over
+
+=item -l PROTO://ADDRESS/?cert=/path/to/cert,key=/path/to/key
+
+=item --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<pop3://> or
+C<pop3s://>) may be specified to force a given protocol.
+
+For STARTTLS and POP3S 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 POP3S support
+if the C<cert> option is not given with C<--listen>.
+
+If using systemd-compatible socket activation and a TCP listener on port
+995 is inherited, it is automatically POP3S when this option is given.
+When a listener on port 110 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 POP3S
+support if the C<key> option is not given with C<--listen>. The private
+key may be concatenated into the path used by C<--cert>, in which case this
+option is not needed.
+
+=back
+
+=head1 CONFIGURATION
+
+Aside from C<publicinbox.pop3state>, C<public-inbox-pop3d> 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.pop3state
+
+A directory containing per-user/mailbox account information;
+must be writable to the C<public-inbox-pop3d> process.
+
+=item publicInbox.<name>.newsgroup
+
+The newsgroup name maps to a POP3 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/>, and
+L<nntp://news.public-inbox.org/inbox.comp.mail.public-inbox.meta>,
+L<nntp://4uok3hntl7oi7b4uf4rtfwefqeexfzil2w6kgk2jn5z2f764irre7byd.onion/inbox.comp.mail.public-inbox.meta>
+
+=head1 COPYRIGHT
+
+Copyright 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)>,
+L<uuidgen(1)>
diff --git a/Documentation/standards.perl b/Documentation/standards.perl
index 69568ceb..835de3a2 100755
--- a/Documentation/standards.perl
+++ b/Documentation/standards.perl
@@ -1,6 +1,6 @@
#!/usr/bin/perl -w
-use strict;
-# Copyright 2019-2021 all contributors <meta@public-inbox.org>
+use v5.12;
+# Copyright all contributors <meta@public-inbox.org>
# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
print <<EOF;
@@ -66,8 +66,12 @@ my $rfcs = [
2369 => 'URLs as Meta-Syntax for Core Mail List Commands',
8058 => 'Signaling One-Click Functionality for List Email Headers',
- # TODO: flesh this out
+ 1081 => 'Post Office Protocol – Version 3',
+ 1939 => 'Post Office Protocol – Version 3 (STD 53)',
+ 2449 => 'POP3 extension mechanism',
+ 2384 => 'POP URL Scheme',
+ # TODO: flesh this out
];
my @rfc_urls = qw(tools.ietf.org/html/rfc%d
@@ -102,6 +106,6 @@ Other relevant documentation
Copyright
---------
-Copyright (C) 2019-2020 all contributors <meta@public-inbox.org>
+Copyright (C) all contributors <meta@public-inbox.org>
License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
EOF
diff --git a/MANIFEST b/MANIFEST
index 607a4c5b..2cbe66b7 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -84,6 +84,7 @@ Documentation/public-inbox-mda.pod
Documentation/public-inbox-netd.pod
Documentation/public-inbox-nntpd.pod
Documentation/public-inbox-overview.pod
+Documentation/public-inbox-pop3d.pod
Documentation/public-inbox-purge.pod
Documentation/public-inbox-tuning.pod
Documentation/public-inbox-v1-format.pod
@@ -302,6 +303,8 @@ lib/PublicInbox/NewsWWW.pm
lib/PublicInbox/OnDestroy.pm
lib/PublicInbox/Over.pm
lib/PublicInbox/OverIdx.pm
+lib/PublicInbox/POP3.pm
+lib/PublicInbox/POP3D.pm
lib/PublicInbox/PktOp.pm
lib/PublicInbox/ProcessPipe.pm
lib/PublicInbox/Qspawn.pm
@@ -367,6 +370,7 @@ script/public-inbox-learn
script/public-inbox-mda
script/public-inbox-netd
script/public-inbox-nntpd
+script/public-inbox-pop3d
script/public-inbox-purge
script/public-inbox-watch
script/public-inbox-xcpdb
@@ -519,6 +523,7 @@ t/plack-2-txt-bodies.eml
t/plack-attached-patch.eml
t/plack-qp.eml
t/plack.t
+t/pop3d.t
t/precheck.t
t/psgi_attach.eml
t/psgi_attach.t
diff --git a/lib/PublicInbox/Config.pm b/lib/PublicInbox/Config.pm
index 0f002e5e..a31b5b74 100644
--- a/lib/PublicInbox/Config.pm
+++ b/lib/PublicInbox/Config.pm
@@ -1,4 +1,4 @@
-# Copyright (C) 2014-2021 all contributors <meta@public-inbox.org>
+# Copyright (C) all contributors <meta@public-inbox.org>
# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
#
# Used throughout the project for reading configuration
@@ -434,7 +434,8 @@ sub _fill_ibx {
# more things to encourage decentralization
for my $k (qw(address altid nntpmirror imapmirror
coderepo hide listid url
- infourl watchheader nntpserver imapserver)) {
+ infourl watchheader
+ nntpserver imapserver pop3server)) {
my $v = $self->{"$pfx.$k"} // next;
$ibx->{$k} = _array($v);
}
diff --git a/lib/PublicInbox/Daemon.pm b/lib/PublicInbox/Daemon.pm
index d08ce0f9..8b4c3c70 100644
--- a/lib/PublicInbox/Daemon.pm
+++ b/lib/PublicInbox/Daemon.pm
@@ -32,8 +32,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', 993 => 'imaps' );
-my %KNOWN_STARTTLS = ( 119 => 'nntp', 143 => 'imap' );
+my %KNOWN_TLS = (443 => 'https', 563 => 'nntps', 993 => 'imaps', 995 =>'pop3s');
+my %KNOWN_STARTTLS = (110 => 'pop3', 119 => 'nntp', 143 => 'imap');
sub accept_tls_opt ($) {
my ($opt_str) = @_;
@@ -155,7 +155,7 @@ EOF
$tls_opt{"$scheme://$l"} = accept_tls_opt($1);
} elsif (defined($default_cert)) {
$tls_opt{"$scheme://$l"} = accept_tls_opt('');
- } elsif ($scheme =~ /\A(?:https|imaps|imaps)\z/) {
+ } elsif ($scheme =~ /\A(?:https|imaps|nntps|pop3s)\z/) {
die "$orig specified w/o cert=\n";
}
$scheme =~ /\A(http|imap|nntp|pop3)/ and
@@ -620,7 +620,7 @@ sub daemon_loop ($) {
$l =~ s!\A([^:]+)://!!;
my $scheme = $1 // '';
my $xn = $xnetd->{$l} // $xnetd->{''};
- if ($scheme =~ m!\A(?:https|imaps|nntps)!) {
+ if ($scheme =~ m!\A(?:https|imaps|nntps|pop3s)!) {
$post_accept{$l} = tls_start_cb($v, $xn->{post_accept});
} elsif ($xn->{tlsd}) { # STARTTLS, $k eq '' is OK
$xn->{tlsd}->{accept_tls} = $v;
diff --git a/lib/PublicInbox/Inbox.pm b/lib/PublicInbox/Inbox.pm
index 1579d500..da81fb67 100644
--- a/lib/PublicInbox/Inbox.pm
+++ b/lib/PublicInbox/Inbox.pm
@@ -1,4 +1,4 @@
-# Copyright (C) 2016-2021 all contributors <meta@public-inbox.org>
+# Copyright (C) all contributors <meta@public-inbox.org>
# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
#
# Represents a public-inbox (which may have multiple mailing addresses)
@@ -230,8 +230,9 @@ sub base_url {
$url;
}
+# imapserver, nntpserver, and pop3server configs are used here:
sub _x_url ($$$) {
- my ($self, $x, $ctx) = @_; # $x is "nntp" or "imap"
+ my ($self, $x, $ctx) = @_; # $x is "imap", "nntp", or "pop3"
# no checking for nntp_usable here, we can point entirely
# to non-local servers or users run by a different user
my $ns = $self->{"${x}server"} //
@@ -253,7 +254,7 @@ sub _x_url ($$$) {
if ($group) {
$u .= '/' if $u !~ m!/\z!;
$u .= $group;
- } else { # n.b. IMAP uses "newsgroup"
+ } else { # n.b. IMAP and POP3 use "newsgroup"
warn <<EOM;
publicinbox.$self->{name}.${x}mirror=$_ missing newsgroup name
EOM
@@ -273,8 +274,9 @@ EOM
}
# my ($self, $ctx) = @_;
-sub nntp_url { $_[0]->{-nntp_url} //= _x_url($_[0], 'nntp', $_[1]) }
sub imap_url { $_[0]->{-imap_url} //= _x_url($_[0], 'imap', $_[1]) }
+sub nntp_url { $_[0]->{-nntp_url} //= _x_url($_[0], 'nntp', $_[1]) }
+sub pop3_url { $_[0]->{-pop3_url} //= _x_url($_[0], 'pop3', $_[1]) }
sub nntp_usable {
my ($self) = @_;
diff --git a/lib/PublicInbox/POP3.pm b/lib/PublicInbox/POP3.pm
new file mode 100644
index 00000000..f920571d
--- /dev/null
+++ b/lib/PublicInbox/POP3.pm
@@ -0,0 +1,443 @@
+# Copyright (C) all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+#
+# Each instance of this represents a POP3 client connected to
+# public-inbox-{netd,pop3d}. Much of this was taken from IMAP.pm and NNTP.pm
+#
+# POP3 is one mailbox per-user, so the "USER" command is like the
+# format of -imapd and is mapped to $NEWSGROUP.$SLICE (large inboxes
+# are sliced into 50K mailboxes in both POP3 and IMAP to avoid overloading
+# clients)
+#
+# Unlike IMAP, the "$NEWSGROUP" mailbox (without $SLICE) is a rolling
+# window of the latest messages. We can do this for POP3 since the
+# typical POP3 session is short-lived while long-lived IMAP sessions
+# would cause slices to grow on the server side without bounds.
+#
+# Like IMAP, POP3 also has per-session message sequence numbers (MSN),
+# which require mapping to UIDs. The offset of an entry into our
+# per-client cache is: (MSN-1)
+#
+# fields:
+# - uuid - 16-byte (binary) UUID representation (before successful login)
+# - cache - one-dimentional arrayref of (UID, bytesize, oidhex)
+# - nr_dele - number of deleted messages
+# - expire - string of packed unsigned short offsets
+# - user_id - user-ID mapped to UUID (on successful login + lock)
+# - txn_max_uid - for storing max deleted UID persistently
+# - ibx - PublicInbox::Inbox object
+# - slice - unsigned integer slice number (0..Inf), -1 => latest
+# - salt - pre-auth for APOP
+# - uid_dele - maximum deleted from previous session at login (NNTP ARTICLE)
+# - uid_base - base UID for mailbox slice (0-based) (same as IMAP)
+package PublicInbox::POP3;
+use v5.12;
+use parent qw(PublicInbox::DS);
+use PublicInbox::Syscall qw(EPOLLIN EPOLLONESHOT);
+use PublicInbox::GitAsyncCat;
+use PublicInbox::DS qw(now);
+use Errno qw(EAGAIN);
+use Digest::MD5 qw(md5);
+use PublicInbox::IMAP; # for UID slice stuff
+
+use constant {
+ LINE_MAX => 512, # XXX unsure
+};
+
+# XXX FIXME: duplicated stuff from NNTP.pm and IMAP.pm
+
+sub err ($$;@) {
+ my ($self, $fmt, @args) = @_;
+ printf { $self->{pop3d}->{err} } $fmt."\n", @args;
+}
+
+sub out ($$;@) {
+ my ($self, $fmt, @args) = @_;
+ printf { $self->{pop3d}->{out} } $fmt."\n", @args;
+}
+
+sub zflush {} # noop
+
+sub requeue_once ($) {
+ my ($self) = @_;
+ # 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;
+}
+
+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}:
+ # control passed to ibx_async_cat if $more == \undef
+ requeue_once($self) if !ref($more);
+ } 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 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;
+}
+
+sub _greet ($) {
+ my ($self) = @_;
+ my $s = $self->{salt} = sprintf('%x.%x', int(rand(0x7fffffff)), time);
+ $self->write("+OK POP3 server ready <$s\@public-inbox>\r\n");
+}
+
+sub new ($$$) {
+ my ($class, $sock, $pop3d) = @_;
+ my $self = bless { pop3d => $pop3d }, __PACKAGE__;
+ my $ev = EPOLLIN;
+ my $wbuf;
+ if ($sock->can('accept_SSL') && !$sock->accept_SSL) {
+ return CORE::close($sock) if $! != EAGAIN;
+ $ev = PublicInbox::TLS::epollbit() or return CORE::close($sock);
+ $wbuf = [ \&PublicInbox::DS::accept_tls_step, \&_greet ];
+ }
+ $self->SUPER::new($sock, $ev | EPOLLONESHOT);
+ if ($wbuf) {
+ $self->{wbuf} = $wbuf;
+ } else {
+ _greet($self);
+ }
+ $self;
+}
+
+# POP user is $UUID1@$NEWSGROUP.$SLICE
+sub cmd_user ($$) {
+ my ($self, $mailbox) = @_;
+ $self->{salt} // return \"-ERR already authed\r\n";
+ $mailbox =~ s/\A([a-f0-9\-]+)\@//i or
+ return \"-ERR no UUID@ in mailbox name\r\n";
+ my $user = $1;
+ $user =~ tr/-//d; # most have dashes, some (dbus-uuidgen) don't
+ $user =~ m!\A[a-f0-9]{32}\z!i or return \"-ERR user has no UUID\r\n";
+ my $slice;
+ $mailbox =~ s/\.([0-9]+)\z// and $slice = $1 + 0;
+ my $ibx = $self->{pop3d}->{pi_cfg}->lookup_newsgroup($mailbox) //
+ return \"-ERR $mailbox does not exist\r\n";
+ my $uidmax = $ibx->mm(1)->num_highwater // 0;
+ if (defined $slice) {
+ my $max = int($uidmax / PublicInbox::IMAP::UID_SLICE);
+ my $tip = "$mailbox.$max";
+ return \"-ERR $mailbox.$slice does not exist ($tip does)\r\n"
+ if $slice > $max;
+ $self->{uid_base} = $slice * PublicInbox::IMAP::UID_SLICE;
+ $self->{slice} = $slice;
+ } else { # latest 50K messages
+ my $base = $uidmax - PublicInbox::IMAP::UID_SLICE;
+ $self->{uid_base} = $base < 0 ? 0 : $base;
+ $self->{slice} = -1;
+ }
+ $self->{ibx} = $ibx;
+ $self->{uuid} = pack('H*', $user); # deleted by _login_ok
+ $slice //= '(latest)';
+ \"+OK $ibx->{newsgroup} slice=$slice selected\r\n";
+}
+
+sub _login_ok ($) {
+ my ($self) = @_;
+ if ($self->{pop3d}->lock_mailbox($self)) {
+ $self->{uid_max} = $self->{ibx}->over(1)->max;
+ \"+OK logged in\r\n";
+ } else {
+ \"-ERR unable to lock maildrop\r\n";
+ }
+}
+
+sub cmd_apop {
+ my ($self, $mailbox, $hex) = @_;
+ my $res = cmd_user($self, $mailbox); # sets {uuid}
+ return $res if substr($$res, 0, 1) eq '-';
+ my $s = delete($self->{salt}) // die 'BUG: salt missing';
+ return _login_ok($self) if md5("<$s\@public-inbox>anonymous") eq
+ pack('H*', $hex);
+ $self->{salt} = $s;
+ \"-ERR APOP password mismatch\r\n";
+}
+
+sub cmd_pass {
+ my ($self, $pass) = @_;
+ $self->{ibx} // return \"-ERR mailbox unspecified\r\n";
+ my $s = delete($self->{salt}) // return \"-ERR already authed\r\n";
+ return _login_ok($self) if $pass eq 'anonymous';
+ $self->{salt} = $s;
+ \"-ERR password is not `anonymous'\r\n";
+}
+
+sub cmd_stls {
+ my ($self) = @_;
+ my $sock = $self->{sock} or return;
+ return \"-ERR TLS already enabled\r\n" if $sock->can('stop_SSL');
+ my $opt = $self->{pop3d}->{accept_tls} or
+ return \"-ERR can't start TLS negotiation\r\n";
+ $self->write(\"+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;
+}
+
+sub need_txn ($) {
+ exists($_[0]->{salt}) ? \"-ERR not in TRANSACTION\r\n" : undef;
+}
+
+sub _stat_cache ($) {
+ my ($self) = @_;
+ my ($beg, $end) = ($self->{uid_dele} // 0, $self->{uid_max});
+ PublicInbox::IMAP::uid_clamp($self, \$beg, \$end);
+ my $opt = { limit => PublicInbox::IMAP::UID_SLICE };
+ my $m = $self->{ibx}->over(1)->do_get(<<'', $opt, $beg, $end);
+SELECT num,ddd FROM over WHERE num >= ? AND num <= ?
+ORDER BY num ASC
+
+ [ map { ($_->{num}, $_->{bytes} + 0, $_->{blob}) } @$m ];
+}
+
+sub cmd_stat {
+ my ($self) = @_;
+ my $err; $err = need_txn($self) and return $err;
+ my $cache = $self->{cache} //= _stat_cache($self);
+ my $tot = 0;
+ for (my $i = 1; $i < scalar(@$cache); $i += 3) { $tot += $cache->[$i] }
+ my $nr = @$cache / 3 - ($self->{nr_dele} // 0);
+ "+OK $nr $tot\r\n";
+}
+
+# for LIST and UIDL
+sub _list {
+ my ($desc, $idx, $self, $msn) = @_;
+ my $err; $err = need_txn($self) and return $err;
+ my $cache = $self->{cache} //= _stat_cache($self);
+ if (defined $msn) {
+ my $base_off = ($msn - 1) * 3;
+ my $val = $cache->[$base_off + $idx] //
+ return \"-ERR no such message\r\n";
+ "+OK $desc listing follows\r\n$msn $val\r\n.\r\n";
+ } else { # always +OK, even if no messages
+ my $res = "+OK $desc listing follows\r\n";
+ my $msn = 0;
+ for (my $i = 0; $i < scalar(@$cache); $i += 3) {
+ ++$msn;
+ defined($cache->[$i]) and
+ $res .= "$msn $cache->[$i + $idx]\r\n";
+ }
+ $res .= ".\r\n";
+ }
+}
+
+sub cmd_list { _list('scan', 1, @_) }
+sub cmd_uidl { _list('unique-id', 2, @_) }
+
+sub mark_dele ($$) {
+ my ($self, $off) = @_;
+ my $base_off = $off * 3;
+ my $cache = $self->{cache};
+ my $uid = $cache->[$base_off] // return; # already deleted
+
+ my $old = $self->{txn_max_uid} //= $uid;
+ $self->{txn_max_uid} = $uid if $uid > $old;
+
+ $cache->[$base_off] = undef; # clobber UID
+ $cache->[$base_off + 1] = 0; # zero bytes (simplifies cmd_stat)
+ $cache->[$base_off + 2] = undef; # clobber oidhex
+ ++$self->{nr_dele};
+}
+
+sub retr_cb { # called by git->cat_async via ibx_async_cat
+ my ($bref, $oid, $type, $size, $args) = @_;
+ my ($self, $off, $top_nr) = @$args;
+ my $hex = $self->{cache}->[$off * 3 + 2] //
+ die "BUG: no hex (oid=$oid)";
+ if (!defined($oid)) {
+ # it's possible to have TOCTOU if an admin runs
+ # public-inbox-(edit|purge), just move onto the next message
+ warn "E: $hex missing in $self->{ibx}->{inboxdir}\n";
+ $self->write(\"-ERR no such message\r\n");
+ return $self->requeue;
+ } elsif ($hex ne $oid) {
+ $self->close;
+ die "BUG: $hex != $oid";
+ }
+ PublicInbox::IMAP::to_crlf_full($bref);
+ if (defined $top_nr) {
+ my ($hdr, $bdy) = split(/\r\n\r\n/, $$bref, 2);
+ $bref = \$hdr;
+ $hdr .= "\r\n\r\n";
+ my @tmp = split(/^/m, $bdy);
+ $hdr .= join('', splice(@tmp, 0, $top_nr));
+ }
+ $$bref =~ s/^\./../gms;
+ $$bref .= substr($$bref, -2, 2) eq "\r\n" ? ".\r\n" : "\r\n.\r\n";
+ $self->msg_more("+OK message follows\r\n");
+ $self->write($bref);
+ $self->{expire} .= pack('S', $off) if exists $self->{expire};
+ $self->requeue;
+}
+
+sub cmd_retr {
+ my ($self, $msn, $top_nr) = @_;
+ return \"-ERR lines must be a non-negative number\r\n" if
+ (defined($top_nr) && $top_nr !~ /\A[0-9]+\z/);
+ my $err; $err = need_txn($self) and return $err;
+ my $cache = $self->{cache} //= _stat_cache($self);
+ my $off = $msn - 1;
+ my $hex = $cache->[$off * 3 + 2] // return \"-ERR no such message\r\n";
+ ${ibx_async_cat($self->{ibx}, $hex, \&retr_cb,
+ [ $self, $off, $top_nr ])};
+}
+
+sub cmd_noop { $_[0]->write(\"+OK\r\n") }
+
+sub cmd_rset {
+ my ($self) = @_;
+ my $err; $err = need_txn($self) and return $err;
+ delete $self->{cache};
+ delete $self->{txn_max_uid};
+ \"+OK\r\n";
+}
+
+sub cmd_dele {
+ my ($self, $msn) = @_;
+ my $err; $err = need_txn($self) and return $err;
+ $self->{cache} //= _stat_cache($self);
+ $msn =~ /\A[1-9][0-9]*\z/ or return \"-ERR no such message\r\n";
+ mark_dele($self, $msn - 1) ? \"+OK\r\n" : \"-ERR no such message\r\n";
+}
+
+# RFC 2449
+sub cmd_capa {
+ my ($self) = @_;
+ $self->{expire} = ''; # "EXPIRE 0" allows clients to avoid DELE commands
+ \<<EOM;
++OK Capability list follows\r
+TOP\r
+USER\r
+PIPELINING\r
+UIDL\r
+EXPIRE 0\r
+.\r
+EOM
+}
+
+sub close {
+ my ($self) = @_;
+ $self->{pop3d}->unlock_mailbox($self);
+ $self->SUPER::close;
+}
+
+sub cmd_quit {
+ my ($self) = @_;
+ if (defined(my $txn_id = $self->{txn_id})) {
+ my $user_id = $self->{user_id} // die 'BUG: no {user_id}';
+ if (my $exp = delete $self->{expire}) {
+ mark_dele($self, $_) for unpack('S*', $exp);
+ }
+ my $dbh = $self->{pop3d}->{-state_dbh};
+ my $lk = $self->{pop3d}->lock_for_scope;
+ my $sth;
+ $dbh->begin_work;
+
+ if (defined $self->{txn_max_uid}) {
+ $sth = $dbh->prepare_cached(<<'');
+UPDATE deletes SET uid_dele = ? WHERE txn_id = ? AND uid_dele < ?
+
+ $sth->execute($self->{txn_max_uid}, $txn_id,
+ $self->{txn_max_uid});
+ }
+ $sth = $dbh->prepare_cached(<<'');
+UPDATE users SET last_seen = ? WHERE user_id = ?
+
+ $sth->execute(time, $user_id);
+ $dbh->commit;
+ }
+ $self->write(\"+OK public-inbox POP3 server signing off\r\n");
+ $self->close;
+ undef;
+}
+
+# returns 1 if we can continue, 0 if not due to buffered writes or disconnect
+sub process_line ($$) {
+ my ($self, $l) = @_;
+ my ($req, @args) = split(/[ \t]+/, $l);
+ return 1 unless defined($req); # skip blank line
+ $req = $self->can('cmd_'.lc($req));
+ my $res = $req ? eval { $req->($self, @args) } :
+ \"-ERR command not recognized\r\n";
+ my $err = $@;
+ if ($err && $self->{sock}) {
+ chomp($l);
+ err($self, 'error from: %s (%s)', $l, $err);
+ $res = \"-ERR program fault - command not performed\r\n";
+ }
+ defined($res) ? $self->write($res) : 0;
+}
+
+# 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->{long_cb};
+
+ # 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 $line = index($$rbuf, "\n");
+ while ($line < 0) {
+ return $self->close if length($$rbuf) >= LINE_MAX;
+ $self->do_read($rbuf, LINE_MAX, length($$rbuf)) or return;
+ $line = index($$rbuf, "\n");
+ }
+ $line = substr($$rbuf, 0, $line + 1, '');
+ $line =~ s/\r?\n\z//s;
+ return $self->close if $line =~ /[[:cntrl:]]/s;
+ my $t0 = now();
+ my $fd = fileno($self->{sock}); # may become invalid after process_line
+ my $r = eval { process_line($self, $line) };
+ my $pending = $self->{wbuf} ? ' pending' : '';
+ out($self, "[$fd] %s - %0.6f$pending - $r", $line, now() - $t0);
+ return $self->close if $r < 0;
+ $self->rbuf_idle($rbuf);
+
+ # maybe there's more pipelined data, or we'll have
+ # to register it for socket-readiness notifications
+ $self->requeue unless $pending;
+}
+
+no warnings 'once';
+*cmd_top = \&cmd_retr;
+
+1;
diff --git a/lib/PublicInbox/POP3D.pm b/lib/PublicInbox/POP3D.pm
new file mode 100644
index 00000000..65997f6d
--- /dev/null
+++ b/lib/PublicInbox/POP3D.pm
@@ -0,0 +1,231 @@
+# Copyright (C) all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+
+# represents an POP3D (currently a singleton)
+package PublicInbox::POP3D;
+use v5.12;
+use parent qw(PublicInbox::Lock);
+use DBI qw(:sql_types); # SQL_BLOB
+use Carp ();
+use File::Temp 0.19 (); # 0.19 for ->newdir
+use PublicInbox::Config;
+use PublicInbox::POP3;
+use PublicInbox::Syscall;
+use File::Temp 0.19 (); # 0.19 for ->newdir
+use File::FcntlLock;
+use Fcntl qw(F_SETLK F_UNLCK F_WRLCK SEEK_SET);
+
+sub new {
+ my ($cls, $pi_cfg) = @_;
+ $pi_cfg //= PublicInbox::Config->new;
+ my $d = $pi_cfg->{'publicinbox.pop3state'} //
+ die "publicinbox.pop3state undefined\n";
+ -d $d or do {
+ require File::Path;
+ File::Path::make_path($d, { mode => 0700 });
+ PublicInbox::Syscall::nodatacow_dir($d);
+ };
+ bless {
+ err => \*STDERR,
+ out => \*STDOUT,
+ pi_cfg => $pi_cfg,
+ lock_path => "$d/db.lock", # PublicInbox::Lock to protect SQLite
+ # interprocess lock is the $pop3state/txn.locks file
+ # txn_locks => {}, # intraworker locks
+ # accept_tls => { SSL_server => 1, ..., SSL_reuse_ctx => ... }
+ }, $cls;
+}
+
+sub refresh_groups { # PublicInbox::Daemon callback
+ my ($self, $sig) = @_;
+ # TODO share pi_cfg with nntpd/imapd inside -netd
+ my $new = PublicInbox::Config->new;
+ my $old = $self->{pi_cfg};
+ my $s = 'publicinbox.pop3state';
+ $new->{$s} //= $old->{$s};
+ if ($new->{$s} ne $old->{$s}) {
+ warn <<EOM;
+$s changed: `$old->{$s}' => `$new->{$s}', config reload ignored
+EOM
+ } else {
+ $self->{pi_cfg} = $new;
+ }
+}
+
+# persistent tables
+sub create_state_tables ($$) {
+ my ($self, $dbh) = @_;
+
+ $dbh->do(<<''); # map publicinbox.<name>.newsgroup to integers
+CREATE TABLE IF NOT EXISTS newsgroups (
+ newsgroup_id INTEGER PRIMARY KEY NOT NULL,
+ newsgroup VARBINARY NOT NULL,
+ UNIQUE (newsgroup) )
+
+ # the $NEWSGROUP_NAME.$SLICE_INDEX is part of the POP3 username;
+ # POP3 has no concept of folders/mailboxes like IMAP/JMAP
+ $dbh->do(<<'');
+CREATE TABLE IF NOT EXISTS mailboxes (
+ mailbox_id INTEGER PRIMARY KEY NOT NULL,
+ newsgroup_id INTEGER NOT NULL REFERENCES newsgroups,
+ slice INTEGER NOT NULL, /* -1 for most recent slice */
+ UNIQUE (newsgroup_id, slice) )
+
+ $dbh->do(<<''); # actual users are differentiated by their UUID
+CREATE TABLE IF NOT EXISTS users (
+ user_id INTEGER PRIMARY KEY NOT NULL,
+ uuid VARBINARY NOT NULL,
+ last_seen INTEGER NOT NULL, /* to expire idle accounts */
+ UNIQUE (uuid) )
+
+ # we only track the highest-numbered deleted message per-UUID@mailbox
+ $dbh->do(<<'');
+CREATE TABLE IF NOT EXISTS deletes (
+ txn_id INTEGER PRIMARY KEY NOT NULL, /* -1 == txn lock offset */
+ user_id INTEGER NOT NULL REFERENCES users,
+ mailbox_id INTEGER NOT NULL REFERENCES mailboxes,
+ uid_dele INTEGER NULL, /* IMAP UID, NNTP article number */
+ UNIQUE(user_id, mailbox_id) )
+
+}
+
+sub state_dbh_new {
+ my ($self) = @_;
+ my $f = "$self->{pi_cfg}->{'publicinbox.pop3state'}/db.sqlite3";
+ my $creat = !-s $f;
+ if ($creat) {
+ open my $fh, '+>>', $f or Carp::croak "open($f): $!";
+ PublicInbox::Syscall::nodatacow_fh($fh);
+ }
+
+ my $dbh = DBI->connect("dbi:SQLite:dbname=$f",'','', {
+ AutoCommit => 1,
+ RaiseError => 1,
+ PrintError => 0,
+ sqlite_use_immediate_transaction => 1,
+ sqlite_see_if_its_a_number => 1,
+ });
+ $dbh->do('PRAGMA journal_mode = WAL') if $creat;
+ $dbh->do('PRAGMA foreign_keys = ON'); # don't forget this
+
+ # ensure the interprocess fcntl lock file exists
+ $f = "$self->{pi_cfg}->{'publicinbox.pop3state'}/txn.locks";
+ open my $fh, '+>>', $f or Carp::croak("open($f): $!");
+ $self->{txn_fh} = $fh;
+
+ create_state_tables($self, $dbh);
+ $dbh;
+}
+
+sub lock_mailbox {
+ my ($self, $pop3) = @_; # pop3 - PublicInbox::POP3 client object
+ my $lk = $self->lock_for_scope; # lock the SQLite DB, only
+ my $dbh = $self->{-state_dbh} //= state_dbh_new($self);
+ my ($user_id, $ngid, $mbid, $txn_id);
+ my $uuid = delete $pop3->{uuid};
+ $dbh->begin_work;
+
+ # 1. make sure the user exists, update `last_seen'
+ my $sth = $dbh->prepare_cached(<<'');
+INSERT OR IGNORE INTO users (uuid, last_seen) VALUES (?,?)
+
+ $sth->bind_param(1, $uuid, SQL_BLOB);
+ $sth->bind_param(2, time);
+ if ($sth->execute == 0) { # existing user
+ $sth = $dbh->prepare_cached(<<'', undef, 1);
+SELECT user_id FROM users WHERE uuid = ?
+
+ $sth->bind_param(1, $uuid, SQL_BLOB);
+ $sth->execute;
+ $user_id = $sth->fetchrow_array //
+ die 'BUG: user '.unpack('H*', $uuid).' not found';
+ $sth = $dbh->prepare_cached(<<'');
+UPDATE users SET last_seen = ? WHERE user_id = ?
+
+ $sth->execute(time, $user_id);
+ } else { # new user
+ $user_id = $dbh->last_insert_id(undef, undef,
+ 'users', 'user_id')
+ }
+
+ # 2. make sure the newsgroup has an integer ID
+ $sth = $dbh->prepare_cached(<<'');
+INSERT OR IGNORE INTO newsgroups (newsgroup) VALUES (?)
+
+ my $ng = $pop3->{ibx}->{newsgroup};
+ $sth->bind_param(1, $ng, SQL_BLOB);
+ if ($sth->execute == 0) {
+ $sth = $dbh->prepare_cached(<<'', undef, 1);
+SELECT newsgroup_id FROM newsgroups WHERE newsgroup = ?
+
+ $sth->bind_param(1, $ng, SQL_BLOB);
+ $sth->execute;
+ $ngid = $sth->fetchrow_array // die "BUG: `$ng' not found";
+ } else {
+ $ngid = $dbh->last_insert_id(undef, undef,
+ 'newsgroups', 'newsgroup_id');
+ }
+
+ # 3. ensure the mailbox exists
+ $sth = $dbh->prepare_cached(<<'');
+INSERT OR IGNORE INTO mailboxes (newsgroup_id, slice) VALUES (?,?)
+
+ if ($sth->execute($ngid, $pop3->{slice}) == 0) {
+ $sth = $dbh->prepare_cached(<<'', undef, 1);
+SELECT mailbox_id FROM mailboxes WHERE newsgroup_id = ? AND slice = ?
+
+ $sth->execute($ngid, $pop3->{slice});
+ $mbid = $sth->fetchrow_array //
+ die "BUG: mailbox_id for $ng.$pop3->{slice} not found";
+ } else {
+ $mbid = $dbh->last_insert_id(undef, undef,
+ 'mailboxes', 'mailbox_id');
+ }
+
+ # 4. ensure the (max) deletes row exists for locking
+ $sth = $dbh->prepare_cached(<<'');
+INSERT OR IGNORE INTO deletes (user_id,mailbox_id) VALUES (?,?)
+
+ if ($sth->execute($user_id, $mbid) == 0) {
+ $sth = $dbh->prepare_cached(<<'', undef, 1);
+SELECT txn_id,uid_dele FROM deletes WHERE user_id = ? AND mailbox_id = ?
+
+ $sth->execute($user_id, $mbid);
+ ($txn_id, $pop3->{uid_dele}) = $sth->fetchrow_array;
+ } else {
+ $txn_id = $dbh->last_insert_id(undef, undef,
+ 'deletes', 'txn_id');
+ }
+ $dbh->commit;
+
+ # see if it's locked by the same worker:
+ return if $self->{txn_locks}->{$txn_id};
+
+ # see if it's locked by another worker:
+ my $fs = File::FcntlLock->new;
+ $fs->l_type(F_WRLCK);
+ $fs->l_whence(SEEK_SET);
+ $fs->l_start($txn_id - 1);
+ $fs->l_len(1);
+ $fs->lock($self->{txn_fh}, F_SETLK) or return;
+
+ $pop3->{user_id} = $user_id;
+ $pop3->{txn_id} = $txn_id;
+ $self->{txn_locks}->{$txn_id} = 1;
+}
+
+sub unlock_mailbox {
+ my ($self, $pop3) = @_;
+ my $txn_id = delete($pop3->{txn_id}) // return;
+ delete $self->{txn_locks}->{$txn_id}; # same worker
+
+ # other workers
+ my $fs = File::FcntlLock->new;
+ $fs->l_type(F_UNLCK);
+ $fs->l_whence(SEEK_SET);
+ $fs->l_start($txn_id - 1);
+ $fs->l_len(1);
+ $fs->lock($self->{txn_fh}, F_SETLK) or die "F_UNLCK: $!";
+}
+
+1;
diff --git a/script/public-inbox-pop3d b/script/public-inbox-pop3d
new file mode 100755
index 00000000..ec944aee
--- /dev/null
+++ b/script/public-inbox-pop3d
@@ -0,0 +1,8 @@
+#!perl -w
+# Copyright (C) all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+#
+# Standalone POP3 server for public-inbox.
+use v5.12;
+use PublicInbox::Daemon;
+PublicInbox::Daemon::run('pop3://0.0.0.0:110');
diff --git a/t/pop3d.t b/t/pop3d.t
new file mode 100644
index 00000000..e781987e
--- /dev/null
+++ b/t/pop3d.t
@@ -0,0 +1,254 @@
+#!perl -w
+# Copyright (C) all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+use v5.12;
+use PublicInbox::TestCommon;
+use Socket qw(IPPROTO_TCP SOL_SOCKET);
+# Net::POP3 is part of the standard library, but distros may split it off...
+require_mods(qw(DBD::SQLite Net::POP3 IO::Socket::SSL File::FcntlLock));
+require_git('2.6'); # for v2
+use_ok 'IO::Socket::SSL';
+use_ok 'PublicInbox::TLS';
+my ($tmpdir, $for_destroy) = tmpdir();
+mkdir("$tmpdir/p3state") or xbail "mkdir: $!";
+my $err = "$tmpdir/stderr.log";
+my $out = "$tmpdir/stdout.log";
+my $olderr = "$tmpdir/plain.err";
+my $group = 'test-pop3';
+my $addr = $group . '@example.com';
+my $stls = tcp_server();
+my $plain = tcp_server();
+my $pop3s = tcp_server();
+my $patch = eml_load('t/data/0001.patch');
+my $ibx = create_inbox 'pop3d', version => 2, -primary_address => $addr,
+ indexlevel => 'basic', sub {
+ my ($im, $ibx) = @_;
+ $im->add(eml_load('t/plack-qp.eml')) or BAIL_OUT '->add';
+ $im->add($patch) or BAIL_OUT '->add';
+};
+my $pi_config = "$tmpdir/pi_config";
+open my $fh, '>', $pi_config or BAIL_OUT "open: $!";
+print $fh <<EOF or BAIL_OUT "print: $!";
+[publicinbox]
+ pop3state = $tmpdir/p3state
+[publicinbox "pop3"]
+ inboxdir = $ibx->{inboxdir}
+ address = $addr
+ indexlevel = basic
+ newsgroup = $group
+EOF
+close $fh or BAIL_OUT "close: $!\n";
+
+my $pop3s_addr = tcp_host_port($pop3s);
+my $stls_addr = tcp_host_port($stls);
+my $plain_addr = tcp_host_port($plain);
+my $env = { PI_CONFIG => $pi_config };
+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/";
+}
+
+my $old = start_script(['-pop3d', '-W0',
+ "--stdout=$tmpdir/plain.out", "--stderr=$olderr" ],
+ $env, { 3 => $plain });
+my $oldc = Net::POP3->new($plain->sockhost, Port => $plain->sockport);
+my $locked_mb = ('e'x32)."\@$group";
+ok($oldc->apop("$locked_mb.0", 'anonymous'), 'APOP to old');
+my @old_args = ($plain->sockhost, Port => $plain->sockport);
+
+{ # locking within the same process
+ my $x = Net::POP3->new(@old_args);
+ ok(!$x->apop("$locked_mb.0", 'anonymous'), 'APOP lock failure');
+ like($x->message, qr/unable to lock/, 'diagnostic message');
+
+ $x = Net::POP3->new(@old_args);
+ ok($x->apop($locked_mb, 'anonymous'), 'APOP lock acquire');
+
+ my $y = Net::POP3->new(@old_args);
+ ok(!$y->apop($locked_mb, 'anonymous'), 'APOP lock fails once');
+
+ undef $x;
+ $y = Net::POP3->new(@old_args);
+ ok($y->apop($locked_mb, 'anonymous'), 'APOP lock works after release');
+}
+
+for my $args (
+ [ "--cert=$cert", "--key=$key",
+ "-lpop3s://$pop3s_addr",
+ "-lpop3://$stls_addr" ],
+) {
+ for ($out, $err) { open my $fh, '>', $_ or BAIL_OUT "truncate: $!" }
+ my $cmd = [ '-netd', '-W0', @$args, "--stdout=$out", "--stderr=$err" ];
+ my $td = start_script($cmd, $env, { 3 => $stls, 4 => $pop3s });
+
+ 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($pop3s, 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());
+ }
+
+ my @p3s_args = ($pop3s->sockhost,
+ Port => $pop3s->sockport, SSL => 1, %o);
+ my $p3s = Net::POP3->new(@p3s_args);
+ ok($p3s->quit, 'QUIT works w/POP3S');
+ {
+ $p3s = Net::POP3->new(@p3s_args);
+ ok(!$p3s->apop("$locked_mb.0", 'anonymous'),
+ 'APOP lock failure w/ another daemon');
+ like($p3s->message, qr/unable to lock/, 'diagnostic message');
+ }
+
+ # 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');
+ my @np3_args = ($stls->sockhost, Port => $stls->sockport);
+ my $np3 = Net::POP3->new(@np3_args);
+ ok($np3->quit, 'plain QUIT works');
+ $np3 = Net::POP3->new(@np3_args, %o);
+ ok($np3->starttls, 'STLS works');
+ ok($np3->quit, 'QUIT works after STLS');
+
+ for my $mailbox (('x'x32)."\@$group", $group, ('a'x32)."\@z.$group") {
+ $np3 = Net::POP3->new(@np3_args);
+ ok(!$np3->user($mailbox), "USER $mailbox reject");
+ ok($np3->quit, 'QUIT after USER fail');
+
+ $np3 = Net::POP3->new(@np3_args);
+ ok(!$np3->apop($mailbox, 'anonymous'), "APOP $mailbox reject");
+ ok($np3->quit, "QUIT after APOP fail $mailbox");
+ }
+ for my $mailbox ($group, "$group.0") {
+ my $u = ('f'x32)."\@$mailbox";
+ $np3 = Net::POP3->new(@np3_args);
+ ok($np3->user($u), "UUID\@$mailbox accept");
+ ok($np3->pass('anonymous'), 'pass works');
+
+ $np3 = Net::POP3->new(@np3_args);
+ ok($np3->user($u), "UUID\@$mailbox accept");
+ ok($np3->pass('anonymous'), 'pass works');
+
+ my $list = $np3->list;
+ my $uidl = $np3->uidl;
+ is_deeply([sort keys %$list], [sort keys %$uidl],
+ 'LIST and UIDL keys match');
+ ok($_ > 0, 'bytes in LIST result') for values %$list;
+ like($_, qr/\A[a-z0-9]{40,}\z/,
+ 'blob IDs in UIDL result') for values %$uidl;
+
+ $np3 = Net::POP3->new(@np3_args);
+ ok(!$np3->apop($u, 'anonumuss'), 'APOP wrong pass reject');
+
+ $np3 = Net::POP3->new(@np3_args);
+ ok($np3->apop($u, 'anonymous'), "APOP UUID\@$mailbox");
+ my @res = $np3->popstat;
+ is($res[0], 2, 'STAT knows about 2 messages');
+
+ my $msg = $np3->get(2);
+ $msg = join('', @$msg);
+ $msg =~ s/\r\n/\n/g;
+ is_deeply(PublicInbox::Eml->new($msg), $patch,
+ 't/data/0001.patch round-tripped');
+
+ ok(!$np3->get(22), 'missing message');
+
+ $msg = $np3->top(2, 0);
+ $msg = join('', @$msg);
+ $msg =~ s/\r\n/\n/g;
+ is($msg, $patch->header_obj->as_string . "\n",
+ 'TOP numlines=0');
+
+ ok(!$np3->top(2, -1), 'negative TOP numlines');
+
+ $msg = $np3->top(2, 1);
+ $msg = join('', @$msg);
+ $msg =~ s/\r\n/\n/g;
+ is($msg, $patch->header_obj->as_string . <<EOF,
+
+Filenames within a project tend to be reasonably stable within a
+EOF
+ 'TOP numlines=1');
+
+ $msg = $np3->top(2, 10000);
+ $msg = join('', @$msg);
+ $msg =~ s/\r\n/\n/g;
+ is_deeply(PublicInbox::Eml->new($msg), $patch,
+ 'TOP numlines=10000 (excess)');
+
+ $np3 = Net::POP3->new(@np3_args, %o);
+ ok($np3->starttls, 'STLS works before APOP');
+ ok($np3->apop($u, 'anonymous'), "APOP UUID\@$mailbox w/ STLS");
+
+ # undocumented:
+ ok($np3->_NOOP, 'NOOP works') if $np3->can('_NOOP');
+ }
+
+ SKIP: {
+ skip 'TCP_DEFER_ACCEPT is Linux-only', 2 if $^O ne 'linux';
+ my $var = eval { Socket::TCP_DEFER_ACCEPT() } // 9;
+ my $x = getsockopt($pop3s, IPPROTO_TCP, $var) //
+ xbail "IPPROTO_TCP: $!";
+ ok(unpack('i', $x) > 0, 'TCP_DEFER_ACCEPT set on POP3S');
+ $x = getsockopt($stls, IPPROTO_TCP, $var) //
+ xbail "IPPROTO_TCP: $!";
+ is(unpack('i', $x), 0, 'TCP_DEFER_ACCEPT is 0 on plain POP3');
+ };
+ SKIP: {
+ skip 'SO_ACCEPTFILTER is FreeBSD-only', 2 if $^O ne 'freebsd';
+ system('kldstat -m accf_data >/dev/null') and
+ skip 'accf_data not loaded? kldload accf_data', 2;
+ require PublicInbox::Daemon;
+ my $x = getsockopt($pop3s, SOL_SOCKET,
+ $PublicInbox::Daemon::SO_ACCEPTFILTER);
+ like($x, qr/\Adataready\0+\z/, 'got dataready accf for pop3s');
+ $x = getsockopt($stls, IPPROTO_TCP,
+ $PublicInbox::Daemon::SO_ACCEPTFILTER);
+ is($x, undef, 'no BSD accept filter for plain IMAP');
+ };
+
+ $td->kill;
+ $td->join;
+ is($?, 0, 'no error in exited -netd');
+ open my $fh, '<', $err or BAIL_OUT "open $err failed: $!";
+ my $eout = do { local $/; <$fh> };
+ unlike($eout, qr/wide/i, 'no Wide character warnings in -netd');
+}
+
+{
+ my $capa = $oldc->capa;
+ ok(defined($capa->{PIPELINING}), 'pipelining supported by CAPA');
+}
+
+# TODO: more tests, but mpop was really helpful in helping me
+# figure out bugs with larger newsgroups (>50K messages) which
+# probably isn't suited for this test suite.
+
+$old->kill;
+$old->join;
+is($?, 0, 'no error in exited -pop3d');
+open $fh, '<', $olderr or BAIL_OUT "open $olderr failed: $!";
+my $eout = do { local $/; <$fh> };
+unlike($eout, qr/wide/i, 'no Wide character warnings in -pop3d');
+
+done_testing;
^ permalink raw reply related [flat|nested] 10+ messages in thread
* [PATCH 2/2] pop3: implement IN-USE from RESP-CODES (RFC 2449)
2022-07-19 2:49 [PATCH 0/2] preliminary POP3 daemon Eric Wong
2022-07-19 2:49 ` [PATCH 1/2] public-inbox-pop3d - a mostly read-only POP3 server Eric Wong
@ 2022-07-19 2:49 ` Eric Wong
2022-07-20 7:27 ` [PATCH 3/2] pop3: fix numerous bugs in delete handling Eric Wong
2022-07-20 9:24 ` [PATCH v2 0/5] public-inbox POP3 daemon Eric Wong
3 siblings, 0 replies; 10+ messages in thread
From: Eric Wong @ 2022-07-19 2:49 UTC (permalink / raw)
To: meta
This may help clients communicate to users if they're
making parallel connections or if we have server bugs.
---
lib/PublicInbox/POP3.pm | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/lib/PublicInbox/POP3.pm b/lib/PublicInbox/POP3.pm
index f920571d..5cffc556 100644
--- a/lib/PublicInbox/POP3.pm
+++ b/lib/PublicInbox/POP3.pm
@@ -176,7 +176,7 @@ sub _login_ok ($) {
$self->{uid_max} = $self->{ibx}->over(1)->max;
\"+OK logged in\r\n";
} else {
- \"-ERR unable to lock maildrop\r\n";
+ \"-ERR [IN-USE] unable to lock maildrop\r\n";
}
}
@@ -350,6 +350,7 @@ USER\r
PIPELINING\r
UIDL\r
EXPIRE 0\r
+RESP-CODES\r
.\r
EOM
}
^ permalink raw reply related [flat|nested] 10+ messages in thread
* [PATCH 3/2] pop3: fix numerous bugs in delete handling
2022-07-19 2:49 [PATCH 0/2] preliminary POP3 daemon Eric Wong
2022-07-19 2:49 ` [PATCH 1/2] public-inbox-pop3d - a mostly read-only POP3 server Eric Wong
2022-07-19 2:49 ` [PATCH 2/2] pop3: implement IN-USE from RESP-CODES (RFC 2449) Eric Wong
@ 2022-07-20 7:27 ` Eric Wong
2022-07-20 9:24 ` [PATCH v2 0/5] public-inbox POP3 daemon Eric Wong
3 siblings, 0 replies; 10+ messages in thread
From: Eric Wong @ 2022-07-20 7:27 UTC (permalink / raw)
To: meta
Eric Wong <e@80x24.org> wrote:
> The on-disk storage aspect still has me a little nervous :x
I think this needs to be squashed into [PATCH 1/2] to avoid
migration costs (probably nobody but me is running this, yet):
------8<-------
Subject: [PATCH] pop3: fix numerous bugs in delete handling
This requires a DB change to simplify our Perl code, but there's
no migration for it presently.
We were also incorrectly relying on array offsets instead of sequence
numbers for "EXPIRE 0" handling.
---
lib/PublicInbox/POP3.pm | 4 ++--
lib/PublicInbox/POP3D.pm | 2 +-
t/pop3d.t | 37 +++++++++++++++++++++++++++++++++++--
3 files changed, 38 insertions(+), 5 deletions(-)
diff --git a/lib/PublicInbox/POP3.pm b/lib/PublicInbox/POP3.pm
index 5cffc556..51c2b71a 100644
--- a/lib/PublicInbox/POP3.pm
+++ b/lib/PublicInbox/POP3.pm
@@ -218,7 +218,7 @@ sub need_txn ($) {
sub _stat_cache ($) {
my ($self) = @_;
- my ($beg, $end) = ($self->{uid_dele} // 0, $self->{uid_max});
+ my ($beg, $end) = (($self->{uid_dele} // -1) + 1, $self->{uid_max});
PublicInbox::IMAP::uid_clamp($self, \$beg, \$end);
my $opt = { limit => PublicInbox::IMAP::UID_SLICE };
my $m = $self->{ibx}->over(1)->do_get(<<'', $opt, $beg, $end);
@@ -305,7 +305,7 @@ sub retr_cb { # called by git->cat_async via ibx_async_cat
$$bref .= substr($$bref, -2, 2) eq "\r\n" ? ".\r\n" : "\r\n.\r\n";
$self->msg_more("+OK message follows\r\n");
$self->write($bref);
- $self->{expire} .= pack('S', $off) if exists $self->{expire};
+ $self->{expire} .= pack('S', $off + 1) if exists $self->{expire};
$self->requeue;
}
diff --git a/lib/PublicInbox/POP3D.pm b/lib/PublicInbox/POP3D.pm
index 65997f6d..c7bf1755 100644
--- a/lib/PublicInbox/POP3D.pm
+++ b/lib/PublicInbox/POP3D.pm
@@ -84,7 +84,7 @@ CREATE TABLE IF NOT EXISTS deletes (
txn_id INTEGER PRIMARY KEY NOT NULL, /* -1 == txn lock offset */
user_id INTEGER NOT NULL REFERENCES users,
mailbox_id INTEGER NOT NULL REFERENCES mailboxes,
- uid_dele INTEGER NULL, /* IMAP UID, NNTP article number */
+ uid_dele INTEGER NOT NULL DEFAULT -1, /* IMAP UID, NNTP article */
UNIQUE(user_id, mailbox_id) )
}
diff --git a/t/pop3d.t b/t/pop3d.t
index e781987e..d5ccb0d8 100644
--- a/t/pop3d.t
+++ b/t/pop3d.t
@@ -54,10 +54,10 @@ unless (-r $key && -r $cert) {
my $old = start_script(['-pop3d', '-W0',
"--stdout=$tmpdir/plain.out", "--stderr=$olderr" ],
$env, { 3 => $plain });
-my $oldc = Net::POP3->new($plain->sockhost, Port => $plain->sockport);
+my @old_args = ($plain->sockhost, Port => $plain->sockport);
+my $oldc = Net::POP3->new(@old_args);
my $locked_mb = ('e'x32)."\@$group";
ok($oldc->apop("$locked_mb.0", 'anonymous'), 'APOP to old');
-my @old_args = ($plain->sockhost, Port => $plain->sockport);
{ # locking within the same process
my $x = Net::POP3->new(@old_args);
@@ -238,6 +238,39 @@ EOF
{
my $capa = $oldc->capa;
ok(defined($capa->{PIPELINING}), 'pipelining supported by CAPA');
+ is($capa->{EXPIRE}, 0, 'EXPIRE 0 set');
+
+ # clients which see "EXPIRE 0" can elide DELE requests
+ my $list = $oldc->list;
+ ok($oldc->get($_), "RETR $_") for keys %$list;
+ ok($oldc->quit, 'QUIT after RETR');
+
+ $oldc = Net::POP3->new(@old_args);
+ ok($oldc->apop("$locked_mb.0", 'anonymous'), 'APOP reconnect');
+ my $cont = $oldc->list;
+ is_deeply($cont, {}, 'no messages after implicit DELE from EXPIRE 0');
+ ok($oldc->quit, 'QUIT on noop');
+
+ # test w/o checking CAPA to trigger EXPIRE 0
+ $oldc = Net::POP3->new(@old_args);
+ ok($oldc->apop($locked_mb, 'anonymous'), 'APOP on latest slice');
+ my $l2 = $oldc->list;
+ is_deeply($l2, $list, 'different mailbox, different deletes');
+ ok($oldc->get($_), "RETR $_") for keys %$list;
+ ok($oldc->quit, 'QUIT w/o EXPIRE nor DELE');
+
+ $oldc = Net::POP3->new(@old_args);
+ ok($oldc->apop($locked_mb, 'anonymous'), 'APOP again on latest');
+ $l2 = $oldc->list;
+ is_deeply($l2, $list, 'no DELE nor EXPIRE preserves messages');
+ ok($oldc->delete(2), 'explicit DELE on latest');
+ ok($oldc->quit, 'QUIT w/ highest DELE');
+
+ # this is non-standard behavior, but necessary if we expect hundreds
+ # of thousands of users on cheap HW
+ $oldc = Net::POP3->new(@old_args);
+ ok($oldc->apop($locked_mb, 'anonymous'), 'APOP yet again on latest');
+ is_deeply($oldc->list, {}, 'highest DELE deletes older messages, too');
}
# TODO: more tests, but mpop was really helpful in helping me
^ permalink raw reply related [flat|nested] 10+ messages in thread
* [PATCH v2 0/5] public-inbox POP3 daemon
2022-07-19 2:49 [PATCH 0/2] preliminary POP3 daemon Eric Wong
` (2 preceding siblings ...)
2022-07-20 7:27 ` [PATCH 3/2] pop3: fix numerous bugs in delete handling Eric Wong
@ 2022-07-20 9:24 ` Eric Wong
2022-07-20 9:24 ` [PATCH v2 1/5] public-inbox-pop3d - a mostly read-only POP3 server Eric Wong
` (4 more replies)
3 siblings, 5 replies; 10+ messages in thread
From: Eric Wong @ 2022-07-20 9:24 UTC (permalink / raw)
To: meta
Deletes seem working, and some more bugs with well-known ports.
Mainly tested with public-inbox-netd, but it's live and running
on public-inbox.org (sharing the same process with NNTP and
IMAP).
username: $(uuidgen)@inbox.comp.mail.public-inbox.meta
password: anonymous
ports 110 (POP3 w/ STARTTLS) and 995 (POP3S)
7fh6tueqddpjyxjmgtdiueylzoqt6pt7hec3pukyptlmohoowvhde4yd.onion:110
should also work for Tor users.
Eric Wong (5):
public-inbox-pop3d - a mostly read-only POP3 server
pop3: implement IN-USE from RESP-CODES (RFC 2449)
pop3: TOP requests do not expire messages
netd: setup TLS bits for well-known STARTTLS ports
pop3: advertise STLS in CAPA if appropriate
Documentation/public-inbox-config.pod | 12 +-
Documentation/public-inbox-pop3d.pod | 122 +++++++
Documentation/standards.perl | 13 +-
MANIFEST | 5 +
lib/PublicInbox/Config.pm | 5 +-
lib/PublicInbox/Daemon.pm | 10 +-
lib/PublicInbox/Inbox.pm | 10 +-
lib/PublicInbox/POP3.pm | 447 ++++++++++++++++++++++++++
lib/PublicInbox/POP3D.pm | 231 +++++++++++++
script/public-inbox-pop3d | 8 +
t/pop3d.t | 303 +++++++++++++++++
11 files changed, 1148 insertions(+), 18 deletions(-)
create mode 100644 Documentation/public-inbox-pop3d.pod
create mode 100644 lib/PublicInbox/POP3.pm
create mode 100644 lib/PublicInbox/POP3D.pm
create mode 100755 script/public-inbox-pop3d
create mode 100644 t/pop3d.t
^ permalink raw reply [flat|nested] 10+ messages in thread
* [PATCH v2 1/5] public-inbox-pop3d - a mostly read-only POP3 server
2022-07-20 9:24 ` [PATCH v2 0/5] public-inbox POP3 daemon Eric Wong
@ 2022-07-20 9:24 ` Eric Wong
2022-07-20 9:24 ` [PATCH v2 2/5] pop3: implement IN-USE from RESP-CODES (RFC 2449) Eric Wong
` (3 subsequent siblings)
4 siblings, 0 replies; 10+ messages in thread
From: Eric Wong @ 2022-07-20 9:24 UTC (permalink / raw)
To: meta
Old account expiry has not been implemented, but it seems to
work well with both mpop(1) and getmail(1). The strictness of
mpop was particularly helpful in ironing out bugs in our
implementation of (dreaded) message sequence numbers.
"EXPIRE 0" (RFC 2449) can theoretically save numerous "DELE"
commands, but that's untested by real-world clients. mpop
supports PIPELINING which is effective in hiding latency,
and the core networking functionality is already well-tested
from our NNTP and IMAP implementations.
Configuration requires "publicinbox.pop3state" to point to
a directory writable by the otherwise read-only daemon.
See public-inbox-pop3d(1) manpage for more usage details.
---
Documentation/public-inbox-config.pod | 12 +-
Documentation/public-inbox-pop3d.pod | 122 +++++++
Documentation/standards.perl | 12 +-
MANIFEST | 5 +
lib/PublicInbox/Config.pm | 5 +-
lib/PublicInbox/Daemon.pm | 8 +-
lib/PublicInbox/Inbox.pm | 10 +-
lib/PublicInbox/POP3.pm | 443 ++++++++++++++++++++++++++
lib/PublicInbox/POP3D.pm | 231 ++++++++++++++
script/public-inbox-pop3d | 8 +
t/pop3d.t | 287 +++++++++++++++++
11 files changed, 1126 insertions(+), 17 deletions(-)
create mode 100644 Documentation/public-inbox-pop3d.pod
create mode 100644 lib/PublicInbox/POP3.pm
create mode 100644 lib/PublicInbox/POP3D.pm
create mode 100755 script/public-inbox-pop3d
create mode 100644 t/pop3d.t
diff --git a/Documentation/public-inbox-config.pod b/Documentation/public-inbox-config.pod
index 43e54ed4..ed99b188 100644
--- a/Documentation/public-inbox-config.pod
+++ b/Documentation/public-inbox-config.pod
@@ -67,10 +67,12 @@ may be any newsgroup name with hierarchies delimited by C<.>.
For example, the newsgroup for L<mailto:meta@public-inbox.org>
is: C<inbox.comp.mail.public-inbox.meta>
-It also configures the folder hierarchy used by L<public-inbox-imapd(1)>.
+It also configures the folder hierarchy used by L<public-inbox-imapd(1)>
+as well as L<public-inbox-pop3d(1)>
Omitting this for a given inbox will prevent the inbox from
-being served by L<public-inbox-nntpd(1)> and/or L<public-inbox-imapd(1)>.
+being served by L<public-inbox-nntpd(1)>,
+L<public-inbox-imapd(1)>, and/or L<public-inbox-pop3d(1)>
Default: none, optional
@@ -226,6 +228,10 @@ L<public-inbox-nntpd(1)> instance.
Default: none
+=item publicinbox.pop3state
+
+See L<public-inbox-pop3d(1)/publicinbox.pop3state>
+
=item publicinbox.<name>.feedmax
The size of an Atom feed for the inbox. If specified more than
@@ -463,7 +469,7 @@ L<http://4uok3hntl7oi7b4uf4rtfwefqeexfzil2w6kgk2jn5z2f764irre7byd.onion/meta/>
=head1 COPYRIGHT
-Copyright 2016-2021 all contributors L<mailto:meta@public-inbox.org>
+Copyright all contributors L<mailto:meta@public-inbox.org>
License: AGPL-3.0+ L<https://www.gnu.org/licenses/agpl-3.0.txt>
diff --git a/Documentation/public-inbox-pop3d.pod b/Documentation/public-inbox-pop3d.pod
new file mode 100644
index 00000000..0404c2a7
--- /dev/null
+++ b/Documentation/public-inbox-pop3d.pod
@@ -0,0 +1,122 @@
+=head1 NAME
+
+public-inbox-pop3d - POP3 server for sharing public-inboxes
+
+=head1 SYNOPSIS
+
+ public-inbox-pop3d [OPTIONS]
+
+=head1 DESCRIPTION
+
+public-inbox-pop3d provides a POP3 daemon for public-inbox.
+It uses options and environment variables common to all
+read-only L<public-inbox-daemon(8)> implementations,
+but requires additional read-write storage to keep track
+of deleted messages on a per-user basis.
+
+Like L<public-inbox-imapd(1)>, C<public-inbox-pop3d> will never
+require write access to the directory where the public-inboxes
+are stored.
+
+It is designed for anonymous access, thus the password is
+always C<anonymous> (all lower-case).
+
+Usernames are of the format:
+
+ C<$UUID@$NEWSGROUP_NAME>
+
+Where C<$UUID> is the output of the L<uuidgen(1)> command. Dash
+(C<->) characters in UUIDs are ignored, and C<[A-F]> hex
+characters are case-insensitive. Users should keep their UUIDs
+private to prevent others from deleting unretrieved messages.
+Users may switch to a new UUID at any time to retrieve
+previously-retrieved messages.
+
+Historical slices of 50K messages are available
+by suffixing the integer L<$SLICE>, where C<0> is the oldest.
+
+ C<$UUID@$NEWSGROUP_NAME.$SLICE>
+
+It may be run as a different user than the user running
+L<public-inbox-watch(1)>, L<public-inbox-mda(1)>, or
+L<public-inbox-fetch(1)>.
+
+To save storage, L</publicinbox.pop3state> only stores
+the highest-numbered deleted message
+
+=head1 OPTIONS
+
+See common options in L<public-inbox-daemon(8)/OPTIONS>.
+
+=over
+
+=item -l PROTO://ADDRESS/?cert=/path/to/cert,key=/path/to/key
+
+=item --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<pop3://> or
+C<pop3s://>) may be specified to force a given protocol.
+
+For STARTTLS and POP3S 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 POP3S support
+if the C<cert> option is not given with C<--listen>.
+
+If using systemd-compatible socket activation and a TCP listener on port
+995 is inherited, it is automatically POP3S when this option is given.
+When a listener on port 110 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 POP3S
+support if the C<key> option is not given with C<--listen>. The private
+key may be concatenated into the path used by C<--cert>, in which case this
+option is not needed.
+
+=back
+
+=head1 CONFIGURATION
+
+Aside from C<publicinbox.pop3state>, C<public-inbox-pop3d> 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.pop3state
+
+A directory containing per-user/mailbox account information;
+must be writable to the C<public-inbox-pop3d> process.
+
+=item publicInbox.<name>.newsgroup
+
+The newsgroup name maps to a POP3 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/>, and
+L<nntp://news.public-inbox.org/inbox.comp.mail.public-inbox.meta>,
+L<nntp://4uok3hntl7oi7b4uf4rtfwefqeexfzil2w6kgk2jn5z2f764irre7byd.onion/inbox.comp.mail.public-inbox.meta>
+
+=head1 COPYRIGHT
+
+Copyright 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)>,
+L<uuidgen(1)>
diff --git a/Documentation/standards.perl b/Documentation/standards.perl
index 69568ceb..835de3a2 100755
--- a/Documentation/standards.perl
+++ b/Documentation/standards.perl
@@ -1,6 +1,6 @@
#!/usr/bin/perl -w
-use strict;
-# Copyright 2019-2021 all contributors <meta@public-inbox.org>
+use v5.12;
+# Copyright all contributors <meta@public-inbox.org>
# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
print <<EOF;
@@ -66,8 +66,12 @@ my $rfcs = [
2369 => 'URLs as Meta-Syntax for Core Mail List Commands',
8058 => 'Signaling One-Click Functionality for List Email Headers',
- # TODO: flesh this out
+ 1081 => 'Post Office Protocol – Version 3',
+ 1939 => 'Post Office Protocol – Version 3 (STD 53)',
+ 2449 => 'POP3 extension mechanism',
+ 2384 => 'POP URL Scheme',
+ # TODO: flesh this out
];
my @rfc_urls = qw(tools.ietf.org/html/rfc%d
@@ -102,6 +106,6 @@ Other relevant documentation
Copyright
---------
-Copyright (C) 2019-2020 all contributors <meta@public-inbox.org>
+Copyright (C) all contributors <meta@public-inbox.org>
License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
EOF
diff --git a/MANIFEST b/MANIFEST
index 209fb7d5..923f5147 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -84,6 +84,7 @@ Documentation/public-inbox-mda.pod
Documentation/public-inbox-netd.pod
Documentation/public-inbox-nntpd.pod
Documentation/public-inbox-overview.pod
+Documentation/public-inbox-pop3d.pod
Documentation/public-inbox-purge.pod
Documentation/public-inbox-tuning.pod
Documentation/public-inbox-v1-format.pod
@@ -302,6 +303,8 @@ lib/PublicInbox/NewsWWW.pm
lib/PublicInbox/OnDestroy.pm
lib/PublicInbox/Over.pm
lib/PublicInbox/OverIdx.pm
+lib/PublicInbox/POP3.pm
+lib/PublicInbox/POP3D.pm
lib/PublicInbox/PktOp.pm
lib/PublicInbox/ProcessPipe.pm
lib/PublicInbox/Qspawn.pm
@@ -368,6 +371,7 @@ script/public-inbox-learn
script/public-inbox-mda
script/public-inbox-netd
script/public-inbox-nntpd
+script/public-inbox-pop3d
script/public-inbox-purge
script/public-inbox-watch
script/public-inbox-xcpdb
@@ -520,6 +524,7 @@ t/plack-2-txt-bodies.eml
t/plack-attached-patch.eml
t/plack-qp.eml
t/plack.t
+t/pop3d.t
t/precheck.t
t/psgi_attach.eml
t/psgi_attach.t
diff --git a/lib/PublicInbox/Config.pm b/lib/PublicInbox/Config.pm
index 0f002e5e..a31b5b74 100644
--- a/lib/PublicInbox/Config.pm
+++ b/lib/PublicInbox/Config.pm
@@ -1,4 +1,4 @@
-# Copyright (C) 2014-2021 all contributors <meta@public-inbox.org>
+# Copyright (C) all contributors <meta@public-inbox.org>
# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
#
# Used throughout the project for reading configuration
@@ -434,7 +434,8 @@ sub _fill_ibx {
# more things to encourage decentralization
for my $k (qw(address altid nntpmirror imapmirror
coderepo hide listid url
- infourl watchheader nntpserver imapserver)) {
+ infourl watchheader
+ nntpserver imapserver pop3server)) {
my $v = $self->{"$pfx.$k"} // next;
$ibx->{$k} = _array($v);
}
diff --git a/lib/PublicInbox/Daemon.pm b/lib/PublicInbox/Daemon.pm
index 75719c34..fbce9154 100644
--- a/lib/PublicInbox/Daemon.pm
+++ b/lib/PublicInbox/Daemon.pm
@@ -32,8 +32,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', 993 => 'imaps' );
-my %KNOWN_STARTTLS = ( 119 => 'nntp', 143 => 'imap' );
+my %KNOWN_TLS = (443 => 'https', 563 => 'nntps', 993 => 'imaps', 995 =>'pop3s');
+my %KNOWN_STARTTLS = (110 => 'pop3', 119 => 'nntp', 143 => 'imap');
sub accept_tls_opt ($) {
my ($opt_str) = @_;
@@ -155,7 +155,7 @@ EOF
$tls_opt{"$scheme://$l"} = accept_tls_opt($1);
} elsif (defined($default_cert)) {
$tls_opt{"$scheme://$l"} = accept_tls_opt('');
- } elsif ($scheme =~ /\A(?:https|imaps|imaps)\z/) {
+ } elsif ($scheme =~ /\A(?:https|imaps|nntps|pop3s)\z/) {
die "$orig specified w/o cert=\n";
}
$scheme =~ /\A(http|imap|nntp|pop3)/ and
@@ -622,7 +622,7 @@ sub daemon_loop ($) {
$l =~ s!\A([^:]+)://!!;
my $scheme = $1 // '';
my $xn = $xnetd->{$l} // $xnetd->{''};
- if ($scheme =~ m!\A(?:https|imaps|nntps)!) {
+ if ($scheme =~ m!\A(?:https|imaps|nntps|pop3s)!) {
$post_accept{$l} = tls_start_cb($v, $xn->{post_accept});
} elsif ($xn->{tlsd}) { # STARTTLS, $k eq '' is OK
$xn->{tlsd}->{accept_tls} = $v;
diff --git a/lib/PublicInbox/Inbox.pm b/lib/PublicInbox/Inbox.pm
index 1579d500..da81fb67 100644
--- a/lib/PublicInbox/Inbox.pm
+++ b/lib/PublicInbox/Inbox.pm
@@ -1,4 +1,4 @@
-# Copyright (C) 2016-2021 all contributors <meta@public-inbox.org>
+# Copyright (C) all contributors <meta@public-inbox.org>
# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
#
# Represents a public-inbox (which may have multiple mailing addresses)
@@ -230,8 +230,9 @@ sub base_url {
$url;
}
+# imapserver, nntpserver, and pop3server configs are used here:
sub _x_url ($$$) {
- my ($self, $x, $ctx) = @_; # $x is "nntp" or "imap"
+ my ($self, $x, $ctx) = @_; # $x is "imap", "nntp", or "pop3"
# no checking for nntp_usable here, we can point entirely
# to non-local servers or users run by a different user
my $ns = $self->{"${x}server"} //
@@ -253,7 +254,7 @@ sub _x_url ($$$) {
if ($group) {
$u .= '/' if $u !~ m!/\z!;
$u .= $group;
- } else { # n.b. IMAP uses "newsgroup"
+ } else { # n.b. IMAP and POP3 use "newsgroup"
warn <<EOM;
publicinbox.$self->{name}.${x}mirror=$_ missing newsgroup name
EOM
@@ -273,8 +274,9 @@ EOM
}
# my ($self, $ctx) = @_;
-sub nntp_url { $_[0]->{-nntp_url} //= _x_url($_[0], 'nntp', $_[1]) }
sub imap_url { $_[0]->{-imap_url} //= _x_url($_[0], 'imap', $_[1]) }
+sub nntp_url { $_[0]->{-nntp_url} //= _x_url($_[0], 'nntp', $_[1]) }
+sub pop3_url { $_[0]->{-pop3_url} //= _x_url($_[0], 'pop3', $_[1]) }
sub nntp_usable {
my ($self) = @_;
diff --git a/lib/PublicInbox/POP3.pm b/lib/PublicInbox/POP3.pm
new file mode 100644
index 00000000..86123563
--- /dev/null
+++ b/lib/PublicInbox/POP3.pm
@@ -0,0 +1,443 @@
+# Copyright (C) all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+#
+# Each instance of this represents a POP3 client connected to
+# public-inbox-{netd,pop3d}. Much of this was taken from IMAP.pm and NNTP.pm
+#
+# POP3 is one mailbox per-user, so the "USER" command is like the
+# format of -imapd and is mapped to $NEWSGROUP.$SLICE (large inboxes
+# are sliced into 50K mailboxes in both POP3 and IMAP to avoid overloading
+# clients)
+#
+# Unlike IMAP, the "$NEWSGROUP" mailbox (without $SLICE) is a rolling
+# window of the latest messages. We can do this for POP3 since the
+# typical POP3 session is short-lived while long-lived IMAP sessions
+# would cause slices to grow on the server side without bounds.
+#
+# Like IMAP, POP3 also has per-session message sequence numbers (MSN),
+# which require mapping to UIDs. The offset of an entry into our
+# per-client cache is: (MSN-1)
+#
+# fields:
+# - uuid - 16-byte (binary) UUID representation (before successful login)
+# - cache - one-dimentional arrayref of (UID, bytesize, oidhex)
+# - nr_dele - number of deleted messages
+# - expire - string of packed unsigned short offsets
+# - user_id - user-ID mapped to UUID (on successful login + lock)
+# - txn_max_uid - for storing max deleted UID persistently
+# - ibx - PublicInbox::Inbox object
+# - slice - unsigned integer slice number (0..Inf), -1 => latest
+# - salt - pre-auth for APOP
+# - uid_dele - maximum deleted from previous session at login (NNTP ARTICLE)
+# - uid_base - base UID for mailbox slice (0-based) (same as IMAP)
+package PublicInbox::POP3;
+use v5.12;
+use parent qw(PublicInbox::DS);
+use PublicInbox::Syscall qw(EPOLLIN EPOLLONESHOT);
+use PublicInbox::GitAsyncCat;
+use PublicInbox::DS qw(now);
+use Errno qw(EAGAIN);
+use Digest::MD5 qw(md5);
+use PublicInbox::IMAP; # for UID slice stuff
+
+use constant {
+ LINE_MAX => 512, # XXX unsure
+};
+
+# XXX FIXME: duplicated stuff from NNTP.pm and IMAP.pm
+
+sub err ($$;@) {
+ my ($self, $fmt, @args) = @_;
+ printf { $self->{pop3d}->{err} } $fmt."\n", @args;
+}
+
+sub out ($$;@) {
+ my ($self, $fmt, @args) = @_;
+ printf { $self->{pop3d}->{out} } $fmt."\n", @args;
+}
+
+sub zflush {} # noop
+
+sub requeue_once ($) {
+ my ($self) = @_;
+ # 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;
+}
+
+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}:
+ # control passed to ibx_async_cat if $more == \undef
+ requeue_once($self) if !ref($more);
+ } 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 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;
+}
+
+sub _greet ($) {
+ my ($self) = @_;
+ my $s = $self->{salt} = sprintf('%x.%x', int(rand(0x7fffffff)), time);
+ $self->write("+OK POP3 server ready <$s\@public-inbox>\r\n");
+}
+
+sub new ($$$) {
+ my ($class, $sock, $pop3d) = @_;
+ my $self = bless { pop3d => $pop3d }, __PACKAGE__;
+ my $ev = EPOLLIN;
+ my $wbuf;
+ if ($sock->can('accept_SSL') && !$sock->accept_SSL) {
+ return CORE::close($sock) if $! != EAGAIN;
+ $ev = PublicInbox::TLS::epollbit() or return CORE::close($sock);
+ $wbuf = [ \&PublicInbox::DS::accept_tls_step, \&_greet ];
+ }
+ $self->SUPER::new($sock, $ev | EPOLLONESHOT);
+ if ($wbuf) {
+ $self->{wbuf} = $wbuf;
+ } else {
+ _greet($self);
+ }
+ $self;
+}
+
+# POP user is $UUID1@$NEWSGROUP.$SLICE
+sub cmd_user ($$) {
+ my ($self, $mailbox) = @_;
+ $self->{salt} // return \"-ERR already authed\r\n";
+ $mailbox =~ s/\A([a-f0-9\-]+)\@//i or
+ return \"-ERR no UUID@ in mailbox name\r\n";
+ my $user = $1;
+ $user =~ tr/-//d; # most have dashes, some (dbus-uuidgen) don't
+ $user =~ m!\A[a-f0-9]{32}\z!i or return \"-ERR user has no UUID\r\n";
+ my $slice;
+ $mailbox =~ s/\.([0-9]+)\z// and $slice = $1 + 0;
+ my $ibx = $self->{pop3d}->{pi_cfg}->lookup_newsgroup($mailbox) //
+ return \"-ERR $mailbox does not exist\r\n";
+ my $uidmax = $ibx->mm(1)->num_highwater // 0;
+ if (defined $slice) {
+ my $max = int($uidmax / PublicInbox::IMAP::UID_SLICE);
+ my $tip = "$mailbox.$max";
+ return \"-ERR $mailbox.$slice does not exist ($tip does)\r\n"
+ if $slice > $max;
+ $self->{uid_base} = $slice * PublicInbox::IMAP::UID_SLICE;
+ $self->{slice} = $slice;
+ } else { # latest 50K messages
+ my $base = $uidmax - PublicInbox::IMAP::UID_SLICE;
+ $self->{uid_base} = $base < 0 ? 0 : $base;
+ $self->{slice} = -1;
+ }
+ $self->{ibx} = $ibx;
+ $self->{uuid} = pack('H*', $user); # deleted by _login_ok
+ $slice //= '(latest)';
+ \"+OK $ibx->{newsgroup} slice=$slice selected\r\n";
+}
+
+sub _login_ok ($) {
+ my ($self) = @_;
+ if ($self->{pop3d}->lock_mailbox($self)) {
+ $self->{uid_max} = $self->{ibx}->over(1)->max;
+ \"+OK logged in\r\n";
+ } else {
+ \"-ERR unable to lock maildrop\r\n";
+ }
+}
+
+sub cmd_apop {
+ my ($self, $mailbox, $hex) = @_;
+ my $res = cmd_user($self, $mailbox); # sets {uuid}
+ return $res if substr($$res, 0, 1) eq '-';
+ my $s = delete($self->{salt}) // die 'BUG: salt missing';
+ return _login_ok($self) if md5("<$s\@public-inbox>anonymous") eq
+ pack('H*', $hex);
+ $self->{salt} = $s;
+ \"-ERR APOP password mismatch\r\n";
+}
+
+sub cmd_pass {
+ my ($self, $pass) = @_;
+ $self->{ibx} // return \"-ERR mailbox unspecified\r\n";
+ my $s = delete($self->{salt}) // return \"-ERR already authed\r\n";
+ return _login_ok($self) if $pass eq 'anonymous';
+ $self->{salt} = $s;
+ \"-ERR password is not `anonymous'\r\n";
+}
+
+sub cmd_stls {
+ my ($self) = @_;
+ my $sock = $self->{sock} or return;
+ return \"-ERR TLS already enabled\r\n" if $sock->can('stop_SSL');
+ my $opt = $self->{pop3d}->{accept_tls} or
+ return \"-ERR can't start TLS negotiation\r\n";
+ $self->write(\"+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;
+}
+
+sub need_txn ($) {
+ exists($_[0]->{salt}) ? \"-ERR not in TRANSACTION\r\n" : undef;
+}
+
+sub _stat_cache ($) {
+ my ($self) = @_;
+ my ($beg, $end) = (($self->{uid_dele} // -1) + 1, $self->{uid_max});
+ PublicInbox::IMAP::uid_clamp($self, \$beg, \$end);
+ my $opt = { limit => PublicInbox::IMAP::UID_SLICE };
+ my $m = $self->{ibx}->over(1)->do_get(<<'', $opt, $beg, $end);
+SELECT num,ddd FROM over WHERE num >= ? AND num <= ?
+ORDER BY num ASC
+
+ [ map { ($_->{num}, $_->{bytes} + 0, $_->{blob}) } @$m ];
+}
+
+sub cmd_stat {
+ my ($self) = @_;
+ my $err; $err = need_txn($self) and return $err;
+ my $cache = $self->{cache} //= _stat_cache($self);
+ my $tot = 0;
+ for (my $i = 1; $i < scalar(@$cache); $i += 3) { $tot += $cache->[$i] }
+ my $nr = @$cache / 3 - ($self->{nr_dele} // 0);
+ "+OK $nr $tot\r\n";
+}
+
+# for LIST and UIDL
+sub _list {
+ my ($desc, $idx, $self, $msn) = @_;
+ my $err; $err = need_txn($self) and return $err;
+ my $cache = $self->{cache} //= _stat_cache($self);
+ if (defined $msn) {
+ my $base_off = ($msn - 1) * 3;
+ my $val = $cache->[$base_off + $idx] //
+ return \"-ERR no such message\r\n";
+ "+OK $desc listing follows\r\n$msn $val\r\n.\r\n";
+ } else { # always +OK, even if no messages
+ my $res = "+OK $desc listing follows\r\n";
+ my $msn = 0;
+ for (my $i = 0; $i < scalar(@$cache); $i += 3) {
+ ++$msn;
+ defined($cache->[$i]) and
+ $res .= "$msn $cache->[$i + $idx]\r\n";
+ }
+ $res .= ".\r\n";
+ }
+}
+
+sub cmd_list { _list('scan', 1, @_) }
+sub cmd_uidl { _list('unique-id', 2, @_) }
+
+sub mark_dele ($$) {
+ my ($self, $off) = @_;
+ my $base_off = $off * 3;
+ my $cache = $self->{cache};
+ my $uid = $cache->[$base_off] // return; # already deleted
+
+ my $old = $self->{txn_max_uid} //= $uid;
+ $self->{txn_max_uid} = $uid if $uid > $old;
+
+ $cache->[$base_off] = undef; # clobber UID
+ $cache->[$base_off + 1] = 0; # zero bytes (simplifies cmd_stat)
+ $cache->[$base_off + 2] = undef; # clobber oidhex
+ ++$self->{nr_dele};
+}
+
+sub retr_cb { # called by git->cat_async via ibx_async_cat
+ my ($bref, $oid, $type, $size, $args) = @_;
+ my ($self, $off, $top_nr) = @$args;
+ my $hex = $self->{cache}->[$off * 3 + 2] //
+ die "BUG: no hex (oid=$oid)";
+ if (!defined($oid)) {
+ # it's possible to have TOCTOU if an admin runs
+ # public-inbox-(edit|purge), just move onto the next message
+ warn "E: $hex missing in $self->{ibx}->{inboxdir}\n";
+ $self->write(\"-ERR no such message\r\n");
+ return $self->requeue;
+ } elsif ($hex ne $oid) {
+ $self->close;
+ die "BUG: $hex != $oid";
+ }
+ PublicInbox::IMAP::to_crlf_full($bref);
+ if (defined $top_nr) {
+ my ($hdr, $bdy) = split(/\r\n\r\n/, $$bref, 2);
+ $bref = \$hdr;
+ $hdr .= "\r\n\r\n";
+ my @tmp = split(/^/m, $bdy);
+ $hdr .= join('', splice(@tmp, 0, $top_nr));
+ }
+ $$bref =~ s/^\./../gms;
+ $$bref .= substr($$bref, -2, 2) eq "\r\n" ? ".\r\n" : "\r\n.\r\n";
+ $self->msg_more("+OK message follows\r\n");
+ $self->write($bref);
+ $self->{expire} .= pack('S', $off + 1) if exists $self->{expire};
+ $self->requeue;
+}
+
+sub cmd_retr {
+ my ($self, $msn, $top_nr) = @_;
+ return \"-ERR lines must be a non-negative number\r\n" if
+ (defined($top_nr) && $top_nr !~ /\A[0-9]+\z/);
+ my $err; $err = need_txn($self) and return $err;
+ my $cache = $self->{cache} //= _stat_cache($self);
+ my $off = $msn - 1;
+ my $hex = $cache->[$off * 3 + 2] // return \"-ERR no such message\r\n";
+ ${ibx_async_cat($self->{ibx}, $hex, \&retr_cb,
+ [ $self, $off, $top_nr ])};
+}
+
+sub cmd_noop { $_[0]->write(\"+OK\r\n") }
+
+sub cmd_rset {
+ my ($self) = @_;
+ my $err; $err = need_txn($self) and return $err;
+ delete $self->{cache};
+ delete $self->{txn_max_uid};
+ \"+OK\r\n";
+}
+
+sub cmd_dele {
+ my ($self, $msn) = @_;
+ my $err; $err = need_txn($self) and return $err;
+ $self->{cache} //= _stat_cache($self);
+ $msn =~ /\A[1-9][0-9]*\z/ or return \"-ERR no such message\r\n";
+ mark_dele($self, $msn - 1) ? \"+OK\r\n" : \"-ERR no such message\r\n";
+}
+
+# RFC 2449
+sub cmd_capa {
+ my ($self) = @_;
+ $self->{expire} = ''; # "EXPIRE 0" allows clients to avoid DELE commands
+ \<<EOM;
++OK Capability list follows\r
+TOP\r
+USER\r
+PIPELINING\r
+UIDL\r
+EXPIRE 0\r
+.\r
+EOM
+}
+
+sub close {
+ my ($self) = @_;
+ $self->{pop3d}->unlock_mailbox($self);
+ $self->SUPER::close;
+}
+
+sub cmd_quit {
+ my ($self) = @_;
+ if (defined(my $txn_id = $self->{txn_id})) {
+ my $user_id = $self->{user_id} // die 'BUG: no {user_id}';
+ if (my $exp = delete $self->{expire}) {
+ mark_dele($self, $_) for unpack('S*', $exp);
+ }
+ my $dbh = $self->{pop3d}->{-state_dbh};
+ my $lk = $self->{pop3d}->lock_for_scope;
+ my $sth;
+ $dbh->begin_work;
+
+ if (defined $self->{txn_max_uid}) {
+ $sth = $dbh->prepare_cached(<<'');
+UPDATE deletes SET uid_dele = ? WHERE txn_id = ? AND uid_dele < ?
+
+ $sth->execute($self->{txn_max_uid}, $txn_id,
+ $self->{txn_max_uid});
+ }
+ $sth = $dbh->prepare_cached(<<'');
+UPDATE users SET last_seen = ? WHERE user_id = ?
+
+ $sth->execute(time, $user_id);
+ $dbh->commit;
+ }
+ $self->write(\"+OK public-inbox POP3 server signing off\r\n");
+ $self->close;
+ undef;
+}
+
+# returns 1 if we can continue, 0 if not due to buffered writes or disconnect
+sub process_line ($$) {
+ my ($self, $l) = @_;
+ my ($req, @args) = split(/[ \t]+/, $l);
+ return 1 unless defined($req); # skip blank line
+ $req = $self->can('cmd_'.lc($req));
+ my $res = $req ? eval { $req->($self, @args) } :
+ \"-ERR command not recognized\r\n";
+ my $err = $@;
+ if ($err && $self->{sock}) {
+ chomp($l);
+ err($self, 'error from: %s (%s)', $l, $err);
+ $res = \"-ERR program fault - command not performed\r\n";
+ }
+ defined($res) ? $self->write($res) : 0;
+}
+
+# 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->{long_cb};
+
+ # 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 $line = index($$rbuf, "\n");
+ while ($line < 0) {
+ return $self->close if length($$rbuf) >= LINE_MAX;
+ $self->do_read($rbuf, LINE_MAX, length($$rbuf)) or return;
+ $line = index($$rbuf, "\n");
+ }
+ $line = substr($$rbuf, 0, $line + 1, '');
+ $line =~ s/\r?\n\z//s;
+ return $self->close if $line =~ /[[:cntrl:]]/s;
+ my $t0 = now();
+ my $fd = fileno($self->{sock}); # may become invalid after process_line
+ my $r = eval { process_line($self, $line) };
+ my $pending = $self->{wbuf} ? ' pending' : '';
+ out($self, "[$fd] %s - %0.6f$pending - $r", $line, now() - $t0);
+ return $self->close if $r < 0;
+ $self->rbuf_idle($rbuf);
+
+ # maybe there's more pipelined data, or we'll have
+ # to register it for socket-readiness notifications
+ $self->requeue unless $pending;
+}
+
+no warnings 'once';
+*cmd_top = \&cmd_retr;
+
+1;
diff --git a/lib/PublicInbox/POP3D.pm b/lib/PublicInbox/POP3D.pm
new file mode 100644
index 00000000..c7bf1755
--- /dev/null
+++ b/lib/PublicInbox/POP3D.pm
@@ -0,0 +1,231 @@
+# Copyright (C) all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+
+# represents an POP3D (currently a singleton)
+package PublicInbox::POP3D;
+use v5.12;
+use parent qw(PublicInbox::Lock);
+use DBI qw(:sql_types); # SQL_BLOB
+use Carp ();
+use File::Temp 0.19 (); # 0.19 for ->newdir
+use PublicInbox::Config;
+use PublicInbox::POP3;
+use PublicInbox::Syscall;
+use File::Temp 0.19 (); # 0.19 for ->newdir
+use File::FcntlLock;
+use Fcntl qw(F_SETLK F_UNLCK F_WRLCK SEEK_SET);
+
+sub new {
+ my ($cls, $pi_cfg) = @_;
+ $pi_cfg //= PublicInbox::Config->new;
+ my $d = $pi_cfg->{'publicinbox.pop3state'} //
+ die "publicinbox.pop3state undefined\n";
+ -d $d or do {
+ require File::Path;
+ File::Path::make_path($d, { mode => 0700 });
+ PublicInbox::Syscall::nodatacow_dir($d);
+ };
+ bless {
+ err => \*STDERR,
+ out => \*STDOUT,
+ pi_cfg => $pi_cfg,
+ lock_path => "$d/db.lock", # PublicInbox::Lock to protect SQLite
+ # interprocess lock is the $pop3state/txn.locks file
+ # txn_locks => {}, # intraworker locks
+ # accept_tls => { SSL_server => 1, ..., SSL_reuse_ctx => ... }
+ }, $cls;
+}
+
+sub refresh_groups { # PublicInbox::Daemon callback
+ my ($self, $sig) = @_;
+ # TODO share pi_cfg with nntpd/imapd inside -netd
+ my $new = PublicInbox::Config->new;
+ my $old = $self->{pi_cfg};
+ my $s = 'publicinbox.pop3state';
+ $new->{$s} //= $old->{$s};
+ if ($new->{$s} ne $old->{$s}) {
+ warn <<EOM;
+$s changed: `$old->{$s}' => `$new->{$s}', config reload ignored
+EOM
+ } else {
+ $self->{pi_cfg} = $new;
+ }
+}
+
+# persistent tables
+sub create_state_tables ($$) {
+ my ($self, $dbh) = @_;
+
+ $dbh->do(<<''); # map publicinbox.<name>.newsgroup to integers
+CREATE TABLE IF NOT EXISTS newsgroups (
+ newsgroup_id INTEGER PRIMARY KEY NOT NULL,
+ newsgroup VARBINARY NOT NULL,
+ UNIQUE (newsgroup) )
+
+ # the $NEWSGROUP_NAME.$SLICE_INDEX is part of the POP3 username;
+ # POP3 has no concept of folders/mailboxes like IMAP/JMAP
+ $dbh->do(<<'');
+CREATE TABLE IF NOT EXISTS mailboxes (
+ mailbox_id INTEGER PRIMARY KEY NOT NULL,
+ newsgroup_id INTEGER NOT NULL REFERENCES newsgroups,
+ slice INTEGER NOT NULL, /* -1 for most recent slice */
+ UNIQUE (newsgroup_id, slice) )
+
+ $dbh->do(<<''); # actual users are differentiated by their UUID
+CREATE TABLE IF NOT EXISTS users (
+ user_id INTEGER PRIMARY KEY NOT NULL,
+ uuid VARBINARY NOT NULL,
+ last_seen INTEGER NOT NULL, /* to expire idle accounts */
+ UNIQUE (uuid) )
+
+ # we only track the highest-numbered deleted message per-UUID@mailbox
+ $dbh->do(<<'');
+CREATE TABLE IF NOT EXISTS deletes (
+ txn_id INTEGER PRIMARY KEY NOT NULL, /* -1 == txn lock offset */
+ user_id INTEGER NOT NULL REFERENCES users,
+ mailbox_id INTEGER NOT NULL REFERENCES mailboxes,
+ uid_dele INTEGER NOT NULL DEFAULT -1, /* IMAP UID, NNTP article */
+ UNIQUE(user_id, mailbox_id) )
+
+}
+
+sub state_dbh_new {
+ my ($self) = @_;
+ my $f = "$self->{pi_cfg}->{'publicinbox.pop3state'}/db.sqlite3";
+ my $creat = !-s $f;
+ if ($creat) {
+ open my $fh, '+>>', $f or Carp::croak "open($f): $!";
+ PublicInbox::Syscall::nodatacow_fh($fh);
+ }
+
+ my $dbh = DBI->connect("dbi:SQLite:dbname=$f",'','', {
+ AutoCommit => 1,
+ RaiseError => 1,
+ PrintError => 0,
+ sqlite_use_immediate_transaction => 1,
+ sqlite_see_if_its_a_number => 1,
+ });
+ $dbh->do('PRAGMA journal_mode = WAL') if $creat;
+ $dbh->do('PRAGMA foreign_keys = ON'); # don't forget this
+
+ # ensure the interprocess fcntl lock file exists
+ $f = "$self->{pi_cfg}->{'publicinbox.pop3state'}/txn.locks";
+ open my $fh, '+>>', $f or Carp::croak("open($f): $!");
+ $self->{txn_fh} = $fh;
+
+ create_state_tables($self, $dbh);
+ $dbh;
+}
+
+sub lock_mailbox {
+ my ($self, $pop3) = @_; # pop3 - PublicInbox::POP3 client object
+ my $lk = $self->lock_for_scope; # lock the SQLite DB, only
+ my $dbh = $self->{-state_dbh} //= state_dbh_new($self);
+ my ($user_id, $ngid, $mbid, $txn_id);
+ my $uuid = delete $pop3->{uuid};
+ $dbh->begin_work;
+
+ # 1. make sure the user exists, update `last_seen'
+ my $sth = $dbh->prepare_cached(<<'');
+INSERT OR IGNORE INTO users (uuid, last_seen) VALUES (?,?)
+
+ $sth->bind_param(1, $uuid, SQL_BLOB);
+ $sth->bind_param(2, time);
+ if ($sth->execute == 0) { # existing user
+ $sth = $dbh->prepare_cached(<<'', undef, 1);
+SELECT user_id FROM users WHERE uuid = ?
+
+ $sth->bind_param(1, $uuid, SQL_BLOB);
+ $sth->execute;
+ $user_id = $sth->fetchrow_array //
+ die 'BUG: user '.unpack('H*', $uuid).' not found';
+ $sth = $dbh->prepare_cached(<<'');
+UPDATE users SET last_seen = ? WHERE user_id = ?
+
+ $sth->execute(time, $user_id);
+ } else { # new user
+ $user_id = $dbh->last_insert_id(undef, undef,
+ 'users', 'user_id')
+ }
+
+ # 2. make sure the newsgroup has an integer ID
+ $sth = $dbh->prepare_cached(<<'');
+INSERT OR IGNORE INTO newsgroups (newsgroup) VALUES (?)
+
+ my $ng = $pop3->{ibx}->{newsgroup};
+ $sth->bind_param(1, $ng, SQL_BLOB);
+ if ($sth->execute == 0) {
+ $sth = $dbh->prepare_cached(<<'', undef, 1);
+SELECT newsgroup_id FROM newsgroups WHERE newsgroup = ?
+
+ $sth->bind_param(1, $ng, SQL_BLOB);
+ $sth->execute;
+ $ngid = $sth->fetchrow_array // die "BUG: `$ng' not found";
+ } else {
+ $ngid = $dbh->last_insert_id(undef, undef,
+ 'newsgroups', 'newsgroup_id');
+ }
+
+ # 3. ensure the mailbox exists
+ $sth = $dbh->prepare_cached(<<'');
+INSERT OR IGNORE INTO mailboxes (newsgroup_id, slice) VALUES (?,?)
+
+ if ($sth->execute($ngid, $pop3->{slice}) == 0) {
+ $sth = $dbh->prepare_cached(<<'', undef, 1);
+SELECT mailbox_id FROM mailboxes WHERE newsgroup_id = ? AND slice = ?
+
+ $sth->execute($ngid, $pop3->{slice});
+ $mbid = $sth->fetchrow_array //
+ die "BUG: mailbox_id for $ng.$pop3->{slice} not found";
+ } else {
+ $mbid = $dbh->last_insert_id(undef, undef,
+ 'mailboxes', 'mailbox_id');
+ }
+
+ # 4. ensure the (max) deletes row exists for locking
+ $sth = $dbh->prepare_cached(<<'');
+INSERT OR IGNORE INTO deletes (user_id,mailbox_id) VALUES (?,?)
+
+ if ($sth->execute($user_id, $mbid) == 0) {
+ $sth = $dbh->prepare_cached(<<'', undef, 1);
+SELECT txn_id,uid_dele FROM deletes WHERE user_id = ? AND mailbox_id = ?
+
+ $sth->execute($user_id, $mbid);
+ ($txn_id, $pop3->{uid_dele}) = $sth->fetchrow_array;
+ } else {
+ $txn_id = $dbh->last_insert_id(undef, undef,
+ 'deletes', 'txn_id');
+ }
+ $dbh->commit;
+
+ # see if it's locked by the same worker:
+ return if $self->{txn_locks}->{$txn_id};
+
+ # see if it's locked by another worker:
+ my $fs = File::FcntlLock->new;
+ $fs->l_type(F_WRLCK);
+ $fs->l_whence(SEEK_SET);
+ $fs->l_start($txn_id - 1);
+ $fs->l_len(1);
+ $fs->lock($self->{txn_fh}, F_SETLK) or return;
+
+ $pop3->{user_id} = $user_id;
+ $pop3->{txn_id} = $txn_id;
+ $self->{txn_locks}->{$txn_id} = 1;
+}
+
+sub unlock_mailbox {
+ my ($self, $pop3) = @_;
+ my $txn_id = delete($pop3->{txn_id}) // return;
+ delete $self->{txn_locks}->{$txn_id}; # same worker
+
+ # other workers
+ my $fs = File::FcntlLock->new;
+ $fs->l_type(F_UNLCK);
+ $fs->l_whence(SEEK_SET);
+ $fs->l_start($txn_id - 1);
+ $fs->l_len(1);
+ $fs->lock($self->{txn_fh}, F_SETLK) or die "F_UNLCK: $!";
+}
+
+1;
diff --git a/script/public-inbox-pop3d b/script/public-inbox-pop3d
new file mode 100755
index 00000000..ec944aee
--- /dev/null
+++ b/script/public-inbox-pop3d
@@ -0,0 +1,8 @@
+#!perl -w
+# Copyright (C) all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+#
+# Standalone POP3 server for public-inbox.
+use v5.12;
+use PublicInbox::Daemon;
+PublicInbox::Daemon::run('pop3://0.0.0.0:110');
diff --git a/t/pop3d.t b/t/pop3d.t
new file mode 100644
index 00000000..d5ccb0d8
--- /dev/null
+++ b/t/pop3d.t
@@ -0,0 +1,287 @@
+#!perl -w
+# Copyright (C) all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+use v5.12;
+use PublicInbox::TestCommon;
+use Socket qw(IPPROTO_TCP SOL_SOCKET);
+# Net::POP3 is part of the standard library, but distros may split it off...
+require_mods(qw(DBD::SQLite Net::POP3 IO::Socket::SSL File::FcntlLock));
+require_git('2.6'); # for v2
+use_ok 'IO::Socket::SSL';
+use_ok 'PublicInbox::TLS';
+my ($tmpdir, $for_destroy) = tmpdir();
+mkdir("$tmpdir/p3state") or xbail "mkdir: $!";
+my $err = "$tmpdir/stderr.log";
+my $out = "$tmpdir/stdout.log";
+my $olderr = "$tmpdir/plain.err";
+my $group = 'test-pop3';
+my $addr = $group . '@example.com';
+my $stls = tcp_server();
+my $plain = tcp_server();
+my $pop3s = tcp_server();
+my $patch = eml_load('t/data/0001.patch');
+my $ibx = create_inbox 'pop3d', version => 2, -primary_address => $addr,
+ indexlevel => 'basic', sub {
+ my ($im, $ibx) = @_;
+ $im->add(eml_load('t/plack-qp.eml')) or BAIL_OUT '->add';
+ $im->add($patch) or BAIL_OUT '->add';
+};
+my $pi_config = "$tmpdir/pi_config";
+open my $fh, '>', $pi_config or BAIL_OUT "open: $!";
+print $fh <<EOF or BAIL_OUT "print: $!";
+[publicinbox]
+ pop3state = $tmpdir/p3state
+[publicinbox "pop3"]
+ inboxdir = $ibx->{inboxdir}
+ address = $addr
+ indexlevel = basic
+ newsgroup = $group
+EOF
+close $fh or BAIL_OUT "close: $!\n";
+
+my $pop3s_addr = tcp_host_port($pop3s);
+my $stls_addr = tcp_host_port($stls);
+my $plain_addr = tcp_host_port($plain);
+my $env = { PI_CONFIG => $pi_config };
+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/";
+}
+
+my $old = start_script(['-pop3d', '-W0',
+ "--stdout=$tmpdir/plain.out", "--stderr=$olderr" ],
+ $env, { 3 => $plain });
+my @old_args = ($plain->sockhost, Port => $plain->sockport);
+my $oldc = Net::POP3->new(@old_args);
+my $locked_mb = ('e'x32)."\@$group";
+ok($oldc->apop("$locked_mb.0", 'anonymous'), 'APOP to old');
+
+{ # locking within the same process
+ my $x = Net::POP3->new(@old_args);
+ ok(!$x->apop("$locked_mb.0", 'anonymous'), 'APOP lock failure');
+ like($x->message, qr/unable to lock/, 'diagnostic message');
+
+ $x = Net::POP3->new(@old_args);
+ ok($x->apop($locked_mb, 'anonymous'), 'APOP lock acquire');
+
+ my $y = Net::POP3->new(@old_args);
+ ok(!$y->apop($locked_mb, 'anonymous'), 'APOP lock fails once');
+
+ undef $x;
+ $y = Net::POP3->new(@old_args);
+ ok($y->apop($locked_mb, 'anonymous'), 'APOP lock works after release');
+}
+
+for my $args (
+ [ "--cert=$cert", "--key=$key",
+ "-lpop3s://$pop3s_addr",
+ "-lpop3://$stls_addr" ],
+) {
+ for ($out, $err) { open my $fh, '>', $_ or BAIL_OUT "truncate: $!" }
+ my $cmd = [ '-netd', '-W0', @$args, "--stdout=$out", "--stderr=$err" ];
+ my $td = start_script($cmd, $env, { 3 => $stls, 4 => $pop3s });
+
+ 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($pop3s, 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());
+ }
+
+ my @p3s_args = ($pop3s->sockhost,
+ Port => $pop3s->sockport, SSL => 1, %o);
+ my $p3s = Net::POP3->new(@p3s_args);
+ ok($p3s->quit, 'QUIT works w/POP3S');
+ {
+ $p3s = Net::POP3->new(@p3s_args);
+ ok(!$p3s->apop("$locked_mb.0", 'anonymous'),
+ 'APOP lock failure w/ another daemon');
+ like($p3s->message, qr/unable to lock/, 'diagnostic message');
+ }
+
+ # 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');
+ my @np3_args = ($stls->sockhost, Port => $stls->sockport);
+ my $np3 = Net::POP3->new(@np3_args);
+ ok($np3->quit, 'plain QUIT works');
+ $np3 = Net::POP3->new(@np3_args, %o);
+ ok($np3->starttls, 'STLS works');
+ ok($np3->quit, 'QUIT works after STLS');
+
+ for my $mailbox (('x'x32)."\@$group", $group, ('a'x32)."\@z.$group") {
+ $np3 = Net::POP3->new(@np3_args);
+ ok(!$np3->user($mailbox), "USER $mailbox reject");
+ ok($np3->quit, 'QUIT after USER fail');
+
+ $np3 = Net::POP3->new(@np3_args);
+ ok(!$np3->apop($mailbox, 'anonymous'), "APOP $mailbox reject");
+ ok($np3->quit, "QUIT after APOP fail $mailbox");
+ }
+ for my $mailbox ($group, "$group.0") {
+ my $u = ('f'x32)."\@$mailbox";
+ $np3 = Net::POP3->new(@np3_args);
+ ok($np3->user($u), "UUID\@$mailbox accept");
+ ok($np3->pass('anonymous'), 'pass works');
+
+ $np3 = Net::POP3->new(@np3_args);
+ ok($np3->user($u), "UUID\@$mailbox accept");
+ ok($np3->pass('anonymous'), 'pass works');
+
+ my $list = $np3->list;
+ my $uidl = $np3->uidl;
+ is_deeply([sort keys %$list], [sort keys %$uidl],
+ 'LIST and UIDL keys match');
+ ok($_ > 0, 'bytes in LIST result') for values %$list;
+ like($_, qr/\A[a-z0-9]{40,}\z/,
+ 'blob IDs in UIDL result') for values %$uidl;
+
+ $np3 = Net::POP3->new(@np3_args);
+ ok(!$np3->apop($u, 'anonumuss'), 'APOP wrong pass reject');
+
+ $np3 = Net::POP3->new(@np3_args);
+ ok($np3->apop($u, 'anonymous'), "APOP UUID\@$mailbox");
+ my @res = $np3->popstat;
+ is($res[0], 2, 'STAT knows about 2 messages');
+
+ my $msg = $np3->get(2);
+ $msg = join('', @$msg);
+ $msg =~ s/\r\n/\n/g;
+ is_deeply(PublicInbox::Eml->new($msg), $patch,
+ 't/data/0001.patch round-tripped');
+
+ ok(!$np3->get(22), 'missing message');
+
+ $msg = $np3->top(2, 0);
+ $msg = join('', @$msg);
+ $msg =~ s/\r\n/\n/g;
+ is($msg, $patch->header_obj->as_string . "\n",
+ 'TOP numlines=0');
+
+ ok(!$np3->top(2, -1), 'negative TOP numlines');
+
+ $msg = $np3->top(2, 1);
+ $msg = join('', @$msg);
+ $msg =~ s/\r\n/\n/g;
+ is($msg, $patch->header_obj->as_string . <<EOF,
+
+Filenames within a project tend to be reasonably stable within a
+EOF
+ 'TOP numlines=1');
+
+ $msg = $np3->top(2, 10000);
+ $msg = join('', @$msg);
+ $msg =~ s/\r\n/\n/g;
+ is_deeply(PublicInbox::Eml->new($msg), $patch,
+ 'TOP numlines=10000 (excess)');
+
+ $np3 = Net::POP3->new(@np3_args, %o);
+ ok($np3->starttls, 'STLS works before APOP');
+ ok($np3->apop($u, 'anonymous'), "APOP UUID\@$mailbox w/ STLS");
+
+ # undocumented:
+ ok($np3->_NOOP, 'NOOP works') if $np3->can('_NOOP');
+ }
+
+ SKIP: {
+ skip 'TCP_DEFER_ACCEPT is Linux-only', 2 if $^O ne 'linux';
+ my $var = eval { Socket::TCP_DEFER_ACCEPT() } // 9;
+ my $x = getsockopt($pop3s, IPPROTO_TCP, $var) //
+ xbail "IPPROTO_TCP: $!";
+ ok(unpack('i', $x) > 0, 'TCP_DEFER_ACCEPT set on POP3S');
+ $x = getsockopt($stls, IPPROTO_TCP, $var) //
+ xbail "IPPROTO_TCP: $!";
+ is(unpack('i', $x), 0, 'TCP_DEFER_ACCEPT is 0 on plain POP3');
+ };
+ SKIP: {
+ skip 'SO_ACCEPTFILTER is FreeBSD-only', 2 if $^O ne 'freebsd';
+ system('kldstat -m accf_data >/dev/null') and
+ skip 'accf_data not loaded? kldload accf_data', 2;
+ require PublicInbox::Daemon;
+ my $x = getsockopt($pop3s, SOL_SOCKET,
+ $PublicInbox::Daemon::SO_ACCEPTFILTER);
+ like($x, qr/\Adataready\0+\z/, 'got dataready accf for pop3s');
+ $x = getsockopt($stls, IPPROTO_TCP,
+ $PublicInbox::Daemon::SO_ACCEPTFILTER);
+ is($x, undef, 'no BSD accept filter for plain IMAP');
+ };
+
+ $td->kill;
+ $td->join;
+ is($?, 0, 'no error in exited -netd');
+ open my $fh, '<', $err or BAIL_OUT "open $err failed: $!";
+ my $eout = do { local $/; <$fh> };
+ unlike($eout, qr/wide/i, 'no Wide character warnings in -netd');
+}
+
+{
+ my $capa = $oldc->capa;
+ ok(defined($capa->{PIPELINING}), 'pipelining supported by CAPA');
+ is($capa->{EXPIRE}, 0, 'EXPIRE 0 set');
+
+ # clients which see "EXPIRE 0" can elide DELE requests
+ my $list = $oldc->list;
+ ok($oldc->get($_), "RETR $_") for keys %$list;
+ ok($oldc->quit, 'QUIT after RETR');
+
+ $oldc = Net::POP3->new(@old_args);
+ ok($oldc->apop("$locked_mb.0", 'anonymous'), 'APOP reconnect');
+ my $cont = $oldc->list;
+ is_deeply($cont, {}, 'no messages after implicit DELE from EXPIRE 0');
+ ok($oldc->quit, 'QUIT on noop');
+
+ # test w/o checking CAPA to trigger EXPIRE 0
+ $oldc = Net::POP3->new(@old_args);
+ ok($oldc->apop($locked_mb, 'anonymous'), 'APOP on latest slice');
+ my $l2 = $oldc->list;
+ is_deeply($l2, $list, 'different mailbox, different deletes');
+ ok($oldc->get($_), "RETR $_") for keys %$list;
+ ok($oldc->quit, 'QUIT w/o EXPIRE nor DELE');
+
+ $oldc = Net::POP3->new(@old_args);
+ ok($oldc->apop($locked_mb, 'anonymous'), 'APOP again on latest');
+ $l2 = $oldc->list;
+ is_deeply($l2, $list, 'no DELE nor EXPIRE preserves messages');
+ ok($oldc->delete(2), 'explicit DELE on latest');
+ ok($oldc->quit, 'QUIT w/ highest DELE');
+
+ # this is non-standard behavior, but necessary if we expect hundreds
+ # of thousands of users on cheap HW
+ $oldc = Net::POP3->new(@old_args);
+ ok($oldc->apop($locked_mb, 'anonymous'), 'APOP yet again on latest');
+ is_deeply($oldc->list, {}, 'highest DELE deletes older messages, too');
+}
+
+# TODO: more tests, but mpop was really helpful in helping me
+# figure out bugs with larger newsgroups (>50K messages) which
+# probably isn't suited for this test suite.
+
+$old->kill;
+$old->join;
+is($?, 0, 'no error in exited -pop3d');
+open $fh, '<', $olderr or BAIL_OUT "open $olderr failed: $!";
+my $eout = do { local $/; <$fh> };
+unlike($eout, qr/wide/i, 'no Wide character warnings in -pop3d');
+
+done_testing;
^ permalink raw reply related [flat|nested] 10+ messages in thread
* [PATCH v2 2/5] pop3: implement IN-USE from RESP-CODES (RFC 2449)
2022-07-20 9:24 ` [PATCH v2 0/5] public-inbox POP3 daemon Eric Wong
2022-07-20 9:24 ` [PATCH v2 1/5] public-inbox-pop3d - a mostly read-only POP3 server Eric Wong
@ 2022-07-20 9:24 ` Eric Wong
2022-07-20 9:24 ` [PATCH v2 3/5] pop3: TOP requests do not expire messages Eric Wong
` (2 subsequent siblings)
4 siblings, 0 replies; 10+ messages in thread
From: Eric Wong @ 2022-07-20 9:24 UTC (permalink / raw)
To: meta
This may help clients communicate to users if they're
making parallel connections or if we have server bugs.
---
lib/PublicInbox/POP3.pm | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/lib/PublicInbox/POP3.pm b/lib/PublicInbox/POP3.pm
index 86123563..51c2b71a 100644
--- a/lib/PublicInbox/POP3.pm
+++ b/lib/PublicInbox/POP3.pm
@@ -176,7 +176,7 @@ sub _login_ok ($) {
$self->{uid_max} = $self->{ibx}->over(1)->max;
\"+OK logged in\r\n";
} else {
- \"-ERR unable to lock maildrop\r\n";
+ \"-ERR [IN-USE] unable to lock maildrop\r\n";
}
}
@@ -350,6 +350,7 @@ USER\r
PIPELINING\r
UIDL\r
EXPIRE 0\r
+RESP-CODES\r
.\r
EOM
}
^ permalink raw reply related [flat|nested] 10+ messages in thread
* [PATCH v2 3/5] pop3: TOP requests do not expire messages
2022-07-20 9:24 ` [PATCH v2 0/5] public-inbox POP3 daemon Eric Wong
2022-07-20 9:24 ` [PATCH v2 1/5] public-inbox-pop3d - a mostly read-only POP3 server Eric Wong
2022-07-20 9:24 ` [PATCH v2 2/5] pop3: implement IN-USE from RESP-CODES (RFC 2449) Eric Wong
@ 2022-07-20 9:24 ` Eric Wong
2022-07-20 9:24 ` [PATCH v2 4/5] netd: setup TLS bits for well-known STARTTLS ports Eric Wong
2022-07-20 9:24 ` [PATCH v2 5/5] pop3: advertise STLS in CAPA if appropriate Eric Wong
4 siblings, 0 replies; 10+ messages in thread
From: Eric Wong @ 2022-07-20 9:24 UTC (permalink / raw)
To: meta
RFC 2449 only documents "EXPIRE 0" behavior for RETR requests
which fetch the whole message. TOP requests only fetch
the headers and top $N lines of the body, so it's probably
harmful for deletions to be triggered in those cases.
---
lib/PublicInbox/POP3.pm | 3 ++-
t/pop3d.t | 11 ++++++++++-
2 files changed, 12 insertions(+), 2 deletions(-)
diff --git a/lib/PublicInbox/POP3.pm b/lib/PublicInbox/POP3.pm
index 51c2b71a..2c20c84b 100644
--- a/lib/PublicInbox/POP3.pm
+++ b/lib/PublicInbox/POP3.pm
@@ -300,12 +300,13 @@ sub retr_cb { # called by git->cat_async via ibx_async_cat
$hdr .= "\r\n\r\n";
my @tmp = split(/^/m, $bdy);
$hdr .= join('', splice(@tmp, 0, $top_nr));
+ } elsif (exists $self->{expire}) {
+ $self->{expire} .= pack('S', $off + 1);
}
$$bref =~ s/^\./../gms;
$$bref .= substr($$bref, -2, 2) eq "\r\n" ? ".\r\n" : "\r\n.\r\n";
$self->msg_more("+OK message follows\r\n");
$self->write($bref);
- $self->{expire} .= pack('S', $off + 1) if exists $self->{expire};
$self->requeue;
}
diff --git a/t/pop3d.t b/t/pop3d.t
index d5ccb0d8..3d70935f 100644
--- a/t/pop3d.t
+++ b/t/pop3d.t
@@ -240,8 +240,17 @@ EOF
ok(defined($capa->{PIPELINING}), 'pipelining supported by CAPA');
is($capa->{EXPIRE}, 0, 'EXPIRE 0 set');
- # clients which see "EXPIRE 0" can elide DELE requests
+ # ensure TOP doesn't trigger "EXPIRE 0" like RETR does (cf. RFC2449)
my $list = $oldc->list;
+ ok(scalar keys %$list, 'got a listing of messages');
+ ok($oldc->top($_, 1), "TOP $_ 1") for keys %$list;
+ ok($oldc->quit, 'QUIT after TOP');
+
+ # clients which see "EXPIRE 0" can elide DELE requests
+ $oldc = Net::POP3->new(@old_args);
+ ok($oldc->apop("$locked_mb.0", 'anonymous'), 'APOP for RETR');
+ is_deeply($oldc->capa, $capa, 'CAPA unchanged');
+ is_deeply($oldc->list, $list, 'LIST unchanged by previous TOP');
ok($oldc->get($_), "RETR $_") for keys %$list;
ok($oldc->quit, 'QUIT after RETR');
^ permalink raw reply related [flat|nested] 10+ messages in thread
* [PATCH v2 4/5] netd: setup TLS bits for well-known STARTTLS ports
2022-07-20 9:24 ` [PATCH v2 0/5] public-inbox POP3 daemon Eric Wong
` (2 preceding siblings ...)
2022-07-20 9:24 ` [PATCH v2 3/5] pop3: TOP requests do not expire messages Eric Wong
@ 2022-07-20 9:24 ` Eric Wong
2022-07-20 9:24 ` [PATCH v2 5/5] pop3: advertise STLS in CAPA if appropriate Eric Wong
4 siblings, 0 replies; 10+ messages in thread
From: Eric Wong @ 2022-07-20 9:24 UTC (permalink / raw)
To: meta
Unfortunately, I can't think of an easy way to test this in
our test suite since binding these ports are privileged and
are often in use, anyways.
---
lib/PublicInbox/Daemon.pm | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/lib/PublicInbox/Daemon.pm b/lib/PublicInbox/Daemon.pm
index fbce9154..bceae6e5 100644
--- a/lib/PublicInbox/Daemon.pm
+++ b/lib/PublicInbox/Daemon.pm
@@ -208,7 +208,7 @@ EOF
$tls_opt{"$scheme://$sockname"} ||= accept_tls_opt('');
} elsif (($scheme = $KNOWN_STARTTLS{$1})) {
$xnetd->{$sockname} = load_mod($scheme);
- next if $tls_opt{"$scheme://$sockname"};
+ $tls_opt{"$scheme://$sockname"} ||= accept_tls_opt('');
$tls_opt{''} ||= accept_tls_opt('');
}
}
^ permalink raw reply related [flat|nested] 10+ messages in thread
* [PATCH v2 5/5] pop3: advertise STLS in CAPA if appropriate
2022-07-20 9:24 ` [PATCH v2 0/5] public-inbox POP3 daemon Eric Wong
` (3 preceding siblings ...)
2022-07-20 9:24 ` [PATCH v2 4/5] netd: setup TLS bits for well-known STARTTLS ports Eric Wong
@ 2022-07-20 9:24 ` Eric Wong
4 siblings, 0 replies; 10+ messages in thread
From: Eric Wong @ 2022-07-20 9:24 UTC (permalink / raw)
To: meta
This is documented in RFC 2595, and POP3 clients may rely on
seeing "STLS" in CAPA output to initiate TLS negotiation.
---
Documentation/standards.perl | 1 +
lib/PublicInbox/POP3.pm | 6 ++++--
t/pop3d.t | 7 +++++++
3 files changed, 12 insertions(+), 2 deletions(-)
diff --git a/Documentation/standards.perl b/Documentation/standards.perl
index 835de3a2..c36afb5d 100755
--- a/Documentation/standards.perl
+++ b/Documentation/standards.perl
@@ -69,6 +69,7 @@ my $rfcs = [
1081 => 'Post Office Protocol – Version 3',
1939 => 'Post Office Protocol – Version 3 (STD 53)',
2449 => 'POP3 extension mechanism',
+ 2595 => 'STARTTLS for IMAP and POP3',
2384 => 'POP URL Scheme',
# TODO: flesh this out
diff --git a/lib/PublicInbox/POP3.pm b/lib/PublicInbox/POP3.pm
index 2c20c84b..ec73893c 100644
--- a/lib/PublicInbox/POP3.pm
+++ b/lib/PublicInbox/POP3.pm
@@ -343,15 +343,17 @@ sub cmd_dele {
# RFC 2449
sub cmd_capa {
my ($self) = @_;
+ my $STLS = !$self->{ibx} && !$self->{sock}->can('stop_SSL') &&
+ $self->{pop3d}->{accept_tls} ? "\nSTLS\r" : '';
$self->{expire} = ''; # "EXPIRE 0" allows clients to avoid DELE commands
- \<<EOM;
+ <<EOM;
+OK Capability list follows\r
TOP\r
USER\r
PIPELINING\r
UIDL\r
EXPIRE 0\r
-RESP-CODES\r
+RESP-CODES\r$STLS
.\r
EOM
}
diff --git a/t/pop3d.t b/t/pop3d.t
index 3d70935f..9eb110d6 100644
--- a/t/pop3d.t
+++ b/t/pop3d.t
@@ -106,6 +106,8 @@ for my $args (
my @p3s_args = ($pop3s->sockhost,
Port => $pop3s->sockport, SSL => 1, %o);
my $p3s = Net::POP3->new(@p3s_args);
+ my $capa = $p3s->capa;
+ ok(!exists $capa->{STLS}, 'no STLS CAPA for POP3S');
ok($p3s->quit, 'QUIT works w/POP3S');
{
$p3s = Net::POP3->new(@p3s_args);
@@ -127,7 +129,11 @@ for my $args (
my $np3 = Net::POP3->new(@np3_args);
ok($np3->quit, 'plain QUIT works');
$np3 = Net::POP3->new(@np3_args, %o);
+ $capa = $np3->capa;
+ ok(exists $capa->{STLS}, 'STLS CAPA advertised before STLS');
ok($np3->starttls, 'STLS works');
+ $capa = $np3->capa;
+ ok(!exists $capa->{STLS}, 'STLS CAPA not advertised after STLS');
ok($np3->quit, 'QUIT works after STLS');
for my $mailbox (('x'x32)."\@$group", $group, ('a'x32)."\@z.$group") {
@@ -239,6 +245,7 @@ EOF
my $capa = $oldc->capa;
ok(defined($capa->{PIPELINING}), 'pipelining supported by CAPA');
is($capa->{EXPIRE}, 0, 'EXPIRE 0 set');
+ ok(!exists $capa->{STLS}, 'STLS unset w/o daemon certs');
# ensure TOP doesn't trigger "EXPIRE 0" like RETR does (cf. RFC2449)
my $list = $oldc->list;
^ permalink raw reply related [flat|nested] 10+ messages in thread
end of thread, other threads:[~2022-07-20 9:24 UTC | newest]
Thread overview: 10+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-07-19 2:49 [PATCH 0/2] preliminary POP3 daemon Eric Wong
2022-07-19 2:49 ` [PATCH 1/2] public-inbox-pop3d - a mostly read-only POP3 server Eric Wong
2022-07-19 2:49 ` [PATCH 2/2] pop3: implement IN-USE from RESP-CODES (RFC 2449) Eric Wong
2022-07-20 7:27 ` [PATCH 3/2] pop3: fix numerous bugs in delete handling Eric Wong
2022-07-20 9:24 ` [PATCH v2 0/5] public-inbox POP3 daemon Eric Wong
2022-07-20 9:24 ` [PATCH v2 1/5] public-inbox-pop3d - a mostly read-only POP3 server Eric Wong
2022-07-20 9:24 ` [PATCH v2 2/5] pop3: implement IN-USE from RESP-CODES (RFC 2449) Eric Wong
2022-07-20 9:24 ` [PATCH v2 3/5] pop3: TOP requests do not expire messages Eric Wong
2022-07-20 9:24 ` [PATCH v2 4/5] netd: setup TLS bits for well-known STARTTLS ports Eric Wong
2022-07-20 9:24 ` [PATCH v2 5/5] pop3: advertise STLS in CAPA if appropriate Eric Wong
Code repositories for project(s) associated with this public 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).