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);
+use Text::ParseWords qw(parse_line);
use Errno qw(EAGAIN);
my $Address;
for my $mod (qw(Email::Address::XS Mail::Address)) {
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->max;
+ 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->{imapd}->idler_start;
+ $self->{-idle_tag} = $tag;
+ $self->{-idle_max} = $ibx->mm->max // 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
return "$tag NO Mailbox doesn't exist: $mailbox\r\n";
my $mm = $ibx->mm;
- my $max = $mm->num_highwater // 0;
+ my $max = $mm->max // 0;
# 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"
1;
}
+sub cmd_status ($$$;@) {
+ my ($self, $tag, $mailbox, @items) = @_;
+ my $ibx = $self->{imapd}->{groups}->{$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
+ return "$tag BAD invalid args\r\n";
+
+ my $mm = $ibx->mm;
+ my ($max, @it);
+ for my $it (@items) {
+ $it = uc($it);
+ push @it, $it;
+ if ($it =~ /\A(?:MESSAGES|UNSEEN|RECENT)\z/) {
+ push(@it, ($max //= $mm->max // 0));
+ } 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"));
+ } else {
+ return "$tag BAD invalid item\r\n";
+ }
+ }
+ return "$tag BAD no items\r\n" if !@it;
+ "* STATUS $mailbox (".join(' ', @it).")\r\n" .
+ "$tag OK Status complete\r\n";
+}
+
+my %patmap = ('*' => '.*', '%' => '[^\.]*');
+sub cmd_list ($$$$) {
+ my ($self, $tag, $refname, $wildcard) = @_;
+ my $l = $self->{imapd}->{inboxlist};
+ if ($refname eq '' && $wildcard eq '') {
+ # request for hierarchy delimiter
+ $l = [ qq[* LIST (\\Noselect) "." ""\r\n] ];
+ } elsif ($refname ne '' || $wildcard ne '*') {
+ $wildcard =~ s!([^a-z0-9_])!$patmap{$1} // "\Q$1"!eig;
+ $l = [ grep(/ \Q$refname\E$wildcard\r\n\z/s, @$l) ];
+ }
+ \(join('', @$l, "$tag OK List complete\r\n"));
+}
+
sub cmd_uid_fetch ($$$;@) {
my ($self, $tag, $range, @want) = @_;
my $ibx = $self->{ibx} or return "$tag BAD No mailbox selected\r\n";
if ($range =~ /\A([0-9]+):([0-9]+)\z/s) {
($beg, $end) = ($1, $2);
} elsif ($range =~ /\A([0-9]+):\*\z/s) {
- ($beg, $end) = ($1, $ibx->mm->num_highwater // 0);
+ ($beg, $end) = ($1, $ibx->mm->max // 0);
} elsif ($range =~ /\A[0-9]+\z/) {
my $smsg = $ibx->over->get_art($range) or return "$tag OK\r\n";
push @$msgs, $smsg;
} elsif ($arg eq 'UID' && scalar(@rest) == 1) {
if ($rest[0] =~ /\A([0-9]+):([0-9]+|\*)\z/s) {
my ($beg, $end) = ($1, $2);
- $end = ($ibx->mm->minmax)[1] if $end eq '*';
+ $end = $ibx->mm->max if $end eq '*';
$self->msg_more('* SEARCH');
long_response($self, \&uid_search_uid_range,
$tag, $ibx, \$beg, $end);
# returns 1 if we can continue, 0 if not due to buffered writes or disconnect
sub process_line ($$) {
my ($self, $l) = @_;
- my ($tag, $req, @args) = split(/[ \t]+/, $l);
+ my ($tag, $req, @args) = parse_line('[ \t]+', 0, $l);
+ pop(@args) if (@args && !defined($args[-1]));
if (@args && uc($req) eq 'UID') {
$req .= "_".(shift @args);
}
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;