]> Sergey Matveev's repositories - public-inbox.git/blobdiff - lib/PublicInbox/IMAP.pm
imap: fix UID-offset-to-MSN mapping bugs
[public-inbox.git] / lib / PublicInbox / IMAP.pm
index 9ae7c60e75ee161eb276b23d750fa65c4ea9a7ce..d8b1fce109ea151bdda1a6438d7d2f75219c332c 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";
 }
@@ -225,7 +220,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};
 }
 
@@ -351,7 +346,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 +415,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 +1072,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 +1154,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;
 }
 
@@ -1244,7 +1173,7 @@ sub refill_xap ($$$$) {
        my $opt = { mset => 2, limit => 1000 };
        my $nshard = $srch->{nshard} // 1;
        while (1) {
-               my $mset = $srch->query("$$q uid:$beg..$end", $opt);
+               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
@@ -1256,38 +1185,48 @@ sub refill_xap ($$$$) {
 }
 
 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) //
@@ -1462,6 +1406,10 @@ sub cmd_starttls ($$) {
 # for graceful shutdown in PublicInbox::Daemon:
 sub busy {
        my ($self, $now) = @_;
+       if (defined($self->{-idle_tag})) {
+               $self->write(\"* BYE server shutting down\r\n");
+               return; # not busy anymore
+       }
        ($self->{rbuf} || $self->{wbuf} || $self->not_idle_long($now));
 }