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]") });
 }