Rename '--check' to '--repair' and improve repairing algorithm.

2 files changed, 171 insertions, 89 deletions

diff --git a/imapsync b/imapsync
index 396b355..0aa7a41 100755
--- a/imapsync
+++ b/imapsync
@@ -42,7 +42,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 check/);
+usage(1) unless GetOptions(\%CONFIG, qw/debug help|h config=s quiet|q oneshot|1 repair/);
 usage(0) if $CONFIG{help};
 
 
@@ -568,105 +568,184 @@ my $STH_GET_INTERRUPTED_BY_IDX = $DBH->prepare(q{
 });
 
 
-# Download some missing UIDs.
-sub fix_missing($$$@) {
+# Download some missing UIDs from $source; returns the thew allocated UIDs
+sub download_missing($$$@) {
     my $idx = shift;
     my $mailbox = shift;
-    my $name = shift;
+    my $source = shift;
     my @set = @_;
+    my @uids;
+
+    my $target = $source eq 'local' ? 'remote' : 'local';
 
-    my $source = $name eq 'local' ? $lIMAP : $rIMAP;
-    my $target = $name eq 'local' ? $rIMAP : $lIMAP;
+    my ($buff, $bufflen) = ([], 0);
+    undef $buff if ($target eq 'local' ? $lIMAP : $rIMAP)->incapable('MULTIAPPEND');
 
     my $attrs = join ' ', qw/MODSEQ FLAGS INTERNALDATE ENVELOPE BODY.PEEK[]/;
-    $source->fetch(compact_set(@set), "($attrs)", sub($) {
+    ($source eq 'local' ? $lIMAP : $rIMAP)->fetch(compact_set(@set), "($attrs)", sub($) {
         my $mail = shift;
         return unless exists $mail->{RFC822}; # not for us
 
-        my $suid = $mail->{UID};
+        my $uid = $mail->{UID};
         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 $suid from <$from> ($mail->{INTERNALDATE})\n" unless $CONFIG{quiet};
-
-        # don't bother checking for MULTIAPPEND, @set is probably rather small
-        my ($tuid) = $target->append($mailbox, $mail);
+        print STDERR "$source($mailbox): UID $uid from <$from> ($mail->{INTERNALDATE})\n" unless $CONFIG{quiet};
 
-        my ($lUID, $rUID) = $name eq 'local' ? ($suid, $tuid) : ($tuid, $suid);
-        print STDERR "$name($mailbox): Adding mapping (lUID,rUID) = ($lUID,$rUID)\n";
-        $STH_INSERT_MAPPING->execute($idx, $lUID, $rUID);
+        callback_new_message($idx, $mailbox, $source, $mail, \@uids, $buff, \$bufflen)
     });
+    push @uids, callback_new_message_flush($idx, $mailbox, $source, @$buff) if defined $buff and @$buff;
+    return @uids;
+}
+
+
+# Solve a flag update conflict (by taking the union of the two flag lists).
+sub flag_conflict($$$$$) {
+    my ($mailbox, $lUID, $lFlags, $rUID, $rFlags);
+
+    my %flags = map {$_ => 1} (split(/ /, $lFlags), split(/ /, $rFlags));
+    my $flags = join ' ', sort(keys %flags);
+    warn "WARNING: Conflicting flag update in $mailbox for local UID $lUID ($lFlags) ".
+         "and remote UID $rUID ($rFlags). Setting both to the union ($flags).\n";
+
+    return $flags
+}
+
+
+# Delete a mapping ($idx, $lUID)
+sub delete_mapping($$) {
+    my ($idx, $lUID) = @_;
+    my $r = $STH_DELETE_MAPPING->execute($idx, $lUID);
+    die if $r > 1; # sanity check
+    warn "WARNING: Can't delete (idx,lUID) = ($idx,$lUID) from the database\n" if $r == 0;
 }
 
-# Check synchronization of a mailbox between the two servers (in a very crude way)
-my @CHECKED;
-sub check($$$$$) {
-    my ($idx, $lVanished, $lList, $rVanished, $rList) = @_;
+
+# Check and repair synchronization of a mailbox between the two servers
+# (in a very crude way, by downloading all existing UID with their flags)
+my @REPAIR;
+sub repair($$) {
+    my ($idx, $mailbox) = @_;
+
+    # get all existing UID with their flags
+    my ($lVanished, $lModified) = $lIMAP->pull_updates(1);
+    my ($rVanished, $rModified) = $rIMAP->pull_updates(1);
 
     my %lVanished = map {$_ => 1} @$lVanished;
     my %rVanished = map {$_ => 1} @$rVanished;
 
+    my (@lToRemove, %lToUpdate, @lMissing);
+    my (@rToRemove, %rToUpdate, @rMissing);
+    my @delete_mapping;
+
     $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};
+
+    # process each pair ($lUID,$rUID) found in the mapping table, and
+    # compare with the result from the IMAP servers to detect anomalies
 
     $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};
-                }
+        if (defined $lModified->{$lUID} and defined $rModified->{$rUID}) {
+            # both $lUID and $rUID are known; see sync_known_messages
+            # for the sync algorithm
+            my ($lFlags, $rFlags) = ($lModified->{$lUID}->[1], $rModified->{$rUID}->[1]);
+            if ($lFlags eq $rFlags) {
+                # no conflict
+            }
+            elsif ($lModified->{$lUID}->[0] <= $cache->{lHIGHESTMODSEQ} and
+                   $rModified->{$rUID}->[0] >  $cache->{rHIGHESTMODSEQ}) {
+                # set $lUID to $rFlags
+                $lToUpdate{$rFlags} //= [];
+                push @{$lToUpdate{$rFlags}}, $lUID;
+            }
+            elsif ($lModified->{$lUID}->[0] >  $cache->{lHIGHESTMODSEQ} and
+                   $rModified->{$rUID}->[0] <= $cache->{rHIGHESTMODSEQ}) {
+                # set $rUID to $lFlags
+                $rToUpdate{$lFlags} //= [];
+                push @{$rToUpdate{$lFlags}}, $rUID;
             }
             else {
-                # delete the old stuff
-                delete $lList->{$lUID} if $lList->{$lUID}->[0] <= $cache->{lHIGHESTMODSEQ};
-                delete $rList->{$rUID} if $rList->{$rUID}->[0] <= $cache->{rHIGHESTMODSEQ};
+                # conflict
+                warn "WARNING: Missed flag update in $mailbox for (lUID,rUID) = ($lUID,$rUID). Repairing.\n"
+                    if $lModified->{$lUID}->[0] <= $cache->{lHIGHESTMODSEQ} and
+                       $rModified->{$rUID}->[0] <= $cache->{rHIGHESTMODSEQ};
+                # set both $lUID and $rUID to the union of $lFlags and $rFlags
+                my $flags = flag_conflict($mailbox, $lUID => $lFlags, $rUID => $rFlags);
+                $lToUpdate{$flags} //= [];
+                push @{$lToUpdate{$flags}}, $lUID;
+                $rToUpdate{$flags} //= [];
+                push @{$rToUpdate{$flags}}, $rUID;
             }
         }
-        elsif (!defined $lList->{$lUID} and !defined $rList->{$rUID}) {
+        elsif (!defined $lModified->{$lUID} and !defined $rModified->{$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;
+                warn "WARNING: Pair (lUID,rUID) = ($lUID,$rUID) vanished from $mailbox. Repairing.\n";
+                push @delete_mapping, $lUID;
             }
         }
-        elsif (!defined $lList->{$lUID}) {
-            unless ($lVanished{$lUID}) {
-                warn "local($mailbox): WARNING: No match for remote UID $rUID. Downloading again...\n";
-                push @{$missing{remote}}, $rUID;
-                delete $rList->{$rUID};
+        elsif (!defined $lModified->{$lUID}) {
+            push @delete_mapping, $lUID;
+            if ($lVanished{$lUID}) {
+                push @rToRemove, $rUID;
+            } else {
+                warn "local($mailbox): WARNING: UID $lUID disappeared. Downloading remote UID $rUID again.\n";
+                push @rMissing, $rUID;
             }
         }
-        elsif (!defined $rList->{$rUID}) {
-            unless ($rVanished{$rUID}) {
-                warn "remote($mailbox): WARNING: No match for local UID $lUID. Downloading again...\n";
-                push @{$missing{local}}, $lUID;
-                delete $lList->{$lUID};
+        elsif (!defined $rModified->{$rUID}) {
+            push @delete_mapping, $lUID;
+            if ($rVanished{$rUID}) {
+                push @lToRemove, $lUID;
+            } else {
+                warn "remote($mailbox): WARNING: UID $rUID disappeared. Downloading local UID $lUID again.\n";
+                push @lMissing, $lUID;
             }
         }
-        $lList->{$lUID} = $lList->{$lUID}->[1] if defined $lList->{$lUID};
-        $rList->{$rUID} = $rList->{$rUID}->[1] if defined $rList->{$rUID};
+
+        delete $lModified->{$lUID};
+        delete $lVanished{$lUID};
+        delete $rModified->{$rUID};
+        delete $rVanished{$rUID};
+    }
+
+    # remove messages on the IMAP side; will increase HIGHESTMODSEQ
+    $lIMAP->remove_message(@lToRemove) if @lToRemove;
+    $rIMAP->remove_message(@rToRemove) if @rToRemove;
+
+    # remove entries in the table
+    delete_mapping($idx, $_) foreach @delete_mapping;
+    $DBH->commit() if @delete_mapping;
+
+    # push flag updates; will increase HIGHESTMODSEQ
+    while (my ($lFlags,$lUIDs) = each %lToUpdate) {
+        $lIMAP->push_flag_updates($lFlags, @$lUIDs);
+    }
+    while (my ($rFlags,$rUIDs) = each %rToUpdate) {
+        $rIMAP->push_flag_updates($rFlags, @$rUIDs);
+    }
+
+
+    # Process UID found in IMAP but not in the mapping table.
+    warn "remote($mailbox): WARNING: No match for vanished local UID $_. Ignoring.\n" foreach keys %lVanished;
+    warn "local($mailbox): WARNING: No match for vanished remote UID $_. Ignoring.\n" foreach keys %rVanished;
+
+    foreach my $lUID (keys %$lModified) {
+        warn "remote($mailbox): WARNING: No match for modified local UID $lUID. Downloading again.\n";
+        push @lMissing, $lUID;
+    }
+    foreach my $rUID (keys %$rModified) {
+        warn "local($mailbox): WARNING: No match for modified remote UID $rUID. Downloading again.\n";
+        push @rMissing, $rUID;
     }
 
-    # we'll complain later for modified UIDs without an entry in the database
+    # download missing UIDs; will increase UIDNEXT and HIGHESTMODSEQ
+    my @rIgnore = download_missing($idx, $mailbox, 'local',  @lMissing) if @lMissing;
+    my @lIgnore = download_missing($idx, $mailbox, 'remote', @rMissing) if @rMissing;
 
-    @$lVanished = keys %lVanished;
-    @$rVanished = keys %rVanished;
-    push @CHECKED, $idx;
-    return %missing;
+    # download new messages; this will also update UIDNEXT and HIGHESTMODSEQ in the database
+    sync_messages($idx, $mailbox, \@lIgnore, \@rIgnore);
 }
 
 
@@ -680,15 +759,13 @@ sub sync_known_messages($$) {
 
     # loop since processing might produce VANISHED or unsollicited FETCH responses
     while (1) {
-        my ($lVanished, $lModified, $rVanished, $rModified, %missing);
+        my ($lVanished, $lModified, $rVanished, $rModified);
 
-        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;
+        ($lVanished, $lModified) = $lIMAP->pull_updates();
+        ($rVanished, $rModified) = $rIMAP->pull_updates();
 
         # repeat until we have nothing pending
-        return $update unless %$lModified or %$rModified or @$lVanished or @$rVanished or %missing;
+        return $update unless %$lModified or %$rModified or @$lVanished or @$rVanished;
         $update = 1;
 
         # process VANISHED messages
@@ -707,7 +784,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 "remote($mailbox): WARNING: No match for local vanished UID $lUID. Ignoring...\n";
+                    warn "remote($mailbox): WARNING: No match for vanished local UID $lUID. Ignoring.\n";
                 }
                 elsif (!exists $rVanished{$rUID}) {
                     push @rToRemove, $rUID;
@@ -718,7 +795,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 "local($mailbox): WARNING: No match for remote vanished UID $rUID. Ignoring...\n";
+                    warn "local($mailbox): WARNING: No match for vanished remote UID $rUID. Ignoring.\n";
                 }
                 elsif (!exists $lVanished{$lUID}) {
                     push @lToRemove, $lUID;
@@ -730,9 +807,7 @@ sub sync_known_messages($$) {
 
             # remove existing mappings
             foreach my $lUID (@$lVanished, @lToRemove) {
-                my $r = $STH_DELETE_MAPPING->execute($idx, $lUID);
-                die if $r > 1; # sanity check
-                warn "WARNING: Can't delete (idx,lUID) = ($idx,$lUID) from the database\n" if $r == 0;
+                delete_mapping($idx, $lUID);
             }
         }
 
@@ -755,15 +830,11 @@ 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 "remote($mailbox): WARNING: No match for local updated UID $lUID. Downloading again...\n";
-                    push @{$missing{local}}, $lUID;
+                    warn "remote($mailbox): WARNING: No match for modified local UID $lUID. Try '--repair'.\n";
                 }
                 elsif (defined (my $rFlags = $rModified->{$rUID})) {
                     unless ($lFlags eq $rFlags) {
-                        my %flags = map {$_ => 1} (split(/ /, $lFlags), split(/ /, $rFlags));
-                        my $flags = join ' ', sort(keys %flags);
-                        warn "WARNING: Conflicting flag update in $mailbox for local UID $lUID ($lFlags) ".
-                             "and remote UID $rUID ($rFlags). Setting both to the union ($flags).\n";
+                        my $flags = flag_conflict($mailbox, $lUID => $lFlags, $rUID => $rFlags);
                         $lToUpdate{$flags} //= [];
                         push @{$lToUpdate{$flags}}, $lUID;
                         $rToUpdate{$flags} //= [];
@@ -780,8 +851,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 "local($mailbox): WARNING: No match for remote updated UID $rUID. Downloading again...\n";
-                    push @{$missing{remote}}, $rUID;
+                    warn "local($mailbox): WARNING: No match for modified remote UID $rUID. Try '--repair'.\n";
                 }
                 elsif (!exists $lModified->{$lUID}) {
                     # conflicts are taken care of above
@@ -790,9 +860,6 @@ 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);
             }
@@ -952,9 +1019,7 @@ while (defined (my $row = $STH_LIST_INTERRUPTED->fetchrow_arrayref())) {
         push @lToRemove, $lUID if $lList{$lUID};
         push @rToRemove, $rUID if $rList{$rUID};
 
-        my $r = $STH_DELETE_MAPPING->execute($IDX, $lUID);
-        die if $r > 1; # sanity check
-        warn "WARNING: Can't delete (idx,lUID) = ($IDX,$lUID) from the database\n" if $r == 0;
+        delete_mapping($IDX, $lUID);
     }
 
     $lIMAP->remove_message(@lToRemove) if @lToRemove;
@@ -981,15 +1046,32 @@ while (defined (my $row = $STH_GET_CACHE->fetchrow_hashref())) {
     $lIMAP->set_cache($row->{mailbox},
         UIDVALIDITY   => $row->{lUIDVALIDITY},
         UIDNEXT       => $row->{lUIDNEXT},
-        HIGHESTMODSEQ => ($CONFIG{check} ? 0 : $row->{lHIGHESTMODSEQ})
+        HIGHESTMODSEQ => $row->{lHIGHESTMODSEQ}
     );
     $rIMAP->set_cache($row->{mailbox},
         UIDVALIDITY   => $row->{rUIDVALIDITY},
         UIDNEXT       => $row->{rUIDNEXT},
-        HIGHESTMODSEQ => ($CONFIG{check} ? 0 : $row->{rHIGHESTMODSEQ})
+        HIGHESTMODSEQ => $row->{rHIGHESTMODSEQ}
     );
+    push @REPAIR, $row->{mailbox} if $CONFIG{repair} and
+        (!@ARGV or grep { $_ eq $row->{mailbox} } @ARGV);
 }
 
+while (@REPAIR) {
+    $MAILBOX = shift @REPAIR;
+    unless (defined $MAILBOX) {
+        cleanup();
+        exit 0;
+    }
+
+    $STH_GET_INDEX->execute($MAILBOX);
+    ($IDX) = $STH_GET_INDEX->fetchrow_array();
+    die if defined $STH_GET_INDEX->fetch(); # sanity check
+
+    $lIMAP->select($MAILBOX);
+    $rIMAP->select($MAILBOX);
+    repair($IDX, $MAILBOX);
+}
 
 
 while(1) {
@@ -1035,7 +1117,7 @@ while(1) {
         }
     }
     # clean state!
-    if ($CONFIG{oneshot} or $CONFIG{check}) {
+    if ($CONFIG{oneshot}) {
         cleanup();
         exit 0;
     }
diff --git a/lib/Net/IMAP/Sync.pm b/lib/Net/IMAP/Sync.pm
index c3af4fa..362d436 100644
--- a/lib/Net/IMAP/Sync.pm
+++ b/lib/Net/IMAP/Sync.pm
@@ -568,7 +568,7 @@ sub list($$@) {
 }
 
 
-# $self->remove($uid, [...])
+# $self->remove_message($uid, [...])
 #   Remove the given $uid list.  Croak if the server did not advertize
 #   "UIDPLUS" (RFC 4315) in its CAPABILITY list.
 #   Successfully EXPUNGEd UIDs are removed from the pending VANISHED and