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.

1 files changed, 24 insertions, 34 deletions

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;
 }