Add a --check command to verify the synchronization state.

diff --git a/imapsync b/imapsync
index 4ad95f3f6306318cf765cabb11f8876f7593b444..a8c786c45b276668c1513804bc4daee464003e66 100755 (executable)
--- 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 2aff76cd7b57420d8c196db1e7dbc1309ef21f96..21e2fa86e850142a5fa733751c82302af357eb15 100644 (file)
--- 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;
     }