lib/PublicInbox/DSKQXS.pm
lib/PublicInbox/DSPoll.pm
lib/PublicInbox/Daemon.pm
+lib/PublicInbox/DummyInbox.pm
lib/PublicInbox/Emergency.pm
lib/PublicInbox/Eml.pm
lib/PublicInbox/EmlContentFoo.pm
xt/mem-msgview.t
xt/msgtime_cmp.t
xt/nntpd-validate.t
-xt/perf-imap-list.t
xt/perf-msgview.t
xt/perf-nntpd.t
xt/perf-threading.t
$self->{-iter} = [ \$i, $cb, $arg ];
}
-# for PublicInbox::DS::next_tick
+# for PublicInbox::DS::next_tick, we only call this is if
+# PublicInbox::DS is already loaded
sub event_step {
my ($self) = @_;
my ($i, $cb, $arg) = @{$self->{-iter}};
my $section = $self->{-section_order}->[$$i++];
delete($self->{-iter}) unless defined($section);
- $cb->($self, $section, $arg);
+ eval { $cb->($self, $section, $arg) };
+ warn "E: $@ in ${self}::event_step" if $@;
+ PublicInbox::DS::requeue($self) if defined($section);
}
sub lookup_newsgroup {
--- /dev/null
+# Copyright (C) 2020 all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+#
+# An EXAMINE-able, PublicInbox::Inbox-like object for IMAP. Some
+# IMAP clients don't like having unselectable parent mailboxes,
+# so we have a dummy
+package PublicInbox::DummyInbox;
+use strict;
+
+sub created_at { 0 } # Msgmap::created_at
+sub mm { shift }
+sub max { undef } # Msgmap::max
+sub msg_range { [] } # Msgmap::msg_range
+
+no warnings 'once';
+*query_xover = \&msg_range;
+*over = \&mm;
+*subscribe_unlock = *unsubscribe_unlock =
+ *get_art = *description = *base_url = \&max;
+
+1;
"$idle_tag OK Idle done\r\n";
}
-sub ensure_old_ranges_exist ($$$) {
- my ($self, $ibx, $uid_min) = @_;
- my $groups = $self->{imapd}->{groups};
- my $mailbox = $ibx->{newsgroup};
+sub ensure_ranges_exist ($$$) {
+ my ($imapd, $ibx, $max) = @_;
+ my $mailboxes = $imapd->{mailboxes};
+ my $mb_top = $ibx->{newsgroup};
my @created;
- $uid_min -= UID_BLOCK;
+ my $uid_min = UID_BLOCK * int($max/UID_BLOCK) + 1;
my $uid_end = $uid_min + UID_BLOCK - 1;
while ($uid_min > 0) {
- my $sub_mailbox = "$mailbox.$uid_min-$uid_end";
- last if exists $groups->{$sub_mailbox};
- $groups->{$sub_mailbox} = $ibx;
+ my $sub_mailbox = "$mb_top.$uid_min-$uid_end";
+ last if exists $mailboxes->{$sub_mailbox};
+ $mailboxes->{$sub_mailbox} = $ibx;
$uid_end -= UID_BLOCK;
$uid_min -= UID_BLOCK;
push @created, $sub_mailbox;
}
return unless @created;
- my $l = $self->{imapd}->{inboxlist};
- grep {
- / \Q$mailbox\E\r\n\z/ and s/\(\\HasNoChildren/\(\\HasChildren/;
- } @$l;
+ my $l = $imapd->{inboxlist} or return;
push @$l, map { qq[* LIST (\\HasNoChildren) "." $_\r\n] } @created;
}
if ($mailbox =~ /\A(.+)\.([0-9]+)-([0-9]+)\z/) {
# old mail: inbox.comp.foo.$uid_min-$uid_end
my ($mb_top, $uid_min, $uid_end) = ($1, $2 + 0, $3 + 0);
- $ibx = $self->{imapd}->{groups}->{lc $mb_top};
- if (!$ibx || ($uid_end % UID_BLOCK) != 0 ||
- ($uid_min + UID_BLOCK - 1) != $uid_end) {
- return "$tag NO Mailbox doesn't exist: $mailbox\r\n";
- }
- $mm = $ibx->mm;
- $max = $mm->max // 0;
- # don't let users create inboxes w/ not-yet-possible range:
- $uid_min > $max and
+ $ibx = $self->{imapd}->{mailboxes}->{lc $mailbox} or
return "$tag NO Mailbox doesn't exist: $mailbox\r\n";
- $max = $uid_min + UID_BLOCK + 1;
+ $mm = $ibx->mm;
+ $max = $mm->max // 0;
$self->{uid_min} = $uid_min;
- ensure_old_ranges_exist($self, $ibx, $uid_min);
- } else { # current mailbox (most recent UID_BLOCK messages)
- $ibx = $self->{imapd}->{groups}->{lc $mailbox} or
+ ensure_ranges_exist($self->{imapd}, $ibx, $max);
+ $max = $uid_end if $max > $uid_end;
+ } else { # check for dummy inboxes
+ $ibx = $self->{imapd}->{mailboxes}->{lc $mailbox} or
return "$tag NO Mailbox doesn't exist: $mailbox\r\n";
-
+ delete $self->{uid_min};
+ $max = 0;
$mm = $ibx->mm;
- $max = $mm->max // 0;
-
- my $uid_min = UID_BLOCK * int($max/UID_BLOCK) + 1;
- if ($uid_min == 1) { # normal inbox with <UID_BLOCK messages
- delete $self->{uid_min}; # implicit cmd_close
- } else { # we have a giant inbox:
- $self->{uid_min} = $uid_min;
- ensure_old_ranges_exist($self, $ibx, $uid_min);
- }
}
- # RFC 3501 2.3.1.1 - "A good UIDVALIDITY value to use in
- # this case is a 32-bit representation of the creation
- # date/time of the mailbox"
- my $uidvalidity = $mm->created_at or return "$tag BAD UIDVALIDITY\r\n";
my $uidnext = $max + 1;
# XXX: do we need this? RFC 5162/7162
* OK [PERMANENTFLAGS ()] Read-only mailbox\r
* OK [UNSEEN $max]\r
* OK [UIDNEXT $uidnext]\r
-* OK [UIDVALIDITY $uidvalidity]\r
+* OK [UIDVALIDITY $ibx->{uidvalidity}]\r
$tag OK [READ-ONLY] EXAMINE/SELECT done\r
EOF
}
sub cmd_status ($$$;@) {
my ($self, $tag, $mailbox, @items) = @_;
- my $ibx = $self->{imapd}->{groups}->{$mailbox} or
+ my $ibx = $self->{imapd}->{mailboxes}->{$mailbox} or
return "$tag NO Mailbox doesn't exist: $mailbox\r\n";
return "$tag BAD no items\r\n" if !scalar(@items);
($items[0] !~ s/\A\(//s || $items[-1] !~ s/\)\z//s) and
} elsif ($it eq 'UIDNEXT') {
push(@it, ($max //= $mm->max // 0) + 1);
} elsif ($it eq 'UIDVALIDITY') {
- push(@it, $mm->created_at //
- return("$tag BAD UIDVALIDITY\r\n"));
+ push(@it, $ibx->{uidvalidity});
} else {
return "$tag BAD invalid item\r\n";
}
# see script/public-inbox-imapd for how it is used
package PublicInbox::IMAPD;
use strict;
-use parent qw(PublicInbox::NNTPD);
+use PublicInbox::Config;
use PublicInbox::InboxIdle;
use PublicInbox::IMAP;
-# *UID_BLOCK = \&PublicInbox::IMAP::UID_BLOCK;
+use PublicInbox::DummyInbox;
+my $dummy = bless { uidvalidity => 0 }, 'PublicInbox::DummyInbox';
sub new {
my ($class) = @_;
bless {
- groups => {},
+ mailboxes => {},
err => \*STDERR,
out => \*STDOUT,
- grouplist => [],
# accept_tls => { SSL_server => 1, ..., SSL_reuse_ctx => ... }
# pi_config => PublicInbox::Config
# idler => PublicInbox::InboxIdle
}, $class;
}
-sub refresh_inboxlist ($) {
- my ($self) = @_;
- my @names = map { $_->{newsgroup} } @{delete $self->{grouplist}};
- my %ns; # "\Noselect \HasChildren"
-
- if (my @uc = grep(/[A-Z]/, @names)) {
- warn "Uppercase not allowed for IMAP newsgroup(s):\n",
- map { "\t$_\n" } @uc;
- my %uc = map { $_ => 1 } @uc;
- @names = grep { !$uc{$_} } @names;
- }
- for (@names) {
- my $up = $_;
- while ($up =~ s/\.[^\.]+\z//) {
- $ns{$up} = '\\Noselect \\HasChildren';
- }
- }
- @names = map {;
- my $at = delete($ns{$_}) ? '\\HasChildren' : '\\HasNoChildren';
- qq[* LIST ($at) "." $_\r\n]
- } @names;
- push(@names, map { qq[* LIST ($ns{$_}) "." $_\r\n] } keys %ns);
- @names = sort {
- my ($xa) = ($a =~ / (\S+)\r\n/g);
- my ($xb) = ($b =~ / (\S+)\r\n/g);
- length($xa) <=> length($xb);
- } @names;
- $self->{inboxlist} = \@names;
-}
-
sub imapd_refresh_ibx { # pi_config->each_inbox cb
my ($ibx, $imapd) = @_;
my $ngname = $ibx->{newsgroup} or return;
if (ref $ngname) {
warn 'multiple newsgroups not supported: '.
join(', ', @$ngname). "\n";
+ return;
} elsif ($ngname =~ m![^a-z0-9/_\.\-\~\@\+\=:]! ||
$ngname =~ /\.[0-9]+-[0-9]+\z/) {
- warn "mailbox name invalid: `$ngname'\n";
+ warn "mailbox name invalid: newsgroup=`$ngname'\n";
+ return;
}
-
+ $ibx->over or return;
+ $ibx->{over} = undef;
my $mm = $ibx->mm or return;
$ibx->{mm} = undef;
+
+ # RFC 3501 2.3.1.1 - "A good UIDVALIDITY value to use in
+ # this case is a 32-bit representation of the creation
+ # date/time of the mailbox"
defined($ibx->{uidvalidity} = $mm->created_at) or return;
- $imapd->{tmp_groups}->{$ngname} = $ibx;
+ PublicInbox::IMAP::ensure_ranges_exist($imapd, $ibx, $mm->max // 1);
# preload to avoid fragmentation:
$ibx->description;
$ibx->base_url;
- # my $max = $mm->max // 0;
- # my $uid_min = UID_BLOCK * int($max/UID_BLOCK) + 1;
+
+ # ensure dummies are selectable
+ my $dummies = $imapd->{dummies};
+ do {
+ $dummies->{$ngname} = $dummy;
+ } while ($ngname =~ s/\.[^\.]+\z//);
}
sub imapd_refresh_finalize {
my ($imapd, $pi_config) = @_;
- $imapd->{groups} = delete $imapd->{tmp_groups};
- $imapd->{grouplist} = [ values %{$imapd->{groups}} ];
- refresh_inboxlist($imapd);
+ my $mailboxes;
+ if (my $next = delete $imapd->{imapd_next}) {
+ $imapd->{mailboxes} = delete $next->{mailboxes};
+ $mailboxes = delete $next->{dummies};
+ } else {
+ $mailboxes = delete $imapd->{dummies};
+ }
+ %$mailboxes = (%$mailboxes, %{$imapd->{mailboxes}});
+ $imapd->{mailboxes} = $mailboxes;
+ $imapd->{inboxlist} = [
+ map {
+ my $no = $mailboxes->{$_} == $dummy ? '' : 'No';
+ qq[* LIST (\\Has${no}Children) "." $_\r\n]
+ } sort { length($a) <=> length($b) } keys %$mailboxes
+ ];
$imapd->{pi_config} = $pi_config;
if (my $idler = $imapd->{idler}) {
$idler->refresh($pi_config);
if (defined($section)) {
return if $section !~ m!\Apublicinbox\.([^/]+)\z!;
my $ibx = $pi_config->lookup_name($1) or return;
- imapd_refresh_ibx($ibx, $imapd);
- } else { # "EOF"
+ imapd_refresh_ibx($ibx, $imapd->{imapd_next});
+ } else { # undef == "EOF"
imapd_refresh_finalize($imapd, $pi_config);
}
}
sub refresh_groups {
my ($self, $sig) = @_;
my $pi_config = PublicInbox::Config->new;
- $self->{tmp_groups} = {};
- if (0 && $sig) { # SIGHUP
+ if ($sig) { # SIGHUP is handled through the event loop
+ $self->{imapd_next} = { dummies => {}, mailboxes => {} };
$pi_config->iterate_start(\&imapd_refresh_step, $self);
PublicInbox::DS::requeue($pi_config); # call event_step
- } else { # initial start
+ } else { # initial start is synchronous
+ $self->{dummies} = {};
$pi_config->each_inbox(\&imapd_refresh_ibx, $self);
imapd_refresh_finalize($self, $pi_config);
}
use Test::More;
use PublicInbox::IMAP;
use PublicInbox::IMAPD;
+use PublicInbox::TestCommon;
+require_mods(qw(DBD::SQLite));
+require_git 2.6;
-{ # make sure we get '%' globbing right
+my ($tmpdir, $for_destroy) = tmpdir();
+my $cfgfile = "$tmpdir/config";
+{
+ open my $fh, '>', $cfgfile or BAIL_OUT $!;
+ print $fh <<EOF or BAIL_OUT $!;
+[publicinbox "a"]
+ inboxdir = $tmpdir/a
+ newsgroup = x.y.z
+[publicinbox "b"]
+ inboxdir = $tmpdir/b
+ newsgroup = x.z.y
+[publicinbox "c"]
+ inboxdir = $tmpdir/c
+ newsgroup = IGNORE.THIS
+EOF
+ close $fh or BAIL_OUT $!;
+ local $ENV{PI_CONFIG} = $cfgfile;
+ for my $x (qw(a b c)) {
+ ok(run_script(['-init', '-Lbasic', '-V2', $x, "$tmpdir/$x",
+ "https://example.com/$x", "$x\@example.com"]),
+ "init $x");
+ }
+ my $imapd = PublicInbox::IMAPD->new;
my @w;
local $SIG{__WARN__} = sub { push @w, @_ };
- my @n = map { { newsgroup => $_ } } (qw(x.y.z x.z.y IGNORE.THIS));
- my $self = { imapd => { grouplist => \@n } };
- PublicInbox::IMAPD::refresh_inboxlist($self->{imapd});
+ $imapd->refresh_groups;
+ my $self = { imapd => $imapd };
is(scalar(@w), 1, 'got a warning for upper-case');
like($w[0], qr/IGNORE\.THIS/, 'warned about upper-case');
-
my $res = PublicInbox::IMAP::cmd_list($self, 'tag', 'x', '%');
is(scalar($$res =~ tr/\n/\n/), 2, 'only one result');
like($$res, qr/ x\r\ntag OK/, 'saw expected');
$imap_client = 'PublicInbox::IMAPClient';
}
+require_ok 'PublicInbox::IMAP';
+my $first_range = '1-'.PublicInbox::IMAP::UID_BLOCK();
+
my $level = '-Lbasic';
SKIP: {
require_mods('Search::Xapian', 1);
like($e, qr/\bNO\b/, 'got a NO on EXAMINE for non-existent');
ok(!$mic->select('foo') && ($e = $@), 'EXAMINE non-existent');
like($e, qr/\bNO\b/, 'got a NO on EXAMINE for non-existent');
-ok($mic->select('inbox.i1'), 'SELECT succeeds');
-ok($mic->examine('INBOX.i1'), 'EXAMINE succeeds');
-my @raw = $mic->status('inbox.i1', qw(Messages uidnext uidvalidity));
+my $mailbox1 = "inbox.i1.$first_range";
+ok($mic->select('inbox.i1'), 'SELECT on parent succeeds');
+ok($mic->select($mailbox1), 'SELECT succeeds');
+ok($mic->examine($mailbox1), 'EXAMINE succeeds');
+my @raw = $mic->status($mailbox1, qw(Messages uidnext uidvalidity));
is(scalar(@raw), 2, 'got status response');
-like($raw[0], qr/\A\*\x20STATUS\x20inbox\.i1\x20
+like($raw[0], qr/\A\*\x20STATUS\x20inbox\.i1\.$first_range\x20
\(MESSAGES\x20\d+\x20UIDNEXT\x20\d+\x20UIDVALIDITY\x20\d+\)\r\n/sx);
like($raw[1], qr/\A\S+ OK /, 'finished status response');
like($raw[0], qr/^\* LIST \(.*?\) "\." inbox/,
'got an inbox');
like($raw[-1], qr/^\S+ OK /, 'response ended with OK');
-is(scalar(@raw), scalar(@V) + 2, 'default LIST response');
+is(scalar(@raw), scalar(@V) + 4, 'default LIST response');
@raw = $mic->list('', 'inbox.i1');
is(scalar(@raw), 2, 'limited LIST response');
like($raw[0], qr/^\* LIST \(.*?\) "\." inbox/,
skip 'Mail::IMAPClient too old for ->compress', 2 if !$can_compress;
my $c = $imap_client->new(%mic_opt);
ok($c && $c->compress, 'compress enabled');
- ok($c->examine('inbox.i1'), 'EXAMINE succeeds after COMPRESS');
+ ok($c->examine($mailbox1), 'EXAMINE succeeds after COMPRESS');
$ret = $c->search('uid 1:*') or BAIL_OUT "SEARCH FAIL $@";
is_deeply($ret, [ 1 ], 'search UID 1:* works after compression');
}
my $ng = $ibx->{newsgroup};
my $mic = $imap_client->new(%mic_opt);
ok($mic && $mic->login && $mic->IsAuthenticated, "authed $name");
- my $uidnext = $mic->uidnext($ng); # we'll fetch BODYSTRUCTURE on this
+ my $mb = "$ng.$first_range";
+ my $uidnext = $mic->uidnext($mb); # we'll fetch BODYSTRUCTURE on this
ok($uidnext, 'got uidnext for later fetch');
is_deeply([$mic->has_capability('IDLE')], ['IDLE'], "IDLE capa $name");
ok(!$mic->idle, "IDLE fails w/o SELECT/EXAMINE $name");
- ok($mic->examine($ng), "EXAMINE $ng succeeds");
+ ok($mic->examine($mb), "EXAMINE $ng succeeds");
ok(my $idle_tag = $mic->idle, "IDLE succeeds on $ng");
open(my $fh, '<', 't/data/message_embed.eml') or BAIL_OUT("open: $!");
plan skip_all => "bad characters in $inboxdir" if $inboxdir =~ m![^\w\.\-/]!;
my ($tmpdir, $for_destroy) = tmpdir();
my $cfg = "$tmpdir/cfg";
-my $mailbox = 'inbox.test';
+my $newsgroup = 'inbox.test';
+my $mailbox = "$newsgroup.1-50000";
{
open my $fh, '>', $cfg or BAIL_OUT "open: $!";
print $fh <<EOF or BAIL_OUT "print: $!";
[publicinbox "test"]
- newsgroup = $mailbox
+ newsgroup = $newsgroup
address = oimap\@example.com
inboxdir = $inboxdir
EOF
}
my ($tmpdir, $for_destroy) = tmpdir();
my %OPT = qw(User u Password p);
-my (%STARTTLS_OPT, %IMAPS_OPT, $td, $mailbox, $make_local_server);
+my (%STARTTLS_OPT, %IMAPS_OPT, $td, $newsgroup, $mailbox, $make_local_server);
if (($ENV{IMAP_TEST_URL} // '') =~ m!\Aimap://([^/]+)/(.+)\z!) {
($OPT{Server}, $mailbox) = ($1, $2);
$OPT{Server} =~ s/:([0-9]+)\z// and $OPT{Port} = $1 + 0;
} else {
require_mods(qw(DBD::SQLite));
$make_local_server->();
+ $mailbox = "$newsgroup.1-50000";
}
my %opts = (imap => \%OPT, 'imap+compress' => { %OPT, Compress => 1 });
$make_local_server = sub {
require PublicInbox::Inbox;
- $mailbox = 'inbox.test';
- my $ibx = { inboxdir => $inbox_dir, newsgroup => $mailbox };
+ $newsgroup = 'inbox.test';
+ my $ibx = { inboxdir => $inbox_dir, newsgroup => $newsgroup };
$ibx = PublicInbox::Inbox->new($ibx);
my $pi_config = "$tmpdir/config";
{
open my $fh, '>', $pi_config or die "open($pi_config): $!";
print $fh <<"" or die "print $pi_config: $!";
[publicinbox "test"]
- newsgroup = $mailbox
+ newsgroup = $newsgroup
inboxdir = $inbox_dir
address = test\@example.com
+++ /dev/null
-#!perl -w
-# Copyright (C) 2020 all contributors <meta@public-inbox.org>
-# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
-use Test::More;
-use_ok 'PublicInbox::IMAP';
-use_ok 'PublicInbox::IMAPD';
-use PublicInbox::DS;
-use Benchmark qw(:all);
-my @n = map { { newsgroup => "inbox.comp.foo.bar.$_" } } (0..50000);
-push @n, map { { newsgroup => "xobni.womp.foo.bar.$_" } } (0..50000);
-my $self = { imapd => { grouplist => \@n } };
-my $n = scalar @n;
-my $t = timeit(1, sub {
- PublicInbox::IMAPD::refresh_inboxlist($self->{imapd});
-});
-diag timestr($t). "refresh $n inboxes";
-
-open my $null, '>', '/dev/null' or BAIL_OUT "open: $!";
-my $ds = { sock => $null };
-my $nr = 200;
-diag "starting benchmark...";
-my $cmd_list = \&PublicInbox::IMAP::cmd_list;
-$t = timeit(1, sub {
- for (0..$nr) {
- my $res = $cmd_list->($self, 'tag', '', '*');
- PublicInbox::DS::write($ds, $res);
- }
-});
-diag timestr($t). "list all for $n inboxes $nr times";
-$nr = 20;
-$t = timeit(1, sub {
- for (0..$nr) {
- my $res = $cmd_list->($self, 'tag', 'inbox.', '%');
- PublicInbox::DS::write($ds, $res);
- }
-});
-diag timestr($t). "list partial for $n inboxes $nr times";
-done_testing;