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