From 7d5e16c835b0444330d424a98924dbd13523087f Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Fri, 24 Jul 2015 01:21:17 +0200 Subject: [PATCH] Add a --check command to verify the synchronization state. --- imapsync | 156 +++++++++++++++++++++++++++++++++++++------ lib/Net/IMAP/Sync.pm | 27 ++++++-- 2 files changed, 158 insertions(+), 25 deletions(-) diff --git a/imapsync b/imapsync index 4ad95f3..a8c786c 100755 --- a/imapsync +++ b/imapsync @@ -43,7 +43,7 @@ sub usage(;$) { print STDERR "TODO $NAME usage\n"; exit $rv; } -usage(1) unless GetOptions(\%CONFIG, qw/debug help|h config=s quiet|q oneshot|1/); +usage(1) unless GetOptions(\%CONFIG, qw/debug help|h config=s quiet|q oneshot|1 check/); usage(0) if $CONFIG{help}; @@ -518,6 +518,13 @@ my $STH_GET_CACHE = $DBH->prepare(q{ r.UIDVALIDITY as rUIDVALIDITY, r.UIDNEXT as rUIDNEXT, r.HIGHESTMODSEQ as rHIGHESTMODSEQ FROM mailboxes m JOIN local l ON m.idx = l.idx JOIN remote r ON m.idx = r.idx }); +my $STH_GET_CACHE_BY_IDX = $DBH->prepare(q{ + SELECT mailbox, + l.UIDVALIDITY as lUIDVALIDITY, l.UIDNEXT as lUIDNEXT, l.HIGHESTMODSEQ as lHIGHESTMODSEQ, + r.UIDVALIDITY as rUIDVALIDITY, r.UIDNEXT as rUIDNEXT, r.HIGHESTMODSEQ as rHIGHESTMODSEQ + FROM mailboxes m JOIN local l ON m.idx = l.idx JOIN remote r ON m.idx = r.idx + WHERE m.idx = ? +}); # Get the index associated with a mailbox. my $STH_GET_INDEX = $DBH->prepare(q{SELECT idx FROM mailboxes WHERE mailbox = ?}); @@ -544,8 +551,9 @@ my $STH_NEWMAILBOX = $DBH->prepare(q{INSERT INTO mailboxes (mailbox,subscribed) my $STH_INSERT_LOCAL = $DBH->prepare(q{INSERT INTO local (idx,UIDVALIDITY,UIDNEXT,HIGHESTMODSEQ) VALUES (?,?,?,?)}); my $STH_INSERT_REMOTE = $DBH->prepare(q{INSERT INTO remote (idx,UIDVALIDITY,UIDNEXT,HIGHESTMODSEQ) VALUES (?,?,?,?)}); -# Insert a (idx,lUID,rUID) association. -my $STH_INSERT_MAPPING = $DBH->prepare("INSERT INTO mapping (idx,lUID,rUID) VALUES (?,?,?)"); +# Insert or retrieve a (idx,lUID,rUID) association. +my $STH_INSERT_MAPPING = $DBH->prepare(q{INSERT INTO mapping (idx,lUID,rUID) VALUES (?,?,?)}); +my $STH_GET_MAPPING = $DBH->prepare(q{SELECT lUID,rUID FROM mapping WHERE idx = ?}); # Initialize $lIMAP and $rIMAP states to detect mailbox dirtyness. @@ -554,31 +562,136 @@ while (defined (my $row = $STH_GET_CACHE->fetchrow_hashref())) { $lIMAP->set_cache($row->{mailbox}, UIDVALIDITY => $row->{lUIDVALIDITY}, UIDNEXT => $row->{lUIDNEXT}, - HIGHESTMODSEQ => $row->{lHIGHESTMODSEQ} + HIGHESTMODSEQ => ($CONFIG{check} ? 0 : $row->{lHIGHESTMODSEQ}) ); $rIMAP->set_cache($row->{mailbox}, UIDVALIDITY => $row->{rUIDVALIDITY}, UIDNEXT => $row->{rUIDNEXT}, - HIGHESTMODSEQ => $row->{rHIGHESTMODSEQ} + HIGHESTMODSEQ => ($CONFIG{check} ? 0 : $row->{rHIGHESTMODSEQ}) ); } +# Download some missing UIDs. +sub fix_missing($$$@) { + my $idx = shift; + my $mailbox = shift; + my $name = shift; + my @set = @_; + + my $source = $name eq 'local' ? $lIMAP : $rIMAP; + my $target = $name eq 'local' ? $rIMAP : $lIMAP; + + my $attrs = join ' ', qw/MODSEQ FLAGS INTERNALDATE ENVELOPE BODY.PEEK[]/; + $source->fetch(compact_set(@set), "($attrs)", sub(%) { + my %mail = @_; + return unless exists $mail{RFC822}; # not for us + + my $from = first { defined $_ and @$_ } @{$mail{ENVELOPE}}[2,3,4]; + $from = (defined $from and @$from) ? $from->[0]->[2].'@'.$from->[0]->[3] : ''; + print STDERR "$name($mailbox): UID $mail{UID} from <$from> ($mail{INTERNALDATE})\n" unless $CONFIG{quiet}; + + # don't bother checking for MULTIAPPEND, @set is probably rather small + my @mail = ($mail{RFC822}, [ grep {lc $_ ne '\recent'} @{$mail{FLAGS}} ], $mail{INTERNALDATE}); + my ($uid) = $target->append($mailbox, @mail); + + my ($lUID, $rUID) = $name eq 'local' ? ($mail{UID}, $uid) : ($uid, $mail{UID}); + print STDERR "$name($mailbox): Adding mapping (lUID,rUID) = ($lUID,$rUID)\n"; + $STH_INSERT_MAPPING->execute($idx, $lUID, $rUID); + }); +} + +# Check synchronization of a mailbox between the two servers (in a very crude way) +my @CHECKED; +sub check($$$$$) { + my ($idx, $lVanished, $lList, $rVanished, $rList) = @_; + + my %lVanished = map {$_ => 1} @$lVanished; + my %rVanished = map {$_ => 1} @$rVanished; + + $STH_GET_CACHE_BY_IDX->execute($idx); + my $cache = $STH_GET_CACHE_BY_IDX->fetchrow_hashref() // die "Missing cache for index $idx"; + die if defined $STH_GET_CACHE_BY_IDX->fetch(); # sanity check + my $mailbox = $cache->{mailbox}; + + $STH_GET_MAPPING->execute($idx); + my %missing = ( local => [], remote => [] ); + while (defined (my $row = $STH_GET_MAPPING->fetch())) { + my ($lUID, $rUID) = @$row; + if (defined $lList->{$lUID} and defined $rList->{$rUID}) { + # both $lUID and $rUID are known + if ($lList->{$lUID}->[0] <= $cache->{lHIGHESTMODSEQ} and + $rList->{$rUID}->[0] <= $cache->{rHIGHESTMODSEQ}) { + # old stuff + if ($lList->{$lUID}->[1] ne $rList->{$rUID}->[1]) { + warn "WARNING: Missed flag update in $mailbox for (lUID,rUID) = ($lUID,$rUID). Fixing...\n"; + # keep it in the hash references so we fix it automatically + } + else { + # no conflict, remove it from the hashes + delete $lList->{$lUID}; + delete $rList->{$rUID}; + } + } + else { + # delete the old stuff + delete $lList->{$lUID} if $lList->{$lUID}->[0] <= $cache->{lHIGHESTMODSEQ}; + delete $rList->{$rUID} if $rList->{$rUID}->[0] <= $cache->{rHIGHESTMODSEQ}; + } + } + elsif (!defined $lList->{$lUID} and !defined $rList->{$rUID}) { + unless ($lVanished{$lUID} and $rVanished{$rUID}) { + # will be deleted from the database later + warn "WARNING: Pair (lUID,rUID) = ($lUID,$rUID) vanished from $mailbox\n"; + $lVanished{$lUID} = 1; + $rVanished{$rUID} = 1; + } + } + elsif (!defined $lList->{$lUID}) { + unless ($lVanished{$lUID}) { + warn "WARNING: local($mailbox): No match for remote UID $rUID. Downloading again...\n"; + push @{$missing{remote}}, $rUID; + delete $rList->{$rUID}; + } + } + elsif (!defined $rList->{$rUID}) { + unless ($rVanished{$rUID}) { + warn "WARNING: remote($mailbox): No match for local UID $lUID. Downloading again...\n"; + push @{$missing{local}}, $lUID; + delete $lList->{$lUID}; + } + } + $lList->{$lUID} = $lList->{$lUID}->[1] if defined $lList->{$lUID}; + $rList->{$rUID} = $rList->{$rUID}->[1] if defined $rList->{$rUID}; + } + + # we'll complain later for modified UIDs without an entry in the database + + @$lVanished = keys %lVanished; + @$rVanished = keys %rVanished; + push @CHECKED, $idx; + return %missing; +} + # Sync known messages. Since pull_updates is the last method call on # $lIMAP and $rIMAP, it is safe to call get_cache on either object after # this function, in order to update the HIGHESTMODSEQ. # Return true if an update was detected, and false otherwise -sub sync_known_messages($) { - my $idx = shift; +sub sync_known_messages($$) { + my ($idx, $mailbox) = @_; my $update = 0; # loop since processing might produce VANISHED or unsollicited FETCH responses while (1) { - my ($lVanished, $lModified) = $lIMAP->pull_updates(); - my ($rVanished, $rModified) = $rIMAP->pull_updates(); + my ($lVanished, $lModified, $rVanished, $rModified, %missing); + + my $check = ($CONFIG{check} and !grep { $idx == $_} @CHECKED) ? 1 : 0; + ($lVanished, $lModified) = $lIMAP->pull_updates($check); + ($rVanished, $rModified) = $rIMAP->pull_updates($check); + %missing = check($idx, $lVanished, $lModified, $rVanished, $rModified) if $check; # repeat until we have nothing pending - return $update unless %$lModified or %$rModified or @$lVanished or @$rVanished; + return $update unless %$lModified or %$rModified or @$lVanished or @$rVanished or %missing; $update = 1; # process VANISHED messages @@ -597,7 +710,7 @@ sub sync_known_messages($) { my ($rUID) = $STH_GET_REMOTE_UID->fetchrow_array(); die if defined $STH_GET_REMOTE_UID->fetchrow_arrayref(); # sanity check if (!defined $rUID) { - warn "WARNING: Couldn't find a matching rUID for (idx,lUID) = ($idx,$lUID)\n"; + warn "WARNING: remote($mailbox): No match for local vanished UID $lUID. Ignoring...\n"; } elsif (!exists $rVanished{$rUID}) { push @rToRemove, $rUID; @@ -608,7 +721,7 @@ sub sync_known_messages($) { my ($lUID) = $STH_GET_LOCAL_UID->fetchrow_array(); die if defined $STH_GET_LOCAL_UID->fetchrow_arrayref(); # sanity check if (!defined $lUID) { - warn "WARNING: Couldn't find a matching lUID for (idx,rUID) = ($idx,$rUID)\n"; + warn "WARNING: local($mailbox): No match for remote vanished UID $rUID. Ignoring...\n"; } elsif (!exists $lVanished{$lUID}) { push @lToRemove, $lUID; @@ -622,7 +735,7 @@ sub sync_known_messages($) { foreach my $lUID (@$lVanished, @lToRemove) { my $r = $STH_DELETE_MAPPING->execute($idx, $lUID); die if $r > 1; # sanity check - warn "WARNING: Couldn't delete (idx,lUID) pair ($idx,$lUID)\n" if $r == 0; + warn "WARNING: Can't delete (idx,lUID) = ($idx,$lUID) from the database\n" if $r == 0; } } @@ -645,7 +758,8 @@ sub sync_known_messages($) { my ($rUID) = $STH_GET_REMOTE_UID->fetchrow_array(); die if defined $STH_GET_REMOTE_UID->fetchrow_arrayref(); # sanity check if (!defined $rUID) { - warn "WARNING: Couldn't find a matching rUID for (idx,lUID) = ($idx,$lUID)\n"; + warn "WARNING: remote($mailbox): No match for local updated UID $lUID. Downloading again...\n"; + push @{$missing{local}}, $lUID; } elsif (defined (my $rFlags = $rModified->{$rUID})) { unless ($lFlags eq $rFlags) { @@ -669,7 +783,8 @@ sub sync_known_messages($) { my ($lUID) = $STH_GET_LOCAL_UID->fetchrow_array(); die if defined $STH_GET_LOCAL_UID->fetchrow_arrayref(); # sanity check if (!defined $lUID) { - warn "WARNING: Couldn't find a matching rUID for (idx,rUID) = ($idx,$rUID)\n"; + warn "WARNING: local($mailbox): No match for remote updated UID $rUID. Downloading again...\n"; + push @{$missing{remote}}, $rUID; } elsif (!exists $lModified->{$lUID}) { # conflicts are taken care of above @@ -678,6 +793,9 @@ sub sync_known_messages($) { } } + fix_missing($idx, $mailbox, 'local', @{$missing{local}}) if @{$missing{local} // []}; + fix_missing($idx, $mailbox, 'remote', @{$missing{remote}}) if @{$missing{remote} // []}; + while (my ($lFlags,$lUIDs) = each %lToUpdate) { $lIMAP->push_flag_updates($lFlags, @$lUIDs); } @@ -750,13 +868,13 @@ sub sync_messages($$) { die if !defined $$idx or defined $STH_GET_INDEX->fetchrow_arrayref(); # sanity check # there might be flag updates pending - sync_known_messages($$idx); + sync_known_messages($$idx, $mailbox); $STH_INSERT_LOCAL->execute($$idx, $lIMAP->get_cache(qw/UIDVALIDITY UIDNEXT HIGHESTMODSEQ/)); $STH_INSERT_REMOTE->execute($$idx, $rIMAP->get_cache(qw/UIDVALIDITY UIDNEXT HIGHESTMODSEQ/)); } else { # update known mailbox - sync_known_messages($$idx); + sync_known_messages($$idx, $mailbox); $STH_UPDATE_LOCAL->execute($lIMAP->get_cache( qw/UIDNEXT HIGHESTMODSEQ/), $$idx); $STH_UPDATE_REMOTE->execute($rIMAP->get_cache(qw/UIDNEXT HIGHESTMODSEQ/), $$idx); } @@ -809,7 +927,7 @@ while(1) { $rIMAP->select($mailbox); # sync updates to known messages before fetching new messages - if (defined $idx and sync_known_messages($idx)) { + if (defined $idx and sync_known_messages($idx, $mailbox)) { # get_cache is safe after pull_update $STH_UPDATE_LOCAL_HIGHESTMODSEQ->execute( $lIMAP->get_cache('HIGHESTMODSEQ'), $idx); $STH_UPDATE_REMOTE_HIGHESTMODSEQ->execute($rIMAP->get_cache('HIGHESTMODSEQ'), $idx); @@ -819,7 +937,7 @@ while(1) { } } # clean state! - exit 0 if $CONFIG{oneshot}; + exit 0 if $CONFIG{oneshot} or $CONFIG{check}; wait_notifications(900); } diff --git a/lib/Net/IMAP/Sync.pm b/lib/Net/IMAP/Sync.pm index 2aff76c..21e2fa8 100644 --- a/lib/Net/IMAP/Sync.pm +++ b/lib/Net/IMAP/Sync.pm @@ -682,6 +682,15 @@ sub append($$$@) { } +# $self->fetch($set, $flags, [$callback]) +# Issue an UID FETCH command with the given UID $set, $flags, and +# optional $callback. +sub fetch($$$$) { + my ($self, $set, $flags, $callback) = @_; + $self->_send("UID FETCH $set $flags", $callback); +} + + # $self->notify(@specifications) # Issue a NOTIFY command with the given mailbox @specifications (cf RFC # 5465 section 6) to be monitored. Croak if the server did not @@ -832,13 +841,16 @@ sub next_dirty_mailbox($@) { } -# $self->pull_updates() +# $self->pull_updates([$full]) +# If $full is set, FETCH FLAGS and MODSEQ for each UID up to +# UIDNEXT-1. # Get pending updates (unprocessed VANISHED responses and FLAG # updates), and empty these lists from the cache. # Finally, update the HIGHESTMODSEQ from the persistent cache to the # value found in the internal cache. -sub pull_updates($) { +sub pull_updates($;$) { my $self = shift; + my $full = shift // 0; my $mailbox = $self->{_SELECTED} // $self->panic(); my $pcache = $self->{_PCACHE}->{$mailbox}; @@ -848,6 +860,9 @@ sub pull_updates($) { $self->{_VANISHED} = []; } else { + $self->_send("UID FETCH 1:".($pcache->{UIDNEXT}-1)." (MODSEQ FLAGS)") + if $full and $pcache->{UIDNEXT} > 1; + my @missing; while (%{$self->{_MODIFIED}}) { while (my ($uid,$v) = each %{$self->{_MODIFIED}}) { @@ -855,9 +870,9 @@ sub pull_updates($) { # 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} # out of bounds - and $v->[0] > $pcache->{HIGHESTMODSEQ}; # already seen - $modified{$uid} = $v->[1]; + next unless $uid < $pcache->{UIDNEXT} # out of bounds + and ($full or $v->[0] > $pcache->{HIGHESTMODSEQ}); # already seen + $modified{$uid} = $full ? $v : $v->[1]; } else { push @missing, $uid; } @@ -996,7 +1011,7 @@ sub push_flag_updates($$@) { } unless ($self->{quiet}) { - $self->log("Updated flags ($flags) for UID ".compact_set(@ok)); + $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; } -- 2.39.2