From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on dcvr.yhbt.net X-Spam-Level: X-Spam-ASN: X-Spam-Status: No, score=-4.2 required=3.0 tests=ALL_TRUSTED,BAYES_00, DKIM_SIGNED,DKIM_VALID,DKIM_VALID_AU,DKIM_VALID_EF shortcircuit=no autolearn=ham autolearn_force=no version=3.4.2 Received: from localhost (dcvr.yhbt.net [127.0.0.1]) by dcvr.yhbt.net (Postfix) with ESMTP id 4D50A1F59D; Tue, 19 Jul 2022 02:49:51 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=80x24.org; s=selector1; t=1658198991; bh=bUjL8/DuorTn36Eo3YBjpakj3P10zEagYbkeZZIOBEk=; h=From:To:Subject:Date:In-Reply-To:References:From; b=WfbLsBHpRjonB9sGQb39ORY+WSxYcbgLwrJCyfed5YlRFZ1yXMLPsLfA70ng18cZr WpacAFICkZPbA3tbx817ywdwkQxBkT9zp1znK6N7UufBqOp3u0c0ZUPpsMyBCRCd62 aFMheggc7/Osq943w/wGNMvkVSirsDAHnv3zFwZU= From: Eric Wong To: meta@public-inbox.org Subject: [PATCH 1/2] public-inbox-pop3d - a mostly read-only POP3 server Date: Tue, 19 Jul 2022 02:49:49 +0000 Message-Id: <20220719024950.1831808-2-e@80x24.org> In-Reply-To: <20220719024950.1831808-1-e@80x24.org> References: <20220719024950.1831808-1-e@80x24.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit List-Id: 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 is: C -It also configures the folder hierarchy used by L. +It also configures the folder hierarchy used by L +as well as L Omitting this for a given inbox will prevent the inbox from -being served by L and/or L. +being served by L, +L, and/or L Default: none, optional @@ -226,6 +228,10 @@ L instance. Default: none +=item publicinbox.pop3state + +See L + =item publicinbox..feedmax The size of an Atom feed for the inbox. If specified more than @@ -463,7 +469,7 @@ L =head1 COPYRIGHT -Copyright 2016-2021 all contributors L +Copyright all contributors L License: AGPL-3.0+ L 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 implementations, +but requires additional read-write storage to keep track +of deleted messages on a per-user basis. + +Like L, C 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 (all lower-case). + +Usernames are of the format: + + C<$UUID@$NEWSGROUP_NAME> + +Where C<$UUID> is the output of the L 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, L, or +L. + +To save storage, L only stores +the highest-numbered deleted message + +=head1 OPTIONS + +See common options in L. + +=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, the C prefix (e.g. C or +C) may be specified to force a given protocol. + +For STARTTLS and POP3S support, the C and C 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 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 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, C uses the +same configuration knobs as L, +see L and L. + +=over 8 + +=item publicInbox.pop3state + +A directory containing per-user/mailbox account information; +must be writable to the C process. + +=item publicInbox..newsgroup + +The newsgroup name maps to a POP3 folder name. + +=back + +=head1 CONTACT + +Feedback welcome via plain-text mail to L + +The mail archives are hosted at L, and +L, +L + +=head1 COPYRIGHT + +Copyright all contributors L + +License: AGPL-3.0+ L + +=head1 SEE ALSO + +L, L, L, +L, L, +L 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 +use v5.12; +# Copyright all contributors # License: AGPL-3.0+ print < '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 +Copyright (C) all contributors License: AGPL-3.0+ 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 +# Copyright (C) all contributors # License: AGPL-3.0+ # # 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 +# Copyright (C) all contributors # License: AGPL-3.0+ # # 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 <{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 +# License: AGPL-3.0+ +# +# 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 + \<{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 +# License: AGPL-3.0+ + +# 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 <{$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..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 +# License: AGPL-3.0+ +# +# 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 +# License: AGPL-3.0+ +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 <{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 . <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;