aboutsummaryrefslogtreecommitdiffstats
path: root/imapsync
diff options
context:
space:
mode:
Diffstat (limited to 'imapsync')
-rwxr-xr-ximapsync592
1 files changed, 389 insertions, 203 deletions
diff --git a/imapsync b/imapsync
index f80106d..00beec7 100755
--- a/imapsync
+++ b/imapsync
@@ -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(); }
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-05 00:43:06 +0000