Net::IMAP::InterIMAP::push_flag_updates() bugfixes.

The UNCHANGEDSINCE test from the CONDSTORE extension was incorrectly
placed after the flag list in UID STORE commands.  In practice this
meant the server didn't add the MODIFIED code when needed.

The server won't send an untagged FETCH command (and won't increase the
message's MODSEQ) if no change was made to the flag list.  A panic() was
incorrectly triggered in that case.

When the flag list was set (by another client) to a superset of the UID
STORE command currently processed, the extra flags were not synchronized.
Cf. RFC 7162 sec. 3.1.3 ex. 10.

4 files changed, 82 insertions, 34 deletions

diff --git a/Changelog b/Changelog
index f90c28c..763a7a1 100644
--- a/Changelog
+++ b/Changelog
@@ -87,6 +87,13 @@ interimap (0.5) upstream;
    compression stream is reached.
  - libinterimap: the 'compress' boolean wasn't honored.
  - libinterimap: fix STARTTLS directive, broken since 0.2.
+ - libinterimap: push_flag_updates(): the UNCHANGEDSINCE test from
+   the CONDSTORE extension was incorrectly placed after the flag list in
+   UID STORE commands.
+ - libinterimap: push_flag_updates(): ignore UIDs for which no untagged
+   FETCH response was received.
+ - libinterimap: push_flag_updates(): don't ignores received updates (by
+   another client) to a superset of the desigred flag list.
 
  -- Guilhem Moulin <guilhem@fripost.org>  Fri, 10 May 2019 00:58:14 +0200
 
diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index c25df27..a838dd0 100644
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -1197,16 +1197,15 @@ sub pull_updates($;$) {
     my $mailbox = $self->{_SELECTED} // $self->panic();
     my $pcache = $self->{_PCACHE}->{$mailbox};
 
-    my %modified;
     $self->_send("UID FETCH 1:".($pcache->{UIDNEXT}-1)." (MODSEQ FLAGS)")
         if $full and ($pcache->{UIDNEXT} // 1) > 1;
 
-    my @missing;
+    my %modified;
     while (%{$self->{_MODIFIED}}) {
+        my @missing;
         while (my ($uid,$v) = each %{$self->{_MODIFIED}}) {
-            # don't filter on the fly (during FETCH responses) because
-            # FLAG updates can arrive while processing pull_new_messages
-            # for instance
+            # don't filter on the fly (during FETCH responses) because FLAG updates
+            # can arrive while processing pull_new_messages() for instance
             if (defined $v->[1] and $v->[0] > 0) { # setting the MODSEQ to 0 forces a FETCH
                 next unless $uid              < ($pcache->{UIDNEXT} // 1)         # out of bounds
                         and ($full or $v->[0] > ($pcache->{HIGHESTMODSEQ} // 0)); # already seen
@@ -1216,8 +1215,9 @@ sub pull_updates($;$) {
             }
         }
         $self->{_MODIFIED} = {};
+        # non-empty @missing indicates a discouraged (but allowed) CONDSTORE server behavior,
+        # cf. RFC 7162 sec. 3.1.3 ex. 8 and the comment in push_flag_updates() below
         $self->_send("UID FETCH ".compact_set(@missing)." (MODSEQ FLAGS)") if @missing;
-        @missing = ();
     }
 
     # do that afterwards since the UID FETCH command above can produce VANISHED responses
@@ -1307,22 +1307,18 @@ sub push_flag_updates($$@) {
 
     my $mailbox = $self->{_SELECTED} // $self->panic();
     my $modseq = $self->{_PCACHE}->{$mailbox}->{HIGHESTMODSEQ} // $self->panic();
-    my $command = "UID STORE ".compact_set(@set)." FLAGS.SILENT ($flags) (UNCHANGEDSINCE $modseq)";
-
-    my %listed;
-    $self->_send($command, sub($){ $listed{shift->{UID}}++; });
+    my $command = "UID STORE ".compact_set(@set)." (UNCHANGEDSINCE $modseq) FLAGS.SILENT ($flags)";
 
     my %failed;
+    $self->_send($command);
     if ($IMAP_text =~ /\A\Q$IMAP_cond\E \[MODIFIED ([0-9,:]+)\] $RE_TEXT_CHAR+\z/) {
         foreach (split /,/, $1) {
             if (/\A([0-9]+)\z/) {
                 $failed{$1} = 1;
-            }
-            elsif (/\A([0-9]+):([0-9]+)\z/) {
+            } elsif (/\A([0-9]+):([0-9]+)\z/) {
                 my ($min, $max) = $1 < $2 ? ($1,$2) : ($2,$1);
                 $failed{$_} = 1 foreach ($min .. $max);
-            }
-            else {
+            } else {
                 $self->panic($_);
             }
         }
@@ -1330,34 +1326,28 @@ sub push_flag_updates($$@) {
 
     my @ok;
     foreach my $uid (@set) {
+        my $modified = $self->{_MODIFIED};
         if ($failed{$uid}) {
-            # $uid was listed in the MODIFIED response code
-            $self->{_MODIFIED}->{$uid} //= [ 0, undef ]; # will be downloaded again in pull_updates
-            delete $self->{_MODIFIED}->{$uid} if
-                # got a FLAG update for $uid; ignore it if it's $flags
-                defined $self->{_MODIFIED}->{$uid}->[1] and
-                $self->{_MODIFIED}->{$uid}->[1] eq $flags;
-        }
-        else {
-            # $uid wasn't listed in the MODIFIED response code
-            next unless defined $self->{_MODIFIED}->{$uid}; # already stored
-            $self->panic() unless defined $listed{$uid} and $listed{$uid} > 0; # sanity check
-            if ($listed{$uid} == 1) {
-                # ignore succesful update
-                delete $self->{_MODIFIED}->{$uid};
-            }
-            elsif ($self->{_MODIFIED}->{$uid}->[1] and $self->{_MODIFIED}->{$uid}->[1] eq $flags) {
-                # got multiple FETCH responses for $uid, the last one with $flags
-                delete $self->{_MODIFIED}->{$uid};
+            # $uid was listed in the MODIFIED response code from RFC 7162; will FETCH
+            # again in pull_updates(); per RFC 7162 sec. 3.1.3 $modified->{$uid} might not
+            # be defined ("nice" servers send an untagged FETCH response, cf. example 10,
+            # but they might omit it - allowed but discouraged CONDSTORE server behavior -
+            # cf. example 8)
+            $modified->{$uid} //= [ 0, undef ];
+        } elsif (defined (my $m = $modified->{$uid})) {
+            # received an untagged FETCH response, remove from the list of pending changes
+            # if the flag list was up to date (either implicitely or explicitely)
+            if (!defined $m->[1] or $m->[1] eq $flags) {
+                delete $modified->{$uid};
+                push @ok, $uid;
             }
-            push @ok, $uid;
         }
     }
 
     unless ($self->{quiet}) {
         $self->log("Updated flags ($flags) for UID ".compact_set(@ok)) if @ok;
         $self->log("Couldn't update flags ($flags) for UID ".compact_set(keys %failed).', '.
-                   "trying again later") if %failed;
+                   "will try again later") if %failed;
     }
     return keys %failed;
 }
diff --git a/tests/condstore/t b/tests/condstore/t
new file mode 100644
index 0000000..d4da50f
--- /dev/null
+++ b/tests/condstore/t
@@ -0,0 +1,50 @@
+TIMEOUT=60
+N=4096
+
+# test CONDSTORE/QRESYNC (behavior) in UID STORE commands, in particular
+# the UNCHANGEDSINCE test: populate, keep assiging keywords at random,
+# and make sure interimap is able to reconciliate the changes
+
+# populate (with dummy messages to speed things up) only one server
+# before initializing interimap, so UIDs concide with sequence numbers
+# and are identical on both servers
+for ((i = 0; i < N; i++)); do
+    deliver -u "local" <<< .
+done
+
+interimap_init
+
+# assign a set of 16 tags; not more because in order to maximize the
+# likelyhood of conflicts we want UID STORE commands to use large sets
+declare -a FLAGS=(0 1 2 3 4 5 6 7 8 9 a b c d e f)
+
+# start a long-lived interimap process
+interimap --watch=1 & PID=$!
+trap "ptree_abort $PID" EXIT INT TERM
+
+timer=$(( $(date +%s) + TIMEOUT ))
+while [ $(date +%s) -le $timer ]; do
+    a="$(shuf -n1 -e "add" "remove" "replace")"
+    u="$(shuf -n1 -e "local" "remote")"
+    f="$(shuf -n1 -e "${FLAGS[@]}")"
+    seqs="$(shuf -n$((N/8)) -i1-$N)" # trigger changes on 1/8 of all messages
+    doveadm -u "$u" flags "$a" "$f" mailbox "INBOX" "${seqs//$'\n'/,}"
+    sleep "0.0$(shuf -n1 -i10-99)" # 10 to 99ms
+done
+sleep 2
+
+ptree_abort $PID
+trap - EXIT INT TERM
+
+# make sure the list of uids for a given tag match
+flagged_uids() {
+    local u="$1" f="$2"
+    doveadm -u "$u" search mailbox "INBOX" keyword "$f" | cut -d" " -f2 | sort -n
+}
+for f in "${FLAGS[@]}"; do
+    diff --label="local/$f" --label="remote/$f" -u -- \
+        <(flagged_uids "local" "$f") <(flagged_uids "remote" "$f") ||
+        error "UID list differs for keyword '$f'"
+done
+
+# vim: set filetype=sh :
diff --git a/tests/list b/tests/list
index 9ce0c06..8bb4478 100644
--- a/tests/list
+++ b/tests/list
@@ -39,6 +39,7 @@ repair  --repair
     auth-noplaintext        abort when STARTTLS is not offered
 
 compress    COMPRESS=DEFLATE
+condstore   CONDSTORE
 
 . SSL/TLS
     starttls-logindisabled  LOGINDISABLED STARTTLS