aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rwxr-xr-ximapsync156
-rw-r--r--lib/Net/IMAP/Sync.pm27
2 files changed, 158 insertions, 25 deletions
diff --git a/imapsync b/imapsync
index 4ad95f3..a8c786c 100755
--- a/imapsync
+++ b/imapsync
@@ -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);
}
diff --git a/lib/Net/IMAP/Sync.pm b/lib/Net/IMAP/Sync.pm
index 2aff76c..21e2fa8 100644
--- a/lib/Net/IMAP/Sync.pm
+++ b/lib/Net/IMAP/Sync.pm
@@ -682,6 +682,15 @@ sub append($$$@) {
}
+# $self->fetch($set, $flags, [$callback])
+# Issue an UID FETCH command with the given UID $set, $flags, and
+# optional $callback.
+sub fetch($$$$) {
+ my ($self, $set, $flags, $callback) = @_;
+ $self->_send("UID FETCH $set $flags", $callback);
+}
+
+
# $self->notify(@specifications)
# Issue a NOTIFY command with the given mailbox @specifications (cf RFC
# 5465 section 6) to be monitored. Croak if the server did not
@@ -832,13 +841,16 @@ sub next_dirty_mailbox($@) {
}
-# $self->pull_updates()
+# $self->pull_updates([$full])
+# If $full is set, FETCH FLAGS and MODSEQ for each UID up to
+# UIDNEXT-1.
# Get pending updates (unprocessed VANISHED responses and FLAG
# updates), and empty these lists from the cache.
# Finally, update the HIGHESTMODSEQ from the persistent cache to the
# value found in the internal cache.
-sub pull_updates($) {
+sub pull_updates($;$) {
my $self = shift;
+ my $full = shift // 0;
my $mailbox = $self->{_SELECTED} // $self->panic();
my $pcache = $self->{_PCACHE}->{$mailbox};
@@ -848,6 +860,9 @@ sub pull_updates($) {
$self->{_VANISHED} = [];
}
else {
+ $self->_send("UID FETCH 1:".($pcache->{UIDNEXT}-1)." (MODSEQ FLAGS)")
+ if $full and $pcache->{UIDNEXT} > 1;
+
my @missing;
while (%{$self->{_MODIFIED}}) {
while (my ($uid,$v) = each %{$self->{_MODIFIED}}) {
@@ -855,9 +870,9 @@ sub pull_updates($) {
# FLAG updates can arrive while processing pull_new_messages
# for instance
if (defined $v->[1] and $v->[0] > 0) { # setting the MODSEQ to 0 forces a FETCH
- next unless $uid < $pcache->{UIDNEXT} # out of bounds
- and $v->[0] > $pcache->{HIGHESTMODSEQ}; # already seen
- $modified{$uid} = $v->[1];
+ next unless $uid < $pcache->{UIDNEXT} # out of bounds
+ and ($full or $v->[0] > $pcache->{HIGHESTMODSEQ}); # already seen
+ $modified{$uid} = $full ? $v : $v->[1];
} else {
push @missing, $uid;
}
@@ -996,7 +1011,7 @@ sub push_flag_updates($$@) {
}
unless ($self->{quiet}) {
- $self->log("Updated flags ($flags) for UID ".compact_set(@ok));
+ $self->log("Updated flags ($flags) for UID ".compact_set(@ok)) if @ok;
$self->log("Couldn't update flags ($flags) for UID ".compact_set(keys %failed).', '.
"trying again later") if %failed;
}
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-27 13:46:46 +0000