Avoid sending large UID EXPUNGE|FETCH|STORE and APPEND commands.

UID EXPUNGE|FETCH|STORE commands are now split into multiple (sequential)
commands when their set representation exceeds 4096 bytes in size.  Without
splitting logic set representations could grow arbitrarily large, and
exceed the server's maximum command size.

This adds roundtrips which could be eliminated by pipelining, but it's
unlikely to make any difference in typical synchronization work.  While set
representations seem to remain small in practice, they might grow
significantly if many non-contiguous UIDs were flagged and/or expunged, and
later synchronized at once.

Furthermore, for MULTIAPPEND-capable servers, the number of messages is
limited to 128 per APPEND command (also subject to a combined literal size of
1MiB like before).

These numbers are currently not configurable.  They're intentionally lower
than Dovecot's default maximum command size (64k) in order to avoid a
deadlock situation after sending 8k-long commands under COMPRESS=DEFLATE:
https://dovecot.org/pipermail/dovecot/2019-November/117522.html .

1 files changed, 43 insertions, 21 deletions

diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index e595060..02ae65f 100644
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -203,6 +203,21 @@ sub compact_list(@) {
     return $set;
 }
 
+# with_set($set, $cmd)
+#   Split long commands over multiple subsets to avoid exceeding the server limit
+sub with_set($&) {
+    my ($set, $cmd) = @_;
+    my $max_length = 4096;
+    for (my $length = length($set); $length > $max_length;) {
+        my $l = rindex($set, ',', $max_length);
+        die unless $l > 0; # sanity check
+        $cmd->(substr($set, 0, $l));
+        $set = substr($set, ++$l);
+        $length -= $l;
+    }
+    return $cmd->($set);
+}
+
 
 # in_set($x, $set)
 #   Return true if the UID or sequence number $x belongs to the set $set.
@@ -841,9 +856,10 @@ sub remove_message($@) {
     $self->fail("Server did not advertise UIDPLUS (RFC 4315) capability.")
         unless $self->_capable('UIDPLUS');
 
-    my $set = compact_set(@set);
-    $self->_send("UID STORE $set +FLAGS.SILENT (\\Deleted)");
-    $self->_send("UID EXPUNGE $set"); # RFC 4315 UIDPLUS
+    with_set(compact_set(@set), sub($) {
+        $self->_send("UID STORE $_[0] +FLAGS.SILENT (\\Deleted)");
+        $self->_send("UID EXPUNGE $_[0]"); # RFC 4315 UIDPLUS
+    });
 
     my %vanished = map {$_ => 1} @{$self->{_VANISHED}};
 
@@ -960,7 +976,9 @@ sub append($$@) {
 #   optional $callback.
 sub fetch($$$;&) {
     my ($self, $set, $flags, $callback) = @_;
-    $self->_send("UID FETCH $set $flags", $callback);
+    return with_set($set, sub($) {
+        $self->_send("UID FETCH $_[0] $flags", $callback);
+    });
 }
 
 
@@ -1217,7 +1235,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;
+        with_set(compact_set(@missing), sub($) {
+            $self->_send("UID FETCH $_[0] (MODSEQ FLAGS)")
+        }) if @missing;
     }
 
     # do that afterwards since the UID FETCH command above can produce VANISHED responses
@@ -1279,7 +1299,7 @@ sub pull_new_messages($$&@) {
         $range .= "$since:4294967295";
 
         $UIDNEXT = $cache->{UIDNEXT} // $self->panic(); # sanity check
-        $self->_send("UID FETCH $range ($attrs)", sub($) {
+        $self->fetch($range, "($attrs)", sub($) {
             my $mail = shift;
             $UIDNEXT = $mail->{UID} + 1 if $UIDNEXT <= $mail->{UID};
             $callback->($mail) if defined $callback;
@@ -1307,22 +1327,23 @@ 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)." (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/) {
-                my ($min, $max) = $1 < $2 ? ($1,$2) : ($2,$1);
-                $failed{$_} = 1 foreach ($min .. $max);
-            } else {
-                $self->panic($_);
+    with_set(compact_set(@set), sub($) {
+        $self->_send("UID STORE $_[0] (UNCHANGEDSINCE $modseq) FLAGS.SILENT ($flags)");
+        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/) {
+                    my ($min, $max) = $1 < $2 ? ($1,$2) : ($2,$1);
+                    $failed{$_} = 1 foreach ($min .. $max);
+                } else {
+                    $self->panic($_);
+                }
             }
         }
-    }
+    });
 
     my @ok;
     foreach my $uid (@set) {
@@ -1360,8 +1381,9 @@ sub push_flag_updates($$@) {
 sub silent_store($$$@) {
     my $self = shift;
     my $set = shift;
-    my $mod = shift;
-    $self->_send("UID STORE $set ${mod}FLAGS.SILENT (".join(' ', @_).")");
+    my $subcmd = shift . "FLAGS.SILENT";
+    my $flags = join(' ', @_);
+    with_set($set, sub($) { $self->_send("UID STORE $_[0] $subcmd ($flags)") });
 }
 
 
@@ -1374,7 +1396,7 @@ sub expunge($$) {
 
     $self->fail("Server did not advertise UIDPLUS (RFC 4315) capability.")
         unless $self->_capable('UIDPLUS');
-    $self->_send("UID EXPUNGE $set");
+    with_set($set, sub($) { $self->_send("UID EXPUNGE $_[0]") });
 }