aboutsummaryrefslogtreecommitdiffstats
path: root/imapsync
diff options
context:
space:
mode:
Diffstat (limited to 'imapsync')
-rwxr-xr-ximapsync201
1 files changed, 166 insertions, 35 deletions
diff --git a/imapsync b/imapsync
index 4ef47b3..f80106d 100755
--- a/imapsync
+++ b/imapsync
@@ -28,7 +28,6 @@ use Getopt::Long qw/:config posix_default no_ignore_case gnu_compat
use List::Util 'first';
use DBI ();
-use POSIX 'strftime';
use lib 'lib';
use Net::IMAP::Sync qw/read_config compact_set $IMAP_text $IMAP_cond/;
@@ -43,14 +42,33 @@ sub usage(;$) {
print STDERR "TODO $NAME usage\n";
exit $rv;
}
-usage(1) unless GetOptions(\%CONFIG, qw/debug help|h 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};
-my $CONFFILE = 'sync.ini';
-my $CACHEDIR = './imapsync.cache'; # XXX use a config option
-my $DBFILE = "$CACHEDIR/imap.guilhem.org.db";
-my $LOCKFILE = "$CACHEDIR/.imap.guilhem.org.lck";
+my $CONF = read_config( delete $CONFIG{config} // $NAME
+ , [qw/_ local remote/]
+ , database => qr/\A(\P{Control}+)\z/ );
+my ($DBFILE, $LOCKFILE);
+
+{
+ $DBFILE = $CONF->{_}->{database} if defined $CONF->{_};
+ $DBFILE //= $CONF->{remote}->{host}.'.db' if defined $CONF->{remote};
+ $DBFILE //= $CONF->{local}->{host}. '.db' if defined $CONF->{local};
+ die "Missing option database" unless defined $DBFILE;
+
+ unless ($DBFILE =~ /\A\//) {
+ my $dir = ($ENV{XDG_DATA_HOME} // "$ENV{HOME}/.local/share") .'/'. $NAME;
+ $dir =~ /\A(\/\p{Print}+)\z/ or die "Insecure $dir";
+ $dir = $1;
+ $DBFILE = $dir .'/'. $DBFILE;
+ unless (-d $dir) {
+ mkdir $dir, 0700 or die "Cannot mkdir $dir: $!\n";
+ }
+ }
+
+ $LOCKFILE = $DBFILE =~ s/([^\/]+)\z/.$1.lck/r;
+}
my ($DBH, $IMAP);
@@ -67,10 +85,7 @@ $SIG{$_} = sub { clean(); die "$!\n"; } foreach qw/INT TERM/;
#############################################################################
# Lock the database
{
- if (!-d $CACHEDIR) {
- mkdir $CACHEDIR, 0700 or die "Cannot mkdir $CACHEDIR: $!\n";
- }
- elsif (-f $LOCKFILE) {
+ if (-f $LOCKFILE) {
open my $lock, '<', $LOCKFILE or die "Cannot open $LOCKFILE: $!\n";
my $pid = <$lock>;
close $lock;
@@ -153,9 +168,7 @@ $DBH->do('PRAGMA foreign_keys = ON');
sub msg($@) {
my $name = shift;
return unless @_;
- my $prefix = strftime "%b %e %H:%M:%S", localtime;
- $prefix .= " $name" if defined $name;
- $prefix .= ': ';
+ my $prefix = defined $name ? "$name: " : '';
print STDERR $prefix, @_, "\n";
}
@@ -164,7 +177,7 @@ sub msg($@) {
# Connect to the local and remote IMAP servers
foreach my $name (qw/local remote/) {
- my %config = Net::IMAP::Sync::read_config($CONFFILE, $name);
+ my %config = %{$CONF->{$name}};
$config{$_} = $CONFIG{$_} foreach keys %CONFIG;
$config{enable} = 'QRESYNC';
$config{name} = $name;
@@ -502,18 +515,25 @@ 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 = ?});
# Find local/remote UID from the map.
-my $STH_GET_LOCAL_UID = $DBH->prepare("SELECT lUID FROM mapping WHERE idx = ? and rUID = ?");
-my $STH_GET_REMOTE_UID = $DBH->prepare("SELECT rUID FROM mapping WHERE idx = ? and lUID = ?");
+my $STH_GET_LOCAL_UID = $DBH->prepare(q{SELECT lUID FROM mapping WHERE idx = ? and rUID = ?});
+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!
-my $STH_DELETE_MAPPING = $DBH->prepare("DELETE FROM mapping WHERE idx = ? and lUID = ?");
+my $STH_DELETE_MAPPING = $DBH->prepare(q{DELETE FROM mapping WHERE idx = ? and lUID = ?});
# Update the HIGHESTMODSEQ.
my $STH_UPDATE_LOCAL_HIGHESTMODSEQ = $DBH->prepare(q{UPDATE local SET HIGHESTMODSEQ = ? WHERE idx = ?});
@@ -528,8 +548,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.
@@ -538,31 +559,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
@@ -581,7 +707,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;
@@ -592,7 +718,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;
@@ -606,7 +732,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;
}
}
@@ -629,7 +755,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) {
@@ -653,7 +780,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
@@ -662,6 +790,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);
}
@@ -734,13 +865,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);
}
@@ -793,7 +924,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);
@@ -803,7 +934,7 @@ while(1) {
}
}
# clean state!
- exit 0 if $CONFIG{oneshot};
+ exit 0 if $CONFIG{oneshot} or $CONFIG{check};
wait_notifications(900);
}
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-04 19:09:04 +0000