aboutsummaryrefslogtreecommitdiffstats
path: root/lib/Net
diff options
context:
space:
mode:
authorGuilhem Moulin <guilhem@fripost.org>2019-11-12 01:39:29 +0100
committerGuilhem Moulin <guilhem@fripost.org>2019-11-13 06:23:57 +0100
commit3aa5593af18bd4925235d1820fd0fe7c646843aa (patch)
tree717aa3b1f6ffb2685a901f42f6a89fd6936c7c84 /lib/Net
parentc3bf5d306ff1396d6117774316afd998f6e9874a (diff)
Net::IMAP::InterIMAP::push_flag_updates() bugfixes.
The UNCHANGEDSINCE test from the CONDSTORE extension was incorrectly placed after the flag list in UID STORE commands. In practice this meant the server didn't add the MODIFIED code when needed. The server won't send an untagged FETCH command (and won't increase the message's MODSEQ) if no change was made to the flag list. A panic() was incorrectly triggered in that case. When the flag list was set (by another client) to a superset of the UID STORE command currently processed, the extra flags were not synchronized. Cf. RFC 7162 sec. 3.1.3 ex. 10.
Diffstat (limited to 'lib/Net')
-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;
}