aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/Net/IMAP/InterIMAP.pm64
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]") });
}