diff options
| -rwxr-xr-x | Documentation/standards.perl | 2 | ||||
| -rw-r--r-- | lib/PublicInbox/IMAP.pm | 58 | ||||
| -rw-r--r-- | lib/PublicInbox/IMAPD.pm | 20 | ||||
| -rw-r--r-- | lib/PublicInbox/NNTPD.pm | 6 | ||||
| -rw-r--r-- | t/imapd.t | 28 |
5 files changed, 104 insertions, 10 deletions
diff --git a/Documentation/standards.perl b/Documentation/standards.perl index 37309956..8fc852c7 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 c0636066..99c6c817 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 1011d6a4..1922c160 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 b8ec84ed..ed5cf7cc 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 { @@ -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'); |