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-Status: No, score=-4.0 required=3.0 tests=ALL_TRUSTED,BAYES_00 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 2C8831FA0C for ; Wed, 10 Jun 2020 07:05:20 +0000 (UTC) From: Eric Wong To: meta@public-inbox.org Subject: [PATCH 05/82] imap: support IDLE Date: Wed, 10 Jun 2020 07:04:02 +0000 Message-Id: <20200610070519.18252-6-e@yhbt.net> In-Reply-To: <20200610070519.18252-1-e@yhbt.net> References: <20200610070519.18252-1-e@yhbt.net> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit List-Id: It seems to be working as far as Mail::IMAPClient is concerned. --- Documentation/standards.perl | 2 +- lib/PublicInbox/IMAP.pm | 58 ++++++++++++++++++++++++++++++++++-- lib/PublicInbox/IMAPD.pm | 20 ++++++++++++- lib/PublicInbox/NNTPD.pm | 6 ++-- t/imapd.t | 28 +++++++++++++++-- 5 files changed, 104 insertions(+), 10 deletions(-) diff --git a/Documentation/standards.perl b/Documentation/standards.perl index 37309956f39..8fc852c722b 100755 --- 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 c0636066b9f..99c6c817fd7 100644 --- 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 1011d6a413b..1922c16046a 100644 --- 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 b8ec84ed6b0..ed5cf7cc8c0 100644 --- 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 f28a663bf9d..359c4c033b2 100644 --- a/t/imapd.t +++ b/t/imapd.t @@ -3,8 +3,10 @@ # License: AGPL-3.0+ 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');