Sample UIDs in SELECT $mailbox (QRESYNC ...) commands.

This should avoids most false-positive among messages reported as
VANISHED by the server but unknown from the database.  The reason for
this server behavior is that QRESYNC [RFC7162] doesn't force the server
to remember the MODSEQs of EXPUNGEd messages.  By passing a sample of
known UIDs/sequence numbers we let the server know that the messages
have been EXPUNGEd [RFC7162, section 3.2.5.2].

2 files changed, 87 insertions, 17 deletions

diff --git a/imapsync b/imapsync
index f7c5234..ac63577 100755
--- a/imapsync
+++ b/imapsync
@@ -559,6 +559,13 @@ my $STH_GET_INTERRUPTED_BY_IDX = $DBH->prepare(q{
     WHERE m.idx = ? AND (lUID >= l.UIDNEXT OR rUID >= r.UIDNEXT)
 });
 
+# Count messages
+my $STH_COUNT_MESSAGES = $DBH->prepare(q{SELECT COUNT(*) FROM mapping WHERE idx = ?});
+
+# List last 1024 messages UIDs
+my $STH_LASTUIDs_LOCAL  = $DBH->prepare(q{SELECT rUID FROM mapping WHERE idx = ? ORDER BY rUID DESC LIMIT 1024});
+my $STH_LASTUIDs_REMOTE = $DBH->prepare(q{SELECT lUID FROM mapping WHERE idx = ? ORDER BY lUID DESC LIMIT 1024});
+
 
 # Download some missing UIDs from $source; returns the thew allocated UIDs
 sub download_missing($$$@) {
@@ -612,6 +619,64 @@ sub delete_mapping($$) {
 }
 
 
+# Create a sample (UIDs, sequence numbers) to use as 3rd and 4th
+# argument of the QRESYNC parameters to the SELECT command.
+# QRESYNC [RFC7162] doesn't force the server to remember the MODSEQs of
+# EXPUNGEd messages.  By passing a sample of known UIDs/sequence numbers
+# we let the server know that the messages have been EXPUNGEd [RFC7162,
+# section 3.2.5.2].
+# The UID set is the largest set of higest UIDs with at most 1024 UIDs,
+# of length (after compacting) at most 64.
+# The reason why we sample with the highest UIDs is that lowest UIDs are
+# less likely to be deleted.
+sub sample($$$) {
+    my ($idx, $count, $sth) = @_;
+    return unless $count > 0;
+
+    my ($n, $uids, $min, $max);
+    $sth->execute($idx);
+    while (defined (my $row = $sth->fetchrow_arrayref())) {
+        my $k = $row->[0];
+        if (!defined $min and !defined $max) {
+            $n = 0;
+            $min = $max = $k;
+        }
+        elsif ($k == $min - 1) {
+            $min--;
+        }
+        else {
+            $n += $max - $min + 1;
+            $uids = ($min == $max ? $min : "$min:$max")
+                   .(defined $uids ? ','.$uids : '');
+            $min = $max = $k;
+            if (length($uids) > 64) {
+                $sth->finish(); # done with the statement
+                last;
+            }
+        }
+    }
+    if (!defined $uids or length($uids) <= 64) {
+        $n += $max - $min + 1;
+        $uids = ($min == $max ? $min : "$min:$max")
+               .(defined $uids ? ','.$uids : '');
+    }
+    return ( $uids, ($count - $n + 1).':'.$count );
+}
+
+
+# Issue a SELECT command with the given $mailbox.
+sub select_mbx($$) {
+    my ($idx, $mailbox) = @_;
+
+    $STH_COUNT_MESSAGES->execute($idx);
+    my ($count) = $STH_COUNT_MESSAGES->fetchrow_array();
+    die if defined $STH_COUNT_MESSAGES->fetch(); # sanity check
+
+    $lIMAP->select($mailbox, sample($idx, $count, $STH_LASTUIDs_LOCAL));
+    $rIMAP->select($mailbox, sample($idx, $count, $STH_LASTUIDs_REMOTE));
+}
+
+
 # Check and repair synchronization of a mailbox between the two servers
 # (in a very crude way, by downloading all existing UID with their flags)
 sub repair($) {
@@ -622,8 +687,7 @@ sub repair($) {
     die if defined $STH_GET_INDEX->fetch(); # sanity check
 
     return unless defined $idx; # not in the database
-    $lIMAP->select($mailbox);
-    $rIMAP->select($mailbox);
+    select_mbx($idx, $mailbox);
 
     $STH_GET_CACHE_BY_IDX->execute($idx);
     my $cache = $STH_GET_CACHE_BY_IDX->fetchrow_hashref() // return; # no cache
@@ -1005,7 +1069,7 @@ sub wait_notifications(;$) {
 
 
 #############################################################################
-# Resume interrupted mailbox syncs.
+# Resume interrupted mailbox syncs (before initializing the cache).
 #
 my ($MAILBOX, $IDX);
 $STH_LIST_INTERRUPTED->execute();
@@ -1101,8 +1165,7 @@ while(1) {
             die if defined $STH_GET_INDEX->fetch(); # sanity check
             die unless defined $IDX; # sanity check;
 
-            $lIMAP->select($MAILBOX);
-            $rIMAP->select($MAILBOX);
+            select_mbx($IDX, $MAILBOX);
 
             if (!$KNOWN_INDEXES{$IDX}) {
                 $STH_INSERT_LOCAL->execute( $IDX, $lIMAP->uidvalidity($MAILBOX));
diff --git a/lib/Net/IMAP/Sync.pm b/lib/Net/IMAP/Sync.pm
index 85ca487..ca85a54 100644
--- a/lib/Net/IMAP/Sync.pm
+++ b/lib/Net/IMAP/Sync.pm
@@ -482,19 +482,21 @@ sub search($$) {
 }
 
 
-# $self->select($mailbox)
-# $self->examine($mailbox)
+# $self->select($mailbox,  [$UIDs, $seqs])
+# $self->examine($mailbox, [$UIDs, $seqs])
 #   Issue a SELECT or EXAMINE command for the $mailbox. Upon success,
 #   change the state to SELECTED, otherwise go back to AUTH.
-sub select($$) {
+#   The optional $UIDs and $seqs are passed are 3rd and 4th arguments to
+#   the QRESYNC parameter, respectively.
+sub select($$;$$) {
     my $self = shift;
     my $mailbox = shift;
-    $self->_select_or_examine('SELECT', $mailbox);
+    $self->_select_or_examine('SELECT', $mailbox, @_);
 }
-sub examine($$) {
+sub examine($$;$$) {
     my $self = shift;
     my $mailbox = shift;
-    $self->_select_or_examine('EXAMINE', $mailbox);
+    $self->_select_or_examine('EXAMINE', $mailbox, @_);
 }
 
 
@@ -1276,13 +1278,16 @@ sub _open_mailbox($$) {
 }
 
 
-# $self->_select_or_examine($command, $mailbox)
+# $self->_select_or_examine($command, $mailbox, [$UIDs, $seqs])
 #   Issue a SELECT or EXAMINE command for the $mailbox.  Upon success,
 #   change the state to SELECTED, otherwise go back to AUTH.
-sub _select_or_examine($$$) {
+#   The optional $UIDs and $seqs are passed are 3rd and 4th arguments to
+#   the QRESYNC parameter, respectively.
+sub _select_or_examine($$$;$$) {
     my $self = shift;
     my $command = shift;
     my $mailbox = shift;
+    my ($uids, $seqs) = @_;
 
     my $pcache = $self->{_PCACHE}->{$mailbox} //= {};
     my $cache = $self->{_CACHE}->{$mailbox} //= {};
@@ -1290,10 +1295,12 @@ sub _select_or_examine($$$) {
 
     $mailbox = uc $mailbox eq 'INBOX' ? 'INBOX' : $mailbox; # INBOX is case-insensitive
     $command .= ' '.quote($mailbox);
-    $command .= " (QRESYNC ($pcache->{UIDVALIDITY} $pcache->{HIGHESTMODSEQ} "
-                           ."1:".($pcache->{UIDNEXT}-1)."))"
-        if $self->_enabled('QRESYNC') and
-           ($pcache->{HIGHESTMODSEQ} // 0) > 0 and ($pcache->{UIDNEXT} // 1) > 1;
+    if ($self->_enabled('QRESYNC') and ($pcache->{HIGHESTMODSEQ} // 0) > 0 and ($pcache->{UIDNEXT} // 1) > 1) {
+        $command .= " (QRESYNC ($pcache->{UIDVALIDITY} $pcache->{HIGHESTMODSEQ} "
+                               ."1:".($pcache->{UIDNEXT}-1);
+        $command .= " ($uids $seqs)" if defined $uids and defined $seqs;
+        $command .= "))";
+    }
 
     if ($self->{_STATE} eq 'SELECTED' and ($self->_capable('CONDSTORE') or $self->_capable('QRESYNC'))) {
         # A mailbox is currently selected and the server advertises