imap: support IDLE

It seems to be working as far as Mail::IMAPClient is concerned.

diff --git a/Documentation/standards.perl b/Documentation/standards.perl
index 37309956f39faccb8c7981976ffbcae854291b89..8fc852c722bae5e48d6bcd3686ee29f7ea442662 100755 (executable)
--- a/Documentation/standards.perl
+++ b/Documentation/standards.perl
@@ -43,7 +43,7 @@ my $rfcs = [
        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',

diff --git a/lib/PublicInbox/IMAP.pm b/lib/PublicInbox/IMAP.pm
index c0636066b9ff0fce0aa6e725549311960440afc8..99c6c817fd799b48995e068d232d09467d12770b 100644 (file)
--- a/lib/PublicInbox/IMAP.pm
+++ b/lib/PublicInbox/IMAP.pm
@@ -15,7 +15,8 @@
 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);
@@ -88,7 +89,10 @@ sub new ($$$) {
 
 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 {
@@ -139,6 +143,40 @@ sub cmd_capability ($$) {
 
 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
@@ -361,7 +399,11 @@ sub process_line ($$) {
        }
        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: ".
@@ -516,6 +558,16 @@ sub busy {
        ($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;

diff --git a/lib/PublicInbox/IMAPD.pm b/lib/PublicInbox/IMAPD.pm
index 1011d6a413b1cf4d5d9f6b0976b65cc4b37f2e5b..1922c16046a3119723e560eb18fdfc010bbc9bd2 100644 (file)
--- a/lib/PublicInbox/IMAPD.pm
+++ b/lib/PublicInbox/IMAPD.pm
@@ -6,10 +6,28 @@
 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;

diff --git a/lib/PublicInbox/NNTPD.pm b/lib/PublicInbox/NNTPD.pm
index b8ec84ed6b0e24490c71cad2fa15787578a467dc..ed5cf7cc8c0af2bdf01d9644fa051b486d7b42f2 100644 (file)
--- a/lib/PublicInbox/NNTPD.pm
+++ b/lib/PublicInbox/NNTPD.pm
@@ -30,9 +30,9 @@ sub new {
        }, $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 {

diff --git a/t/imapd.t b/t/imapd.t
index f28a663bf9dacbb9622120b8647eab5ae64b7dba..359c4c033b28bfecf6fd8b1a39a46e76e13394f3 100644 (file)
--- a/t/imapd.t
+++ b/t/imapd.t
@@ -3,8 +3,10 @@
 # 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);
@@ -12,7 +14,7 @@ SKIP: {
 };
 
 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";
@@ -139,6 +141,28 @@ is_deeply([$mic->has_capability('COMPRESS')], ['DEFLATE'], 'deflate cap');
 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');