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