]> Sergey Matveev's repositories - public-inbox.git/blobdiff - lib/PublicInbox/IMAP.pm
imap: always send EXISTS on uo2m_extend
[public-inbox.git] / lib / PublicInbox / IMAP.pm
index d4ef6efe156d2b3efde19d4eafa08aa3a760b73d..888c9becfe0afc73610615288517a0c5f5ced8ea 100644 (file)
@@ -34,10 +34,9 @@ use PublicInbox::Syscall qw(EPOLLIN EPOLLONESHOT);
 use PublicInbox::GitAsyncCat;
 use Text::ParseWords qw(parse_line);
 use Errno qw(EAGAIN);
-use Time::Local qw(timegm);
-use POSIX qw(strftime);
 use Hash::Util qw(unlock_hash); # dependency of fields for perl 5.10+, anyways
 use PublicInbox::Search;
+use PublicInbox::IMAPsearchqp;
 *mdocid = \&PublicInbox::Search::mdocid;
 
 my $Address;
@@ -97,10 +96,6 @@ undef %FETCH_NEED;
 my $valid_range = '[0-9]+|[0-9]+:[0-9]+|[0-9]+:\*';
 $valid_range = qr/\A(?:$valid_range)(?:,(?:$valid_range))*\z/;
 
-my @MoY = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
-my %MoY;
-@MoY{@MoY} = (0..11);
-
 # RFC 3501 5.4. Autologout Timer needs to be >= 30min
 $PublicInbox::DS::EXPTIME = 60 * 30;
 
@@ -171,7 +166,7 @@ sub cmd_login ($$$$) {
 
 sub cmd_close ($$) {
        my ($self, $tag) = @_;
-       delete $self->{uid_base};
+       delete @$self{qw(uid_base uo2m)};
        delete $self->{ibx} ? "$tag OK Close done\r\n"
                                : "$tag BAD No mailbox\r\n";
 }
@@ -195,8 +190,6 @@ sub cmd_capability ($$) {
        '* '.capa($self)."\r\n$tag OK Capability done\r\n";
 }
 
-sub cmd_noop ($$) { "$_[1] OK Noop done\r\n" }
-
 # uo2m: UID Offset to MSN, this is an arrayref by default,
 # but uo2m_hibernate can compact and deduplicate it
 sub uo2m_ary_new ($) {
@@ -225,7 +218,7 @@ sub uo2m_hibernate ($) {
 
 sub uo2m_last_uid ($) {
        my ($self) = @_;
-       my $uo2m = $self->{uo2m} or die 'BUG: uo2m_last_uid w/o {uo2m}';
+       defined(my $uo2m = $self->{uo2m}) or die 'BUG: uo2m_last_uid w/o {uo2m}';
        (ref($uo2m) ? @$uo2m : (length($uo2m) >> 1)) + $self->{uid_base};
 }
 
@@ -238,7 +231,7 @@ sub uo2m_pack ($) {
 
 # extend {uo2m} to account for new messages which arrived since
 # {uo2m} was created.
-sub uo2m_extend ($$) {
+sub uo2m_extend ($$;$) {
        my ($self, $new_uid_max) = @_;
        defined(my $uo2m = $self->{uo2m}) or
                return($self->{uo2m} = uo2m_ary_new($self));
@@ -250,20 +243,30 @@ sub uo2m_extend ($$) {
        ++$beg;
        my $uids = $self->{ibx}->over->uid_range($beg, $base + UID_SLICE);
        my @tmp; # [$UID_OFFSET] => $MSN
+       my $write_method = $_[2] // 'msg_more';
        if (ref($uo2m)) {
                my $msn = $uo2m->[-1];
                $tmp[$_ - $beg] = ++$msn for @$uids;
+               $self->$write_method("* $msn EXISTS\r\n");
                push @$uo2m, @tmp;
                $uo2m;
        } else {
                my $msn = unpack('S', substr($uo2m, -2, 2));
                $tmp[$_ - $beg] = ++$msn for @$uids;
+               $self->$write_method("* $msn EXISTS\r\n");
                $uo2m .= uo2m_pack(\@tmp);
                my %dedupe = ($uo2m => undef);
                $self->{uo2m} = (keys %dedupe)[0];
        }
 }
 
+sub cmd_noop ($$) {
+       my ($self, $tag) = @_;
+       defined($self->{uid_base}) and
+               uo2m_extend($self, $self->{uid_base} + UID_SLICE);
+       \"$tag OK Noop done\r\n";
+}
+
 # the flexible version which works on scalars and array refs.
 # Must call uo2m_extend before this
 sub uid2msn ($$) {
@@ -300,14 +303,10 @@ sub msn_to_uid_range ($$) {
 # called by PublicInbox::InboxIdle
 sub on_inbox_unlock {
        my ($self, $ibx) = @_;
-       my $old = uo2m_last_uid($self);
        my $uid_end = $self->{uid_base} + UID_SLICE;
-       uo2m_extend($self, $uid_end);
+       uo2m_extend($self, $uid_end, 'write');
        my $new = uo2m_last_uid($self);
-       if ($new > $old) {
-               my $msn = uid2msn($self, $new);
-               $self->write(\"* $msn EXISTS\r\n");
-       } elsif ($new == $uid_end) { # max exceeded $uid_end
+       if ($new == $uid_end) { # max exceeded $uid_end
                # continue idling w/o inotify
                my $sock = $self->{sock} or return;
                $ibx->unsubscribe_unlock(fileno($sock));
@@ -334,14 +333,13 @@ 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";
-       $self->{-idle_tag} = $tag;
-       my $max = $ibx->over->max;
        my $uid_end = $self->{uid_base} + UID_SLICE;
+       uo2m_extend($self, $uid_end);
        my $sock = $self->{sock} or return;
        my $fd = fileno($sock);
+       $self->{-idle_tag} = $tag;
        # only do inotify on most recent slice
-       if ($max < $uid_end) {
-               uo2m_extend($self, $uid_end);
+       if ($ibx->over->max < $uid_end) {
                $ibx->subscribe_unlock($fd, $self);
                $self->{imapd}->idler_start;
        }
@@ -351,7 +349,7 @@ sub cmd_idle ($$) {
 }
 
 sub stop_idle ($$) {
-       my ($self, $ibx);
+       my ($self, $ibx) = @_;
        my $sock = $self->{sock} or return;
        my $fd = fileno($sock);
        delete $IDLERS->{$fd};
@@ -420,6 +418,7 @@ sub cmd_examine ($$$) {
        my ($ibx, $exists, $uidnext, $base) = inbox_lookup($self, $mailbox);
        return "$tag NO Mailbox doesn't exist: $mailbox\r\n" if !$ibx;
        $self->{uid_base} = $base;
+       delete $self->{uo2m};
 
        # XXX: do we need this? RFC 5162/7162
        my $ret = $self->{ibx} ? "* OK [CLOSED] previous closed\r\n" : '';
@@ -1076,24 +1075,23 @@ sub cmd_fetch ($$$$;@) {
        long_response($self, $cb, $tag, [], $range_info, $ops, $partial);
 }
 
-sub parse_date ($) { # 02-Oct-1993
-       my ($date_text) = @_;
-       my ($dd, $mon, $yyyy) = split(/-/, $_[0], 3);
-       defined($yyyy) or return;
-       my $mm = $MoY{$mon} // return;
-       $dd =~ /\A[0123]?[0-9]\z/ or return;
-       $yyyy =~ /\A[0-9]{4,}\z/ or return; # Y10K-compatible!
-       timegm(0, 0, 0, $dd, $mm, $yyyy);
+sub msn_convert ($$) {
+       my ($self, $uids) = @_;
+       my $adj = $self->{uid_base} + 1;
+       my $uo2m = uo2m_extend($self, $uids->[-1]);
+       $uo2m = [ unpack('S*', $uo2m) ] if !ref($uo2m);
+       $_ = $uo2m->[$_ - $adj] for @$uids;
 }
 
 sub search_uid_range { # long_response
-       my ($self, $tag, $sql, $range_info) = @_;
+       my ($self, $tag, $sql, $range_info, $want_msn) = @_;
        my $uids = [];
        if (defined(my $err = refill_uids($self, $uids, $range_info, $sql))) {
                $err ||= 'OK Search done';
                $self->write("\r\n$tag $err\r\n");
                return;
        }
+       msn_convert($self, $uids) if $want_msn;
        $self->msg_more(join(' ', '', @$uids));
        1; # more
 }
@@ -1159,81 +1157,15 @@ sub xap_append ($$$$) {
        undef;
 }
 
-sub parse_query {
-       my ($self, $rest) = @_;
-       if (uc($rest->[0]) eq 'CHARSET') {
-               shift @$rest;
-               defined(my $c = shift @$rest) or return 'BAD missing charset';
-               $c =~ /\A(?:UTF-8|US-ASCII)\z/ or return 'NO [BADCHARSET]';
+sub parse_query ($$) {
+       my ($self, $query) = @_;
+       my $q = PublicInbox::IMAPsearchqp::parse($self, $query);
+       if (ref($q)) {
+               my $max = $self->{ibx}->over->max;
+               my $beg = 1;
+               uid_clamp($self, \$beg, \$max);
+               $q->{range_info} = [ $beg, $max ];
        }
-
-       my $sql = ''; # date conditions, {sql} deleted if Xapian is needed
-       my $xap = '';
-       my $q = { sql => \$sql, xap => \$xap };
-       my $msn2uid;
-       while (@$rest) {
-               my $k = uc(shift @$rest);
-               # default criteria
-               next if $k =~ /\A(?:ALL|RECENT|UNSEEN|NEW)\z/;
-               next if $k eq 'AND'; # the default, until we support OR
-               if ($k =~ $valid_range) { # convert sequence numbers to UIDs
-                       msn_to_uid_range($msn2uid //= msn2uid($self), $k);
-                       push @{$q->{uid}}, $k;
-               } elsif ($k eq 'UID') {
-                       $k = shift(@$rest) // '';
-                       $k =~ $valid_range or return 'BAD UID range';
-                       push @{$q->{uid}}, $k;
-               } elsif ($k =~ /\A(?:SENT)?(?:SINCE|ON|BEFORE)\z/) {
-                       my $d = parse_date(shift(@$rest) // '');
-                       defined $d or return "BAD $k date format";
-                       date_search($q, $k, $d);
-               } elsif ($k =~ /\A(?:SMALLER|LARGER)\z/) {
-                       delete $q->{sql}; # can't use over.sqlite3
-                       my $bytes = shift(@$rest) // '';
-                       $bytes =~ /\A[0-9]+\z/ or return "BAD $k not a number";
-                       $xap .= ' bytes:' . ($k eq 'SMALLER' ?
-                                                       '..'.(--$bytes) :
-                                                       (++$bytes).'..');
-               } elsif ($k eq 'HEADER') {
-                       $k = uc(shift(@$rest) // '');
-                       my $xk = $H2X{$k} or
-                               return "BAD HEADER $k not supported";
-                       my $err = xap_append($q, $rest, $k, $xk);
-                       return $err if $err;
-               } elsif (defined(my $xk = $I2X{$k})) {
-                       my $err = xap_append($q, $rest, $k, $xk);
-                       return $err if $err;
-               } else {
-                       # TODO: parentheses, OR, NOT ...
-                       return "BAD $k not supported (yet?)";
-               }
-       }
-
-       # favor using over.sqlite3 if possible, since Xapian is optional
-       if (exists $q->{sql}) {
-               delete($q->{xap});
-               delete($q->{sql}) if $sql eq '';
-       } elsif (!$self->{ibx}->search) {
-               return 'BAD Xapian not configured for mailbox';
-       }
-       my $max = $self->{ibx}->over->max;
-       if (my $uid = delete $q->{uid}) {
-               my $range_csv = join(',', @$uid);
-               do {
-                       my $nxt = range_step($self, \$range_csv);
-                       my ($beg, $end) = @$nxt;
-                       if ($xap) {
-                               $xap .= " uid:$beg..$end";
-                       } elsif ($beg == $end) {
-                               $sql .= " AND num = $beg";
-                       } else {
-                               $sql .= " AND num >= $beg AND num <= $end";
-                       }
-               } while ($range_csv);
-       }
-       my $beg = 1;
-       uid_clamp($self, \$beg, \$max);
-       $q->{range_info} = [ $beg, $max ];
        $q;
 }
 
@@ -1243,51 +1175,58 @@ sub refill_xap ($$$$) {
        my $srch = $self->{ibx}->search;
        my $opt = { mset => 2, limit => 1000 };
        my $nshard = $srch->{nshard} // 1;
-       while (1) {
-               my $mset = $srch->query("$$q uid:$beg..$end", $opt);
-               @$uids = map { mdocid($nshard, $_) } $mset->items;
-               if (@$uids) {
-                       $range_info->[0] = $uids->[-1] + 1; # update $beg
-                       return;
-               } else { # all done
-                       return 0;
-               }
+       my $mset = $srch->query("$q uid:$beg..$end", $opt);
+       @$uids = map { mdocid($nshard, $_) } $mset->items;
+       if (@$uids) {
+               $range_info->[0] = $uids->[-1] + 1; # update $beg
+               return; # possibly more
        }
+       0; # all done
 }
 
 sub search_xap_range { # long_response
-       my ($self, $tag, $q, $range_info) = @_;
+       my ($self, $tag, $q, $range_info, $want_msn) = @_;
        my $uids = [];
        if (defined(my $err = refill_xap($self, $uids, $range_info, $q))) {
                $err ||= 'OK Search done';
                $self->write("\r\n$tag $err\r\n");
                return;
        }
+       msn_convert($self, $uids) if $want_msn;
        $self->msg_more(join(' ', '', @$uids));
        1; # more
 }
 
-sub cmd_uid_search ($$$;) {
-       my ($self, $tag) = splice(@_, 0, 2);
+sub search_common {
+       my ($self, $tag, $query, $want_msn) = @_;
        my $ibx = $self->{ibx} or return "$tag BAD No mailbox selected\r\n";
-       my $q = parse_query($self, \@_);
+       my $q = parse_query($self, $query);
        return "$tag $q\r\n" if !ref($q);
        my ($sql, $range_info) = delete @$q{qw(sql range_info)};
        if (!scalar(keys %$q)) { # overview.sqlite3
                $self->msg_more('* SEARCH');
                long_response($self, \&search_uid_range,
-                               $tag, $sql, $range_info);
+                               $tag, $sql, $range_info, $want_msn);
        } elsif ($q = $q->{xap}) {
+               $self->{ibx}->search or
+                       return "$tag BAD search not available for mailbox\r\n";
                $self->msg_more('* SEARCH');
                long_response($self, \&search_xap_range,
-                               $tag, $q, $range_info);
+                               $tag, $q, $range_info, $want_msn);
        } else {
                "$tag BAD Error\r\n";
        }
 }
 
-# note: MSN SEARCH is NOT supported.  Do any widely-used MUAs
-# rely on MSNs from SEARCH results?  Let us know at meta@public-inbox.org
+sub cmd_uid_search ($$$) {
+       my ($self, $tag, $query) = @_;
+       search_common($self, $tag, $query);
+}
+
+sub cmd_search ($$$;) {
+       my ($self, $tag, $query) = @_;
+       search_common($self, $tag, $query, 1);
+}
 
 sub args_ok ($$) { # duplicated from PublicInbox::NNTP
        my ($cb, $argc) = @_;
@@ -1304,6 +1243,7 @@ sub process_line ($$) {
 
        # TODO: IMAP allows literals for big requests to upload messages
        # (which we don't support) but maybe some big search queries use it.
+       # RFC 3501 9 (2) doesn't permit TAB or multiple SP
        my ($tag, $req, @args) = parse_line('[ \t]+', 0, $l);
        pop(@args) if (@args && !defined($args[-1]));
        if (@args && uc($req) eq 'UID') {
@@ -1315,6 +1255,10 @@ sub process_line ($$) {
                                idle_done($self, $tag) :
                                "$idle_tag BAD expected DONE\r\n";
                } elsif (my $cmd = $self->can('cmd_'.lc($req // ''))) {
+                       if ($cmd == \&cmd_uid_search || $cmd == \&cmd_search) {
+                               # preserve user-supplied quotes for search
+                               (undef, @args) = split(/ search /i, $l, 2);
+                       }
                        $cmd->($self, $tag, @args);
                } else { # this is weird
                        auth_challenge_ok($self) //
@@ -1353,7 +1297,7 @@ sub long_step {
        } elsif ($more) { # $self->{wbuf}:
                $self->update_idle_time;
 
-               # control passed to $more may be a GitAsyncCat object
+               # control passed to git_async_cat if $more == \undef
                requeue_once($self) if !ref($more);
        } else { # all done!
                delete $self->{long_cb};