diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/Net/IMAP/InterIMAP.pm | 58 |
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; } |