It seems to be working as far as Mail::IMAPClient is concerned.
2822 => 'Internet message format (2001)',
5322 => 'Internet message format (2008)',
3501 => 'IMAP4rev1',
- 2177 => 'IMAP IDLE', # TODO
+ 2177 => 'IMAP IDLE',
# 5032 = 'WITHIN search extension for IMAP',
4978 => 'IMAP COMPRESS Extension',
# 5182 = 'IMAP Extension for Referencing the Last SEARCH Result',
package PublicInbox::IMAP;
use strict;
use base qw(PublicInbox::DS);
-use fields qw(imapd logged_in ibx long_cb -login_tag);
+use fields qw(imapd logged_in ibx long_cb -login_tag
+ -idle_tag -idle_max);
use PublicInbox::Eml;
use PublicInbox::DS qw(now);
use PublicInbox::Syscall qw(EPOLLIN EPOLLONESHOT);
sub capa ($) {
my ($self) = @_;
- my $capa = 'CAPABILITY IMAP4rev1';
+
+ # dovecot advertises IDLE pre-login; perhaps because some clients
+ # depend on it, so we'll do the same
+ my $capa = 'CAPABILITY IMAP4rev1 IDLE';
if ($self->{logged_in}) {
$capa .= ' COMPRESS=DEFLATE';
} else {
sub cmd_noop ($$) { "$_[1] OK NOOP completed\r\n" }
+# called by PublicInbox::InboxIdle
+sub on_inbox_unlock {
+ my ($self, $ibx) = @_;
+ my $new = ($ibx->mm->minmax)[1];
+ defined(my $old = $self->{-idle_max}) or die 'BUG: -idle_max unset';
+ if ($new > $old) {
+ $self->{-idle_max} = $new;
+ $self->msg_more("* $_ EXISTS\r\n") for (($old + 1)..($new - 1));
+ $self->write(\"* $new EXISTS\r\n");
+ }
+}
+
+sub cmd_idle ($$) {
+ my ($self, $tag) = @_;
+ # IDLE seems allowed by dovecot w/o a mailbox selected *shrug*
+ my $ibx = $self->{ibx} or return "$tag BAD no mailbox selected\r\n";
+ $ibx->subscribe_unlock(fileno($self->{sock}), $self);
+ $self->{-idle_tag} = $tag;
+ $self->{-idle_max} = ($ibx->mm->minmax)[1] // 0;
+ "+ idling\r\n"
+}
+
+sub cmd_done ($$) {
+ my ($self, $tag) = @_; # $tag is "DONE" (case-insensitive)
+ defined(my $idle_tag = delete $self->{-idle_tag}) or
+ return "$tag BAD not idle\r\n";
+ my $ibx = $self->{ibx} or do {
+ warn "BUG: idle_tag set w/o inbox";
+ return "$tag BAD internal bug\r\n";
+ };
+ $ibx->unsubscribe_unlock(fileno($self->{sock}));
+ "$idle_tag OK Idle completed\r\n";
+}
+
sub cmd_examine ($$$) {
my ($self, $tag, $mailbox) = @_;
my $ibx = $self->{imapd}->{groups}->{$mailbox} or
}
my $res = eval {
if (my $cmd = $self->can('cmd_'.lc($req // ''))) {
- $cmd->($self, $tag, @args);
+ defined($self->{-idle_tag}) ?
+ "$self->{-idle_tag} BAD expected DONE\r\n" :
+ $cmd->($self, $tag, @args);
+ } elsif (uc($tag // '') eq 'DONE' && !defined($req)) {
+ cmd_done($self, $tag);
} else { # this is weird
auth_challenge_ok($self) //
"$tag BAD Error in IMAP command $req: ".
($self->{rbuf} || $self->{wbuf} || $self->not_idle_long($now));
}
+sub close {
+ my ($self) = @_;
+ if (my $ibx = delete $self->{ibx}) {
+ if (my $sock = $self->{sock}) {;
+ $ibx->unsubscribe_unlock(fileno($sock));
+ }
+ }
+ $self->SUPER::close; # PublicInbox::DS::close
+}
+
# we're read-only, so SELECT and EXAMINE do the same thing
no warnings 'once';
*cmd_select = \&cmd_examine;
package PublicInbox::IMAPD;
use strict;
use parent qw(PublicInbox::NNTPD);
+use PublicInbox::InboxIdle;
sub new {
my ($class) = @_;
- $class->SUPER::new; # PublicInbox::NNTPD->new
+ bless {
+ groups => {},
+ err => \*STDERR,
+ out => \*STDOUT,
+ grouplist => [],
+ # accept_tls => { SSL_server => 1, ..., SSL_reuse_ctx => ... }
+ # idler => PublicInbox::InboxIdle
+ }, $class;
+}
+
+sub refresh_groups {
+ my ($self) = @_;
+ if (my $old_idler = delete $self->{idler}) {
+ $old_idler->close; # PublicInbox::DS::close
+ }
+ my $pi_config = PublicInbox::Config->new;
+ $self->{idler} = PublicInbox::InboxIdle->new($pi_config);
+ $self->SUPER::refresh_groups($pi_config);
}
1;
}, $class;
}
-sub refresh_groups () {
- my ($self) = @_;
- my $pi_config = PublicInbox::Config->new;
+sub refresh_groups {
+ my ($self, $pi_config) = @_;
+ $pi_config //= PublicInbox::Config->new;
my $new = {};
my @list;
$pi_config->each_inbox(sub {
# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
use strict;
use Test::More;
+use Time::HiRes ();
use PublicInbox::TestCommon;
-require_mods(qw(DBD::SQLite Mail::IMAPClient));
+use PublicInbox::Config;
+require_mods(qw(DBD::SQLite Mail::IMAPClient Linux::Inotify2));
my $level = '-Lbasic';
SKIP: {
require_mods('Search::Xapian', 1);
};
my @V = (1);
-#push(@V, 2) if require_git('2.6', 1);
+push(@V, 2) if require_git('2.6', 1);
my ($tmpdir, $for_destroy) = tmpdir();
my $home = "$tmpdir/home";
ok($mic->compress, 'compress enabled');
$compress_logout->($mic);
+my $pi_config = PublicInbox::Config->new;
+$pi_config->each_inbox(sub {
+ my ($ibx) = @_;
+ my $name = $ibx->{name};
+ my $ng = $ibx->{newsgroup};
+ my $mic = Mail::IMAPClient->new(%mic_opt);
+ ok($mic && $mic->login && $mic->IsAuthenticated, "authed $name");
+ 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->idle, "IDLE succeeds on $ng");
+
+ open(my $fh, '<', 't/data/message_embed.eml') or BAIL_OUT("open: $!");
+ my $env = { ORIGINAL_RECIPIENT => $ibx->{-primary_address} };
+ run_script(['-mda', '--no-precheck'], $env, { 0 => $fh }) or
+ BAIL_OUT('-mda delivery');
+ my $t0 = Time::HiRes::time();
+ ok(my @res = $mic->idle_data(11), "IDLE succeeds on $ng");
+ ok(grep(/\A\* [0-9] EXISTS\b/, @res), 'got EXISTS message');
+ ok((Time::HiRes::time() - $t0) < 10, 'IDLE client notified');
+});
+
$td->kill;
$td->join;
is($?, 0, 'no error in exited process');