diff options
Diffstat (limited to 'imapsync')
-rwxr-xr-x | imapsync | 258 |
1 files changed, 170 insertions, 88 deletions
@@ -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; } |