imap: support LIST command

[public-inbox.git] / lib / PublicInbox / IMAP.pm

diff --git a/lib/PublicInbox/IMAP.pm b/lib/PublicInbox/IMAP.pm
index 4a43185c51262baffb9abbafce7eea758c2c3447..ca9a0ea7d420feb3dcaa562d84fb2f8f2efe72c7 100644 (file)
--- a/lib/PublicInbox/IMAP.pm
+++ b/lib/PublicInbox/IMAP.pm
@@ -20,6 +20,7 @@ use fields qw(imapd logged_in ibx long_cb -login_tag
 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)) {
@@ -160,6 +161,7 @@ sub cmd_idle ($$) {
        # 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"
@@ -305,6 +307,49 @@ sub uid_fetch_m { # long_response
        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";
@@ -393,7 +438,8 @@ sub args_ok ($$) { # duplicated from PublicInbox::NNTP
 # 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);
        }