diff options
author | Guilhem Moulin <guilhem@fripost.org> | 2015-07-25 18:56:19 +0200 |
---|---|---|
committer | Guilhem Moulin <guilhem@fripost.org> | 2015-07-25 18:56:19 +0200 |
commit | dff9d2b460e543edad3726c3637145c2733515f8 (patch) | |
tree | c2c88866a2fc3e2ef8c17ef4f14c86c90618b82c /imapsync | |
parent | 0cef7480d009ba721db43b3212f7b884fe95b8f8 (diff) | |
parent | ea6122775d01460c3bf9f73bb7b15b5084623dfa (diff) |
Merge branch 'master' into debian
Diffstat (limited to 'imapsync')
-rwxr-xr-x | imapsync | 592 |
1 files changed, 389 insertions, 203 deletions
@@ -1,7 +1,7 @@ #!/usr/bin/perl -T #---------------------------------------------------------------------- -# A minimal IMAP4 client for QRESYNC-capable servers +# IMAP-to-IMAP synchronization program for QRESYNC-capable servers # Copyright © 2015 Guilhem Moulin <guilhem@fripost.org> # # This program is free software: you can redistribute it and/or modify @@ -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}; @@ -69,17 +69,16 @@ my ($DBFILE, $LOCKFILE); $LOCKFILE = $DBFILE =~ s/([^\/]+)\z/.$1.lck/r; } -my ($DBH, $IMAP); - +my $DBH; # Clean after us -sub clean() { - print STDERR "Cleaning...\n" if $CONFIG{debug}; +sub cleanup() { + print STDERR "Cleaning up...\n" if $CONFIG{debug}; unlink $LOCKFILE if defined $LOCKFILE and -f $LOCKFILE; - undef $_ foreach grep defined, map {$IMAP->{$_}->{client}} keys %$IMAP; $DBH->disconnect() if defined $DBH; } -$SIG{$_} = sub { clean(); die "$!\n"; } foreach qw/INT TERM/; +$SIG{$_} = sub { cleanup(); print STDERR "$!\n"; exit 1; } foreach qw/INT TERM/; +$SIG{$_} = sub { cleanup(); print STDERR "$!\n"; exit 0; } foreach qw/HUP/; ############################################################################# @@ -122,15 +121,15 @@ $DBH->do('PRAGMA foreign_keys = ON'); local => [ q{idx INTEGER NOT NULL PRIMARY KEY REFERENCES mailboxes(idx)}, q{UIDVALIDITY UNSIGNED INT NOT NULL CHECK (UIDVALIDITY > 0)}, - q{UIDNEXT UNSIGNED INT NOT NULL CHECK (UIDNEXT > 0)}, - q{HIGHESTMODSEQ UNSIGNED BIGINT NOT NULL CHECK (HIGHESTMODSEQ > 0)} + q{UIDNEXT UNSIGNED INT NOT NULL}, # 0 initially + q{HIGHESTMODSEQ UNSIGNED BIGINT NOT NULL} # 0 initially # one-to-one correspondence between local.idx and remote.idx ], remote => [ q{idx INTEGER NOT NULL PRIMARY KEY REFERENCES mailboxes(idx)}, q{UIDVALIDITY UNSIGNED INT NOT NULL CHECK (UIDVALIDITY > 0)}, - q{UIDNEXT UNSIGNED INT NOT NULL CHECK (UIDNEXT > 0)}, - q{HIGHESTMODSEQ UNSIGNED BIGINT NOT NULL CHECK (HIGHESTMODSEQ > 0)} + q{UIDNEXT UNSIGNED INT NOT NULL}, # 0 initially + q{HIGHESTMODSEQ UNSIGNED BIGINT NOT NULL} # 0 initially # one-to-one correspondence between local.idx and remote.idx ], mapping => [ @@ -139,7 +138,7 @@ $DBH->do('PRAGMA foreign_keys = ON'); q{rUID UNSIGNED INT NOT NULL CHECK (rUID > 0)}, q{PRIMARY KEY (idx,lUID)}, q{UNIQUE (idx,rUID)} - # also, lUID < local.UIDNEXT and rUID < remote.UIDNEXT + # also, lUID < local.UIDNEXT and rUID < remote.UIDNEXT (except for interrupted syncs) # mapping.idx must be found among local.idx (and remote.idx) ], ); @@ -176,6 +175,7 @@ sub msg($@) { ############################################################################# # Connect to the local and remote IMAP servers +my $IMAP; foreach my $name (qw/local remote/) { my %config = %{$CONF->{$name}}; $config{$_} = $CONFIG{$_} foreach keys %CONFIG; @@ -406,7 +406,7 @@ sub sync_tree($$%) { my %mailboxes; $mailboxes{$_} = 1 foreach (keys %{$IMAP->{local}->{mailboxes}}, keys %{$IMAP->{remote}->{mailboxes}}); foreach my $mbx (keys %mailboxes) { - die "Could not sync mailbox list.\n" if exists_mbx('local',$mbx) xor exists_mbx('remote',$mbx); + die "Couldn't sync mailbox list.\n" if exists_mbx('local',$mbx) xor exists_mbx('remote',$mbx); } } } @@ -531,8 +531,7 @@ my $STH_GET_LOCAL_UID = $DBH->prepare(q{SELECT lUID FROM mapping WHERE idx = ? my $STH_GET_REMOTE_UID = $DBH->prepare(q{SELECT rUID FROM mapping WHERE idx = ? and lUID = ?}); # Delete a (idx,lUID,rUID) association. -# /!\ Don't commit before the messages have actually been EXPUNGEd on -# both sides! +# /!\ Don't commit before the messages have actually been EXPUNGEd on both sides! my $STH_DELETE_MAPPING = $DBH->prepare(q{DELETE FROM mapping WHERE idx = ? and lUID = ?}); # Update the HIGHESTMODSEQ. @@ -544,129 +543,209 @@ my $STH_UPDATE_LOCAL = $DBH->prepare(q{UPDATE local SET UIDNEXT = ?, HIGHESTMO my $STH_UPDATE_REMOTE = $DBH->prepare(q{UPDATE remote SET UIDNEXT = ?, HIGHESTMODSEQ = ? WHERE idx = ?}); # Add a new mailbox. -my $STH_NEWMAILBOX = $DBH->prepare(q{INSERT INTO mailboxes (mailbox,subscribed) VALUES (?,?)}); -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 (?,?,?,?)}); +my $STH_INSERT_MAILBOX= $DBH->prepare(q{INSERT INTO mailboxes (mailbox,subscribed) VALUES (?,?)}); +my $STH_INSERT_LOCAL = $DBH->prepare(q{INSERT INTO local (idx,UIDVALIDITY,UIDNEXT,HIGHESTMODSEQ) VALUES (?,?,0,0)}); +my $STH_INSERT_REMOTE = $DBH->prepare(q{INSERT INTO remote (idx,UIDVALIDITY,UIDNEXT,HIGHESTMODSEQ) VALUES (?,?,0,0)}); # 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 = ?}); +# Get the list of interrupted mailbox syncs. +my $STH_LIST_INTERRUPTED = $DBH->prepare(q{ + SELECT mbx.idx, mailbox + FROM mailboxes mbx JOIN local l ON mbx.idx = l.idx JOIN remote r ON mbx.idx = r.idx JOIN mapping ON mbx.idx = mapping.idx + WHERE (lUID >= l.UIDNEXT OR rUID >= r.UIDNEXT) + GROUP BY mbx.idx +}); + +# For an interrupted mailbox sync, get the pairs (lUID,rUID) that have +# already been downloaded. +my $STH_GET_INTERRUPTED_BY_IDX = $DBH->prepare(q{ + SELECT lUID, rUID + FROM mapping m JOIN local l ON m.idx = l.idx JOIN remote r ON m.idx = r.idx + WHERE m.idx = ? AND (lUID >= l.UIDNEXT OR rUID >= r.UIDNEXT) +}); -# Initialize $lIMAP and $rIMAP states to detect mailbox dirtyness. -$STH_GET_CACHE->execute(); -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}) - ); - $rIMAP->set_cache($row->{mailbox}, - UIDVALIDITY => $row->{rUIDVALIDITY}, - UIDNEXT => $row->{rUIDNEXT}, - HIGHESTMODSEQ => ($CONFIG{check} ? 0 : $row->{rHIGHESTMODSEQ}) - ); -} -# 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(%) { - my %mail = @_; - return unless exists $mail{RFC822}; # not for us + ($source eq 'local' ? $lIMAP : $rIMAP)->fetch(compact_set(@set), "($attrs)", sub($) { + my $mail = shift; + return unless exists $mail->{RFC822}; # not for us - my $from = first { defined $_ and @$_ } @{$mail{ENVELOPE}}[2,3,4]; + 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 $mail{UID} from <$from> ($mail{INTERNALDATE})\n" unless $CONFIG{quiet}; + print STDERR "$source($mailbox): UID $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); + 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 } -# Check synchronization of a mailbox between the two servers (in a very crude way) -my @CHECKED; -sub check($$$$$) { - my ($idx, $lVanished, $lList, $rVanished, $rList) = @_; + +# 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 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 "WARNING: local($mailbox): 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 "WARNING: remote($mailbox): 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}; } - # we'll complain later for modified UIDs without an entry in the database + # 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; - @$lVanished = keys %lVanished; - @$rVanished = keys %rVanished; - push @CHECKED, $idx; - return %missing; + # 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; + } + + # 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; + + # 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 "WARNING: remote($mailbox): 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,21 +795,19 @@ 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: local($mailbox): 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; } } - $lIMAP->remove(@lToRemove) if @lToRemove; - $rIMAP->remove(@rToRemove) if @rToRemove; + $lIMAP->remove_message(@lToRemove) if @lToRemove; + $rIMAP->remove_message(@rToRemove) if @rToRemove; # 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 "WARNING: remote($mailbox): 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 for lUID $lUID ($lFlags) and". - "rUID $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 "WARNING: local($mailbox): 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); } @@ -804,81 +871,99 @@ sub sync_known_messages($$) { } -# Sync known and new messages -sub sync_messages($$) { - my ($idx, $mailbox) = @_; - - my %mapping; - foreach my $source (qw/remote local/) { - my $target = $source eq 'local' ? $rIMAP : $lIMAP; - my $multiappend; - - my @newmails; - my $buffer = 0; # sum of the RFC822 sizes in @newmails - - my (@sUID, @tUID); +# The callback to use when FETCHing new messages from $name to add it to +# the other one. +# If defined, the array reference $UIDs will be fed with the newly added +# UIDs. +# If defined, $buff contains the list of messages to be appended with +# MULTIAPPEND. In that case callback_new_message_flush should be called +# after the FETCH. +sub callback_new_message($$$$;$$$) { + my ($idx, $mailbox, $name, $mail, $UIDs, $buff, $bufflen) = @_; + return unless exists $mail->{RFC822}; # not for us + + my $length = length $mail->{RFC822}; + if ($length == 0) { + warn "$name($mailbox): WARNING: Ignoring new 0-length message (UID $mail->{UID})\n"; + return; + } - # don't fetch again the messages we've just added - my @ignore = $source eq 'local' ? keys %mapping : values %mapping; + my @UIDs; + unless (defined $buff) { + @UIDs = callback_new_message_flush($idx, $mailbox, $name, $mail); + } + else { + # use MULTIAPPEND (RFC 3502) + # proceed by batches of 1MB to save roundtrips without blowing up the memory + if (@$buff and $$bufflen + $length > 1048576) { + @UIDs = callback_new_message_flush($idx, $mailbox, $name, @$buff); + @$buff = (); + $$bufflen = 0; + } + push @$buff, $mail; + $$bufflen += $length; + } + push @$UIDs, @UIDs if defined $UIDs; +} - ($source eq 'local' ? $lIMAP : $rIMAP)->pull_new_messages(sub(%) { - my %mail = @_; - return unless exists $mail{RFC822}; # not for us - my @mail = ($mail{RFC822}, [ grep {lc $_ ne '\recent'} @{$mail{FLAGS}} ], $mail{INTERNALDATE}); - push @sUID, $mail{UID}; +# Add the given @messages (multiple messages are only allowed for +# MULTIAPPEND-capable servers) from $name to the other server. +# Returns the list of newly allocated UIDs. +sub callback_new_message_flush($$$@) { + my ($idx, $mailbox, $name, @messages) = @_; - # use MULTIAPPEND if possible (RFC 3502) to save round-trips - $multiappend //= !$target->incapable('MULTIAPPEND'); + my $imap = $name eq 'local' ? $rIMAP : $lIMAP; # target client + my @sUID = map {$_->{UID}} @messages; + my @tUID = $imap->append($mailbox, @messages); + die unless $#sUID == $#tUID; # sanity check - if (!$multiappend) { - my ($uid) = $target->append($mailbox, @mail); - push @tUID, $uid; - } - else { - # proceed by batch of 1MB to save roundtrips without blowing up the memory - if (@newmails and $buffer + length($mail{RFC822}) > 1048576) { - push @tUID, $target->append($mailbox, @newmails); - @newmails = (); - $buffer = 0; - } - push @newmails, @mail; - $buffer += length $mail{RFC822}; - } - }, @ignore); - push @tUID, $target->append($mailbox, @newmails) if @newmails; - - die unless $#sUID == $#tUID; # sanity check - foreach my $k (0 .. $#sUID) { - my ($lUID,$rUID) = $source eq 'local' ? ($sUID[$k],$tUID[$k]) : ($tUID[$k],$sUID[$k]); - die if exists $mapping{$lUID}; # sanity check - $mapping{$lUID} = $rUID; - } + my ($lUIDs, $rUIDs) = $name eq 'local' ? (\@sUID,\@tUID) : (\@tUID,\@sUID); + for (my $k=0; $k<=$#messages; $k++) { + print STDERR "Adding mapping (lUID,rUID) = ($lUIDs->[$k],$rUIDs->[$k]) for $mailbox\n" + if $CONFIG{debug}; + $STH_INSERT_MAPPING->execute($idx, $lUIDs->[$k], $rUIDs->[$k]); } + $DBH->commit(); # commit only once per batch - # new mailbox - if (!defined $$idx) { - my $subscribed = (grep { $_ eq $mailbox} @SUBSCRIPTIONS) ? 1 : 0; - $STH_NEWMAILBOX->execute($mailbox, $subscribed); - $STH_GET_INDEX->execute($mailbox); - ($$idx) = $STH_GET_INDEX->fetchrow_array(); - die if !defined $$idx or defined $STH_GET_INDEX->fetchrow_arrayref(); # sanity check - - # there might be flag updates pending - 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, $mailbox); - $STH_UPDATE_LOCAL->execute($lIMAP->get_cache( qw/UIDNEXT HIGHESTMODSEQ/), $$idx); - $STH_UPDATE_REMOTE->execute($rIMAP->get_cache(qw/UIDNEXT HIGHESTMODSEQ/), $$idx); - } + return @tUID; +} - while (my ($lUID,$rUID) = each %mapping) { - $STH_INSERT_MAPPING->execute($$idx, $lUID, $rUID); - } + +# Sync both known and new messages +# If the array references $lIgnore and $rIgnore are not empty, skip +# the given UIDs. +sub sync_messages($$;$$) { + my ($idx, $mailbox, $lIgnore, $rIgnore) = @_; + my ($buff, $bufflen, @lUIDs); + + # get new messages from remote (except @$rIgnore) and APPEND them to local + ($buff, $bufflen) = ([], 0); + undef $buff if $lIMAP->incapable('MULTIAPPEND'); + $rIMAP->pull_new_messages(sub($) { + callback_new_message($idx, $mailbox, 'remote', shift, \@lUIDs, $buff, \$bufflen) + }, @{$rIgnore // []}); + push @lUIDs, callback_new_message_flush($idx, $mailbox, 'remote', @$buff) + if defined $buff and @$buff; + + # get new messages from local (except @$lIgnore and the newly allocated local + # UIDs @lUIDs) and APPEND them to remote + ($buff, $bufflen) = ([], 0); + undef $buff if $rIMAP->incapable('MULTIAPPEND'); + $lIMAP->pull_new_messages(sub($) { + callback_new_message($idx, $mailbox, 'local', shift, undef, $buff, \$bufflen) + }, @{$lIgnore // []}, @lUIDs); + callback_new_message_flush($idx, $mailbox, 'local', @$buff) + if defined $buff and @$buff; + + # both local and remote UIDNEXT are now up to date; proceed with + # pending flag updates and vanished messages + sync_known_messages($idx, $mailbox); + + # don't store the new UIDNEXTs before to avoid downloading these + # mails again in the event of a crash + $STH_UPDATE_LOCAL->execute($lIMAP->get_cache( qw/UIDNEXT HIGHESTMODSEQ/), $idx); + $STH_UPDATE_REMOTE->execute($rIMAP->get_cache(qw/UIDNEXT HIGHESTMODSEQ/), $idx); $DBH->commit(); } @@ -903,39 +988,140 @@ sub wait_notifications(;$) { } -my ($mailbox, $idx); +# Resume interrupted mailbox syncs. +my ($MAILBOX, $IDX); +$STH_LIST_INTERRUPTED->execute(); +while (defined (my $row = $STH_LIST_INTERRUPTED->fetchrow_arrayref())) { + ($IDX, $MAILBOX) = @$row; + print STDERR "Resuming interrupted sync for $MAILBOX\n"; + + my %lUIDs; + $STH_GET_INTERRUPTED_BY_IDX->execute($IDX); + while (defined (my $row = $STH_GET_INTERRUPTED_BY_IDX->fetchrow_arrayref())) { + $lUIDs{$row->[0]} = $row->[1]; # pair ($lUID, $rUID) + } + die unless %lUIDs; # sanity check + + $lIMAP->select($MAILBOX); + $rIMAP->select($MAILBOX); + + # FETCH all messages with their FLAGS to detect messages that have + # vanished meanwhile, or for which there was a flag update. + + my (%lList, %rList); # The lists of existing local and remote UIDs + my $attrs = '('.join(' ', qw/MODSEQ FLAGS/).')'; + $lIMAP->fetch(compact_set(keys %lUIDs), $attrs, sub($){ $lList{shift->{UID}} = 1 }); + $rIMAP->fetch(compact_set(values %lUIDs), $attrs, sub($){ $rList{shift->{UID}} = 1 }); + + my (@lToRemove, @rToRemove); + while (my ($lUID,$rUID) = each %lUIDs) { + next if $lList{$lUID} and $rList{$rUID}; # exists on both + push @lToRemove, $lUID if $lList{$lUID}; + push @rToRemove, $rUID if $rList{$rUID}; + + delete_mapping($IDX, $lUID); + } + + $lIMAP->remove_message(@lToRemove) if @lToRemove; + $rIMAP->remove_message(@rToRemove) if @rToRemove; + $DBH->commit() if @lToRemove or @rToRemove; # /!\ commit *after* remove_message! + + # ignore deleted messages + delete @lList{@lToRemove}; + delete @rList{@rToRemove}; + + # Resume the sync, but skip messages that have already been + # downloaded. Flag updates will be processed automatically since + # the _MODIFIED internal cache has been initialized with all our + # UIDs. (Since there is no reliable HIGHESTMODSEQ, any flag + # difference is treated as a conflict.) + sync_messages($IDX, $MAILBOX, [keys %lList], [keys %rList]); +} + + + +# Initialize $lIMAP and $rIMAP states to detect mailbox dirtyness. +$STH_GET_CACHE->execute(); +while (defined (my $row = $STH_GET_CACHE->fetchrow_hashref())) { + $lIMAP->set_cache($row->{mailbox}, + UIDVALIDITY => $row->{lUIDVALIDITY}, + UIDNEXT => $row->{lUIDNEXT}, + HIGHESTMODSEQ => $row->{lHIGHESTMODSEQ} + ); + $rIMAP->set_cache($row->{mailbox}, + UIDVALIDITY => $row->{rUIDVALIDITY}, + UIDNEXT => $row->{rUIDNEXT}, + HIGHESTMODSEQ => $row->{rHIGHESTMODSEQ} + ); + push @REPAIR, $row->{mailbox} if $CONFIG{repair} and + (!@ARGV or grep { $_ eq $row->{mailbox} } @ARGV); +} + +while (@REPAIR) { + $MAILBOX = shift @REPAIR; + + $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); +} +if ($CONFIG{repair}) { + cleanup(); + exit 0; +} + + while(1) { while(1) { my $cache; my $update = 0; - if (defined $mailbox and ($lIMAP->is_dirty($mailbox) or $rIMAP->is_dirty($mailbox))) { - # $mailbox is dirty on either the local or remote mailbox - sync_messages(\$idx, $mailbox); + if (defined $MAILBOX and ($lIMAP->is_dirty($MAILBOX) or $rIMAP->is_dirty($MAILBOX))) { + # $MAILBOX is dirty on either the local or remote mailbox + sync_messages($IDX, $MAILBOX); } else { - $mailbox = $lIMAP->next_dirty_mailbox(@ARGV) // $rIMAP->next_dirty_mailbox(@ARGV) // last; - $mailbox = 'INBOX' if uc $mailbox eq 'INBOX'; # INBOX is case insensitive + $MAILBOX = $lIMAP->next_dirty_mailbox(@ARGV) // $rIMAP->next_dirty_mailbox(@ARGV) // last; + $MAILBOX = 'INBOX' if uc $MAILBOX eq 'INBOX'; # INBOX is case insensitive - $STH_GET_INDEX->execute($mailbox); - ($idx) = $STH_GET_INDEX->fetchrow_array(); + $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); + $lIMAP->select($MAILBOX); + $rIMAP->select($MAILBOX); + + # new mailbox + if (!defined $IDX) { + my $subscribed = (grep { $_ eq $MAILBOX} @SUBSCRIPTIONS) ? 1 : 0; + $STH_INSERT_MAILBOX->execute($MAILBOX, $subscribed); + $STH_GET_INDEX->execute($MAILBOX); + ($IDX) = $STH_GET_INDEX->fetchrow_array(); + die if !defined $IDX or defined $STH_GET_INDEX->fetchrow_arrayref(); # sanity check - # sync updates to known messages before fetching new messages - if (defined $idx and sync_known_messages($idx, $mailbox)) { + $STH_INSERT_LOCAL->execute( $IDX, $lIMAP->uidvalidity($MAILBOX)); + $STH_INSERT_REMOTE->execute($IDX, $rIMAP->uidvalidity($MAILBOX)); + + # don't commit before the first mapping (lUID,rUID) + } + elsif (sync_known_messages($IDX, $MAILBOX)) { + # sync updates to known messages before fetching new messages # 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); + $STH_UPDATE_LOCAL_HIGHESTMODSEQ->execute( $lIMAP->get_cache('HIGHESTMODSEQ'), $IDX); + $STH_UPDATE_REMOTE_HIGHESTMODSEQ->execute($rIMAP->get_cache('HIGHESTMODSEQ'), $IDX); $DBH->commit(); } - sync_messages(\$idx, $mailbox); + sync_messages($IDX, $MAILBOX); } } # clean state! - exit 0 if $CONFIG{oneshot} or $CONFIG{check}; + if ($CONFIG{oneshot}) { + cleanup(); + exit 0; + } wait_notifications(900); } -END { clean (); } +END { cleanup(); } |