aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--Changelog13
-rwxr-xr-xinterimap1016
2 files changed, 609 insertions, 420 deletions
diff --git a/Changelog b/Changelog
index 791df24..0a31639 100644
--- a/Changelog
+++ b/Changelog
@@ -10,6 +10,14 @@ interimap (0.5) upstream;
namespace.
+ interimap: write which --target to use in --delete command
suggestions.
+ + interimap: avoid caching hierarchy delimiters forever in the
+ database. Instead, use null characters internally, and substitute
+ them with the local and remote hierarchy delimiters (which thus no
+ longer need to match) for IMAP commands. This require a database
+ schema upgrade to alter the mailbox name column type from TEXT to
+ BLOB.
+ + interimap: use the 'user_version' SQLite PRAGMA for database schema
+ version.
- libinterimap: bugfix: hierarchy delimiters in LIST responses were
returned as an escaped quoted special, like "\\", not as a single
character (backslash in this case).
@@ -25,6 +33,11 @@ interimap (0.5) upstream;
- interimap: unlike what the documentation said, 'ignore-mailbox' was
not ignored when names were specified as command line arguments.
- interimap: accept comma-separated values for --target.
+ - interimap: --rename of a \NonExistent mailbox didn't trigger a RENAME
+ command on the local/remote IMAP servers, nor an update of the
+ 'mailboxes' table.
+ - interimap: don't try to delete \NoSelect mailboxes (it's an error per
+ RFC 3501 sec. 6.3.4).
-- Guilhem Moulin <guilhem@fripost.org> Fri, 10 May 2019 00:58:14 +0200
diff --git a/interimap b/interimap
index 07c2b24..3e1979b 100755
--- a/interimap
+++ b/interimap
@@ -24,9 +24,10 @@ use warnings;
our $VERSION = '0.5';
my $NAME = 'interimap';
+my $DATABASE_VERSION = 1;
use Getopt::Long qw/:config posix_default no_ignore_case gnu_compat
bundling auto_version/;
-use DBI ();
+use DBI ':sql_types';
use DBD::SQLite::Constants ':file_open';
use Fcntl qw/F_GETFD F_SETFD FD_CLOEXEC/;
use List::Util 'first';
@@ -154,8 +155,7 @@ $SIG{TERM} = sub { cleanup(); exit 0; };
#############################################################################
-# Open the database and create tables
-
+# Open (and maybe create) the database
{
my $dbi_data_source = "dbi:SQLite:dbname=".$DBFILE;
@@ -171,63 +171,10 @@ $SIG{TERM} = sub { cleanup(); exit 0; };
$DBH = DBI::->connect($dbi_data_source, undef, undef, \%dbi_attrs);
$DBH->sqlite_busy_timeout(250);
- $DBH->do('PRAGMA locking_mode = EXCLUSIVE');
- $DBH->do('PRAGMA foreign_keys = ON');
-
- my @schema = (
- mailboxes => [
- q{idx INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT},
- q{mailbox TEXT NOT NULL CHECK (mailbox != '') UNIQUE},
- q{subscribed BOOLEAN NOT NULL}
- ],
- 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}, # 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}, # 0 initially
- q{HIGHESTMODSEQ UNSIGNED BIGINT NOT NULL} # 0 initially
- # one-to-one correspondence between local.idx and remote.idx
- ],
- mapping => [
- q{idx INTEGER NOT NULL REFERENCES mailboxes(idx)},
- q{lUID UNSIGNED INT NOT NULL CHECK (lUID > 0)},
- 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 (except for interrupted syncs)
- # mapping.idx must be found among local.idx (and remote.idx)
- ],
-
- # We have no version number in the schema, but if we ever need a
- # migration, we'll add a new table, and assume version 1.0 if
- # the table is missing.
- );
-
- # Invariants:
- # * UIDVALIDITY never changes.
- # * All changes for UID < {local,remote}.UIDNEXT and MODSEQ <
- # {local,remote}.HIGHESTMODSEQ have been propagated.
- # * No local (resp. remote) new message will ever have a UID <= local.UIDNEXT
- # (resp. <= remote.UIDNEXT).
- # * Any idx in `local` must be present in `remote` and vice-versa.
- # * Any idx in `mapping` must be present in `local` and `remote`.
- while (@schema) {
- my $table = shift @schema;
- my $schema = shift @schema;
- my $sth = $DBH->table_info(undef, undef, $table, 'TABLE', {Escape => 1});
- my $row = $sth->fetch();
- die if defined $sth->fetch(); # sanity check
- unless (defined $row) {
- $DBH->do("CREATE TABLE $table (".join(', ',@$schema).")");
- $DBH->commit();
- }
- }
+ # Try to lock the database before any network traffic so we can fail
+ # early if the database is already locked.
+ $DBH->do("PRAGMA locking_mode = EXCLUSIVE");
+ $DBH->do("PRAGMA foreign_keys = ON");
}
sub msg($@) {
@@ -280,21 +227,52 @@ foreach my $name (qw/local remote/) {
# Pretty-print hierarchy delimiter: DQUOTE QUOTED-CHAR DQUOTE / nil
sub print_delimiter($) {
my $d = shift // return "NIL";
- $d =~ s/([\x22\x5C])/\\$1/g;
+ $d = "\\".$d if $d eq "\\" or $d eq "\"";
return "\"".$d."\"";
}
+# Return the delimiter of the default namespace, and cache the result.
+# Use the cached value if present, otherwise issue a new LIST command
+# with the empty mailbox.
+sub get_delimiter($$) {
+ my ($name, $imap) = @_;
+
+ # Use the cached value if present
+ return $imap->{delimiter} if exists $imap->{delimiter};
+
+ my (undef, $d) = $imap->{client}->list("\"\" \"\"");
+ my @d = values %$d if defined $d;
+ # While multiple LIST responses may happen in theory, we've issued a
+ # single LIST command, so it's fair to expect a single reponse with
+ # a hierarchy delimiter of the root node.
+ fail($name, "Missing or unexpected (unsolicited) LIST response.") unless $#d == 0;
+
+ return $imap->{delimiter} = $d[0]; # cache value and return it
+}
+
# List mailboxes; don't return anything but update $IMAP->{$name}->{mailboxes}
sub list_mailboxes($) {
my $name = shift;
+ my $imap = $IMAP->{$name};
+
my $list = "";
$list .= "(" .$LIST{'select-opts'}. ") " if defined $LIST{'select-opts'};
$list .= "\"\" ";
- $list .= $#{$LIST{mailbox}} < 0 ? "*"
- : $#{$LIST{mailbox}} == 0 ? Net::IMAP::InterIMAP::quote($LIST{mailbox}->[0])
- : "(".join(" ", map {Net::IMAP::InterIMAP::quote($_)} @{$LIST{mailbox}}).")";
- my ($mbx, $delims) = $IMAP->{$name}->{client}->list($list, @{$LIST{params} // []});
- $IMAP->{$name}->{mailboxes} = $mbx;
+
+ my @mailboxes = @{$LIST{mailbox}};
+ my $cached_delimiter = exists $imap->{delimiter} ? 1 : 0;
+ if (grep { index($_,"\x00") >= 0 } @mailboxes) {
+ # some mailbox names contain null characters: substitute them with the hierarchy delimiter
+ my $d = get_delimiter($name, $imap) //
+ fail($name, "Mailbox name contains null characters but the namespace is flat!");
+ s/\x00/$d/g foreach @mailboxes;
+ }
+
+ $list .= $#mailboxes < 0 ? "*"
+ : $#mailboxes == 0 ? Net::IMAP::InterIMAP::quote($mailboxes[0])
+ : "(".join(" ", map {Net::IMAP::InterIMAP::quote($_)} @mailboxes).")";
+ my ($mbx, $delims) = $imap->{client}->list($list, @{$LIST{params} // []});
+ $imap->{mailboxes} = $mbx;
# INBOX exists in a namespace of its own, so it may have a different separator.
# All other mailboxes MUST have the same separator though, per 3501 sec. 7.2.2
@@ -303,32 +281,26 @@ sub list_mailboxes($) {
# the user needs to start multiple interimap instances.)
delete $delims->{INBOX};
- unless (exists $IMAP->{$name}->{delimiter}) {
- # Nothing to do if we already cached the hierarchy delimiter.
+ unless (exists $imap->{delimiter}) {
+ # if the delimiter is still unknown (meaning no names in @{$LIST{mailbox}}
+ # contains null characters) we now cache it
if (%$delims) {
- # Got a non-INBOX LIST reply, use the first one as authoritative value.
+ # got a non-INBOX LIST reply, use the first one as authoritative value
my ($m) = sort keys %$delims;
- $IMAP->{$name}->{delimiter} = delete $delims->{$m};
+ $imap->{delimiter} = delete $delims->{$m};
} else {
- # Didn't get a non-INBOX LIST reply so we issue a new LIST command
- # with the empty mailbox to get the delimiter of the default namespace.
- my (undef, $d) = $IMAP->{$name}->{client}->list("\"\" \"\"");
- my @d = values %$d if defined $d;
- # While multiple LIST responses may happen in theory, we've issued a
- # single LIST command, so it's fair to expect a single reponse with
- # a hierarchy delimiter of the root node.
- fail($name, "Missing or unexpected (unsolicited) LIST response.")
- unless $#d == 0;
- $IMAP->{$name}->{delimiter} = $d[0];
+ # didn't get a non-INBOX LIST reply so we need to explicitely query
+ # the hierarchy delimiter
+ get_delimiter($name, $imap);
}
- logger($name, "Using ", print_delimiter($IMAP->{$name}->{delimiter}),
- " as hierarchy delimiter") if $CONFIG{debug};
}
+ logger($name, "Using ", print_delimiter($imap->{delimiter}),
+ " as hierarchy delimiter") if !$cached_delimiter and $CONFIG{debug};
# Ensure all LISTed delimiters (incl. INBOX's children, although they're
# in a different namespace -- we treat INBOX itself separately, but not
# its children) match the one at the top level.
- my $d = $IMAP->{$name}->{delimiter};
+ my $d = $imap->{delimiter};
foreach my $m (keys %$delims) {
fail($name, "Mailbox $m has hierarchy delimiter ", print_delimiter($delims->{$m}),
", while ", print_delimiter($d), " was expected.")
@@ -337,34 +309,197 @@ sub list_mailboxes($) {
}
}
-list_mailboxes($_) for qw/local remote/;
+list_mailboxes("local");
+if (defined (my $d = $IMAP->{local}->{delimiter})) {
+ # substitute the local delimiter with null characters in the mailbox list
+ s/\Q$d\E/\x00/g foreach @{$LIST{mailbox}};
+}
+list_mailboxes("remote");
+
+# Ensure local and remote namespaces are either both flat, or both hierarchical.
+# (We can't mirror a hierarchical namespace to a flat one.)
+fail(undef, "Local and remote namespaces are neither both flat nor both hierarchical ",
+ "(local ", print_delimiter($IMAP->{local}->{delimiter}), ", ",
+ "remote ", print_delimiter($IMAP->{remote}->{delimiter}), ").")
+ if defined $IMAP->{local}->{delimiter} xor defined $IMAP->{remote}->{delimiter};
+
-# Ensure local and remote hierarchy delimiters match.
-# XXX There is no real reason to enforce that. We could for instance
-# use NUL bytes in the database and config, and substitute it with the
-# local/remote delimiter on the fly.
-fail (undef, "Local and remote hiearchy delimiters differ: ",
- print_delimiter($IMAP->{local}->{delimiter}), " != ",
- print_delimiter($IMAP->{remote}->{delimiter}), ".")
- if (defined $IMAP->{local}->{delimiter} xor defined $IMAP->{remote}->{delimiter})
- or (defined $IMAP->{local}->{delimiter} and defined $IMAP->{remote}->{delimiter}
- and $IMAP->{local}->{delimiter} ne $IMAP->{remote}->{delimiter});
+##############################################################################
+# Create or update database schema (delayed until after the IMAP
+# connections and mailbox LISTing as we need to know the hierarchy
+# delimiter for the schema migration).
+
+{
+ # Invariants:
+ # * UIDVALIDITY never changes.
+ # * All changes for UID < {local,remote}.UIDNEXT and MODSEQ <
+ # {local,remote}.HIGHESTMODSEQ have been propagated.
+ # * No local (resp. remote) new message will ever have a UID <= local.UIDNEXT
+ # (resp. <= remote.UIDNEXT).
+ # * Any idx in `local` must be present in `remote` and vice-versa.
+ # * Any idx in `mapping` must be present in `local` and `remote`.
+ my @schema = (
+ mailboxes => [
+ q{idx INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT},
+ # to avoid caching hierachy delimiter of mailbox names forever we replace it
+ # with '\0' in that table; the substitution is safe since null characters are
+ # not allowed within mailbox names
+ q{mailbox BLOB COLLATE BINARY NOT NULL CHECK (mailbox != '') UNIQUE},
+ q{subscribed BOOLEAN NOT NULL}
+ ],
+ local => [
+ q{idx INTEGER NOT NULL PRIMARY KEY REFERENCES mailboxes(idx)},
+ # no UNIQUE constraint on UIDVALIDITY as two mailboxes may share the same value
+ q{UIDVALIDITY UNSIGNED INT NOT NULL CHECK (UIDVALIDITY > 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)},
+ # no UNIQUE constraint on UIDVALIDITY as two mailboxes may share the same value
+ q{UIDVALIDITY UNSIGNED INT NOT NULL CHECK (UIDVALIDITY > 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 => [
+ q{idx INTEGER NOT NULL REFERENCES mailboxes(idx)},
+ q{lUID UNSIGNED INT NOT NULL CHECK (lUID > 0)},
+ 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 (except for interrupted syncs)
+ # mapping.idx must be found among local.idx (and remote.idx)
+ ],
+ );
+
+ # Use the user_version PRAGMA (0 if unset) to keep track of schema
+ # version https://sqlite.org/pragma.html#pragma_user_version
+ my ($schema_version) = $DBH->selectrow_array("PRAGMA user_version");
+
+ if ($schema_version < $DATABASE_VERSION) {
+ # schema creation or upgrade required
+ if ($schema_version == 0) {
+ my $sth = $DBH->table_info(undef, undef, undef, "TABLE");
+ unless (defined $sth->fetch()) {
+ # there are no tables, create everything
+ msg(undef, "Creating new schema in database file $DBFILE");
+ for (my $i = 0; $i <= $#schema; $i+=2) {
+ $DBH->do("CREATE TABLE $schema[$i] (".join(", ", @{$schema[$i+1]}).")");
+ }
+ goto SCHEMA_DONE; # skip the below migrations
+ }
+ }
+ msg(undef, "Upgrading database version from $schema_version");
+ # 12-step procedure from https://www.sqlite.org/lang_altertable.html
+ if ($schema_version < 1) {
+ fail(undef, "Local and remote hierachy delimiters differ ",
+ "(local ", print_delimiter($IMAP->{local}->{delimiter}), ", ",
+ "remote ", print_delimiter($IMAP->{remote}->{delimiter}), "), ",
+ "refusing to update \`mailboxes\` table.")
+ if defined $IMAP->{local}->{delimiter} and defined $IMAP->{remote}->{delimiter}
+ # we failed earlier if only one of them was NIL
+ and $IMAP->{local}->{delimiter} ne $IMAP->{remote}->{delimiter};
+ $DBH->do("PRAGMA foreign_keys = OFF");
+ $DBH->do("CREATE TABLE _tmp${DATABASE_VERSION}_mailboxes (". join(", ",
+ q{idx INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT},
+ q{mailbox BLOB COLLATE BINARY NOT NULL CHECK (mailbox != '') UNIQUE},
+ q{subscribed BOOLEAN NOT NULL}
+ ).")");
+ if (defined (my $d = $IMAP->{local}->{delimiter})) {
+ # local and remote delimiters match, replace them with null characters
+ my $sth = $DBH->prepare("INSERT INTO _tmp${DATABASE_VERSION}_mailboxes
+ SELECT idx, CAST(REPLACE(mailbox, ?, x'00') AS BLOB), subscribed FROM mailboxes");
+ $sth->bind_param(1, $IMAP->{local}->{delimiter}, SQL_VARCHAR);
+ $sth->execute();
+ } else {
+ # treat all mailboxes as flat (\NoInferiors names)
+ $DBH->do("INSERT INTO _tmp${DATABASE_VERSION}_mailboxes SELECT * FROM mailboxes");
+ }
+ $DBH->do("DROP TABLE mailboxes");
+ $DBH->do("ALTER TABLE _tmp${DATABASE_VERSION}_mailboxes RENAME TO mailboxes");
+ $DBH->do("PRAGMA foreign_keys = ON");
+ }
+ SCHEMA_DONE:
+ $DBH->do("PRAGMA user_version = $DATABASE_VERSION");
+ $DBH->commit();
+ }
+}
##############################################################################
#
# Add a new mailbox to the database.
-my $STH_INSERT_MAILBOX = $DBH->prepare(q{INSERT INTO mailboxes (mailbox,subscribed) VALUES (?,?)});
+# WARN: does not commit changes!
+sub db_create_mailbox($$) {
+ my ($mailbox, $subscribed) = @_;;
+ state $sth = $DBH->prepare(q{INSERT INTO mailboxes (mailbox,subscribed) VALUES (?,?)});
+ $sth->bind_param(1, $mailbox, SQL_BLOB);
+ $sth->bind_param(2, $subscribed, SQL_BOOLEAN);
+ my $r = $sth->execute();
+ msg("database", fmt("Created mailbox %d", $mailbox));
+ return $r;
+}
# Get the index associated with a mailbox.
-my $STH_GET_INDEX = $DBH->prepare(q{SELECT idx,subscribed FROM mailboxes WHERE mailbox = ?});
+sub db_get_mailbox_idx($) {
+ my $mailbox = shift;
+ state $sth = $DBH->prepare(q{SELECT idx,subscribed FROM mailboxes WHERE mailbox = ?});
+ $sth->bind_param(1, $mailbox, SQL_BLOB);
+ $sth->execute();
+ my ($idx, $subscribed) = $sth->fetchrow_array();
+ die if defined $sth->fetch(); # safety check (we have a UNIQUE contstraint though)
+ return wantarray ? ($idx, $subscribed) : $idx;
+}
+
+# Transform mailbox name from internal representation (with \0 as hierarchy delimiters)
+# to a name understandable by the local/remote IMAP server.
+sub mbx_name($$) {
+ my ($name, $mailbox) = @_;
+ my $x = $name // "local";
+ if (defined (my $d = $IMAP->{$x}->{delimiter})) {
+ $mailbox =~ s/\x00/$d/g;
+ } elsif (!exists $IMAP->{$x}->{delimiter} or index($mailbox,"\x00") >= 0) {
+ die; # safety check
+ }
+ return $mailbox;
+}
+
+# Transform mailbox name from local/remote IMAP server to the internal representation
+# (with \0 as hierarchy delimiters).
+sub mbx_unname($$) {
+ my ($name, $mailbox) = @_;
+ return unless defined $mailbox;
+
+ if (defined (my $d = $IMAP->{$name}->{delimiter})) {
+ $mailbox =~ s/\Q$d\E/\x00/g;
+ } elsif (!exists $IMAP->{$name}->{delimiter}) {
+ die; # safety check
+ }
+ return $mailbox;
+}
+
+# Format a message with format controls for local/remote/database mailbox names.
+sub fmt($@) {
+ my $msg = shift;
+ $msg =~ s/%([lrds])/
+ $1 eq "l" ? mbx_name("local", shift)
+ : $1 eq "r" ? mbx_name("remote", shift)
+ : $1 eq "d" ? mbx_name(undef, shift)
+ : $1 eq "s" ? shift
+ : die
+ /ge;
+ return $msg;
+}
# Return true if $mailbox exists on $name
sub mbx_exists($$) {
my ($name, $mailbox) = @_;
my $attrs = $IMAP->{$name}->{mailboxes}->{$mailbox};
- return (defined $attrs and !grep {lc $_ eq lc '\NonExistent'} @$attrs) ? 1 : 0;
+ my ($ne, $ns) = (lc '\NonExistent', lc '\NoSelect');
+ return (defined $attrs and !grep {my $a = lc; $a eq $ne or $a eq $ns} @$attrs) ? 1 : 0;
}
# Return true if $mailbox is subscribed to on $name
@@ -379,36 +514,33 @@ sub mbx_subscribed($$) {
# Process --delete command
#
if (defined $COMMAND and $COMMAND eq 'delete') {
- my $sth_delete_mailboxes = $DBH->prepare(q{DELETE FROM mailboxes WHERE idx = ?});
- my $sth_delete_local = $DBH->prepare(q{DELETE FROM local WHERE idx = ?});
- my $sth_delete_remote = $DBH->prepare(q{DELETE FROM remote WHERE idx = ?});
- my $sth_delete_mapping = $DBH->prepare(q{DELETE FROM mapping WHERE idx = ?});
-
+ if (defined (my $d = $IMAP->{local}->{delimiter})) {
+ s/\Q$d\E/\x00/g foreach @ARGV;
+ }
+ my @statements = map { $DBH->prepare("DELETE FROM $_ WHERE idx = ?") }
+ # non-referenced tables first to avoid violating
+ # FOREIGN KEY constraints
+ qw/mapping local remote mailboxes/
+ if @ARGV and $CONFIG{target}->{database};
foreach my $mailbox (@ARGV) {
- $STH_GET_INDEX->execute($mailbox);
- my ($idx) = $STH_GET_INDEX->fetchrow_array();
- die if defined $STH_GET_INDEX->fetch(); # sanity check
+ my $idx = db_get_mailbox_idx($mailbox);
# delete $mailbox on servers where $mailbox exists. note that
# there is a race condition where the mailbox could have
# appeared meanwhile
foreach my $name (qw/local remote/) {
- next unless $CONFIG{target}->{$name};
- $IMAP->{$name}->{client}->delete($mailbox) if mbx_exists($name, $mailbox);
+ my $mbx = mbx_name($name, $mailbox);
+ $IMAP->{$name}->{client}->delete($mbx)
+ if $CONFIG{target}->{$name} and mbx_exists($name, $mbx);
}
if (defined $idx and $CONFIG{target}->{database}) {
- my $r1 = $sth_delete_mapping->execute($idx);
- msg('database', "WARNING: `DELETE FROM mapping WHERE idx = $idx` failed") unless $r1;
- my $r2 = $sth_delete_local->execute($idx);
- msg('database', "WARNING: `DELETE FROM local WHERE idx = $idx` failed") unless $r2;
- my $r3 = $sth_delete_remote->execute($idx);
- msg('database', "WARNING: `DELETE FROM remote WHERE idx = $idx` failed") unless $r3;
- my $r4 = $sth_delete_mailboxes->execute($idx);
- msg('database', "WARNING: `DELETE FROM mailboxes WHERE idx = $idx` failed") unless $r4;
-
+ foreach my $sth (@statements) {
+ $sth->bind_param(1, $idx, SQL_INTEGER);
+ $sth->execute();
+ }
$DBH->commit();
- msg('database', "Removed mailbox $mailbox") if $r4;
+ msg("database", fmt("Removed mailbox %d", $mailbox));
}
}
exit 0;
@@ -420,55 +552,66 @@ if (defined $COMMAND and $COMMAND eq 'delete') {
#
elsif (defined $COMMAND and $COMMAND eq 'rename') {
my ($from, $to) = @ARGV;
+ if (defined (my $d = $IMAP->{local}->{delimiter})) {
+ s/\Q$d\E/\x00/g foreach ($from, $to);
+ }
# get index of the original name
- $STH_GET_INDEX->execute($from);
- my ($idx) = $STH_GET_INDEX->fetchrow_array();
- die if defined $STH_GET_INDEX->fetch(); # sanity check
+ my $idx = db_get_mailbox_idx($from);
# ensure the target name doesn't already exist on the servers. there
# is a race condition where the mailbox would be created before we
# issue the RENAME command, then the server would reply with a
# tagged NO response
foreach my $name (qw/local remote/) {
- next unless $CONFIG{target}->{$name};
- fail($name, "Mailbox $to exists. Run `$NAME --target=$name --delete $to` to delete.")
- if mbx_exists($name, $to);
+ my $mbx = mbx_name($name, $to);
+ next unless $CONFIG{target}->{$name} and mbx_exists($name, $mbx);
+ fail($name, fmt("Mailbox %s exists. Run `$NAME --target=$name --delete %d` to delete.", $mbx, $to));
}
# ensure the target name doesn't already exist in the database
- $STH_GET_INDEX->execute($to);
- fail("database", "Mailbox $to exists. Run `$NAME --target=database --delete $to` to delete.")
- if defined $STH_GET_INDEX->fetch() and $CONFIG{target}->{database};
+ fail("database", fmt("Mailbox %d exists. Run `$NAME --target=database --delete %d` to delete.", $to, $to))
+ if $CONFIG{target}->{database} and defined db_get_mailbox_idx($to);
- # rename $from to $to on servers where $from exists. again there is
- # a race condition, but if $to has been created meanwhile the server
- # will reply with a tagged NO response
+ # rename $from to $to on servers where $from if LISTed. again there is a
+ # race condition, but if $to has been created meanwhile the server will
+ # reply with a tagged NO response
foreach my $name (qw/local remote/) {
next unless $CONFIG{target}->{$name};
- $IMAP->{$name}->{client}->rename($from, $to) if mbx_exists($name, $from);
+ my ($from, $to) = ( mbx_name($name,$from), mbx_name($name, $to) );
+ # don't use mbx_exists() here, as \NonExistent names can be renamed
+ # too (for instance if they have children)
+ $IMAP->{$name}->{client}->rename($from, $to)
+ if defined $IMAP->{$name}->{mailboxes}->{$from};
}
# rename from to $to in the database
- if (defined $idx and $CONFIG{target}->{database}) {
- my $sth_rename_mailbox = $DBH->prepare(q{UPDATE mailboxes SET mailbox = ? WHERE idx = ?});
- my $r = $sth_rename_mailbox->execute($to, $idx);
- msg('database', "WARNING: `UPDATE mailboxes SET mailbox = ".$DBH->quote($to)." WHERE idx = $idx` failed") unless $r;
-
- # for non-flat mailboxes, rename the children as well
- # (we made sure the local and remote delimiters were identical already)
- if (defined (my $delim = $IMAP->{local}->{delimiter})) {
- my $prefix = $from.$delim;
- my $sth_rename_children = $DBH->prepare(q{
- UPDATE mailboxes SET mailbox = ? || SUBSTR(mailbox,?)
- WHERE SUBSTR(mailbox,1,?) = ?
+ if ($CONFIG{target}->{database}) {
+ my $r = 0;
+ if (defined $idx) {
+ my $sth_rename_mailbox = $DBH->prepare(q{
+ UPDATE mailboxes SET mailbox = ? WHERE idx = ?
});
- $sth_rename_children->execute($to, length($prefix), length($prefix), $prefix);
+ $sth_rename_mailbox->bind_param(1, $to, SQL_BLOB);
+ $sth_rename_mailbox->bind_param(2, $idx, SQL_INTEGER);
+ $r += $sth_rename_mailbox->execute();
}
+ # now rename the children as well
+ my $prefix = $from."\x00";
+ my $sth_rename_children = $DBH->prepare(q{
+ UPDATE mailboxes SET mailbox = CAST(? || SUBSTR(mailbox,?) AS BLOB)
+ WHERE SUBSTR(mailbox,1,?) = ?
+ });
+ $sth_rename_children->bind_param(1, $to, SQL_BLOB);
+ $sth_rename_children->bind_param(2, length($prefix), SQL_INTEGER);
+ $sth_rename_children->bind_param(3, length($prefix), SQL_INTEGER);
+ $sth_rename_children->bind_param(4, $prefix, SQL_BLOB);
+ $r += $sth_rename_children->execute();
+
$DBH->commit();
- msg('database', "Renamed mailbox $from to $to") if $r;
+ msg("database", fmt("Renamed mailbox %d to %d", $from, $to)) if $r > 0;
}
exit 0;
}
@@ -479,8 +622,14 @@ elsif (defined $COMMAND and $COMMAND eq 'rename') {
sub sync_mailbox_list() {
my (%mailboxes, @mailboxes);
+ state $sth_subscribe = $DBH->prepare(q{
+ UPDATE mailboxes SET subscribed = ? WHERE idx = ?
+ });
+
foreach my $name (qw/local remote/) {
foreach my $mbx (keys %{$IMAP->{$name}->{mailboxes}}) {
+ $mbx = mbx_unname($name, $mbx);
+
# exclude ignored mailboxes (taken from the default config as it doesn't
# make sense to ignore mailboxes from one side but not the other
next if !@ARGV and defined $CONF->{_}->{"ignore-mailbox"}
@@ -489,116 +638,78 @@ sub sync_mailbox_list() {
}
}
- my $sth_subscribe = $DBH->prepare(q{UPDATE mailboxes SET subscribed = ? WHERE idx = ?});
-
foreach my $mailbox (keys %mailboxes) {
- my ($lExists, $rExists) = map {mbx_exists($_,$mailbox)} qw/local remote/;
+ my ($lMailbox, $rMailbox) = map {mbx_name($_, $mailbox)} qw/local remote/;
+ my $lExists = mbx_exists("local", $lMailbox);
+ my $rExists = mbx_exists("remote", $rMailbox);
next unless $lExists or $rExists;
- my @attrs = do {
- my %attrs = map {$_ => 1} (@{$IMAP->{local}->{mailboxes}->{$mailbox} // []},
- @{$IMAP->{remote}->{mailboxes}->{$mailbox} // []});
- keys %attrs;
- };
-
- push @mailboxes, $mailbox unless grep {lc $_ eq lc '\NoSelect'} @attrs;
-
- $STH_GET_INDEX->execute($mailbox);
- my ($idx,$subscribed) = $STH_GET_INDEX->fetchrow_array();
- die if defined $STH_GET_INDEX->fetch(); # sanity check
+ push @mailboxes, $mailbox;
+ my ($idx, $subscribed) = db_get_mailbox_idx($mailbox);
if ($lExists and $rExists) {
# $mailbox exists on both sides
- my ($lSubscribed,$rSubscribed) = map {mbx_subscribed($_, $mailbox)} qw/local remote/;
+ my $lSubscribed = mbx_subscribed("local", $lMailbox);
+ my $rSubscribed = mbx_subscribed("remote", $rMailbox);
if (defined $idx) {
if ($lSubscribed xor $rSubscribed) {
# mailbox is subscribed on only one server
if ($subscribed) { # unsubscribe
- my $name = $lSubscribed ? 'local' : 'remote';
- $IMAP->{$name}->{client}->unsubscribe($mailbox);
- }
- else { # subscribe
- my $name = $lSubscribed ? 'remote' : 'local';
- $IMAP->{$name}->{client}->subscribe($mailbox);
+ my ($imap, $mbx) = $lSubscribed ? ($lIMAP, $lMailbox) : ($rIMAP, $rMailbox);
+ $imap->unsubscribe($mbx);
+ } else { # subscribe
+ my ($imap, $mbx) = $lSubscribed ? ($rIMAP, $rMailbox) : ($lIMAP, $lMailbox);
+ $imap->subscribe($mbx);
}
# toggle subscribtion in the database
$subscribed = $subscribed ? 0 : 1;
- $sth_subscribe->execute($subscribed, $idx) or
- msg('database', "WARNING: `UPDATE mailboxes SET subscribed = $subscribed WHERE idx = $idx` failed");
+ $sth_subscribe->bind_param(1, $subscribed, SQL_BOOLEAN);
+ $sth_subscribe->bind_param(2, $idx, SQL_INTEGER);
+ $sth_subscribe->execute();
$DBH->commit();
}
- # $mailbox is either subscribed on both servers, or subscribed on both
+ # $mailbox is either subscribed on both servers, or unsubscribed on both
elsif ($lSubscribed xor $subscribed) {
- # update the database if needed
- $sth_subscribe->execute($lSubscribed, $idx) or
- msg('database', "WARNING: `UPDATE mailboxes SET subscribed = $lSubscribed WHERE idx = $idx` failed");
+ # $lSubscribed == $rSubscribed but database needs updating
+ $sth_subscribe->bind_param(1, $lSubscribed, SQL_BOOLEAN);
+ $sth_subscribe->bind_param(2, $idx, SQL_INTEGER);
+ $sth_subscribe->execute();
$DBH->commit();
}
}
else {
# add new mailbox; subscribe on both servers if $mailbox is subscribed on one of them
my $subscribed = ($lSubscribed or $rSubscribed) ? 1 : 0;
- $STH_INSERT_MAILBOX->execute($mailbox, $subscribed);
- $IMAP->{local}->{client}->subscribe($mailbox) if $subscribed and !$lSubscribed;
- $IMAP->{remote}->{client}->subscribe($mailbox) if $subscribed and !$rSubscribed;
+ db_create_mailbox($mailbox, $subscribed);
+ $IMAP->{local}->{client}->subscribe($lMailbox) if $subscribed and !$lSubscribed;
+ $IMAP->{remote}->{client}->subscribe($rMailbox) if $subscribed and !$rSubscribed;
$DBH->commit();
}
}
- elsif ($lExists and !$rExists) {
- # $mailbox is on 'local' only
- fail("database", "Mailbox $mailbox exists. Run `$NAME --target=database --delete $mailbox` to delete.")
+ elsif ($lExists or $rExists) {
+ # $mailbox is on one server only
+ fail("database", fmt("Mailbox %d exists. Run `$NAME --target=database --delete %d` to delete.", $mailbox, $mailbox))
if defined $idx;
- my $subscribed = mbx_subscribed('local', $mailbox);
- $STH_INSERT_MAILBOX->execute($mailbox, $subscribed);
- $IMAP->{remote}->{client}->create($mailbox, 1);
- $IMAP->{remote}->{client}->subscribe($mailbox) if $subscribed;
- $DBH->commit();
- }
- elsif (!$lExists and $rExists) {
- # $mailbox is on 'remote' only
- fail("database", "Mailbox $mailbox exists. Run `$NAME --target=database --delete $mailbox` to delete.")
- if defined $idx;
- my $subscribed = mbx_subscribed('remote', $mailbox);
- $STH_INSERT_MAILBOX->execute($mailbox, $subscribed);
- $IMAP->{local}->{client}->create($mailbox, 1);
- $IMAP->{local}->{client}->subscribe($mailbox) if $subscribed;
+ my ($name1, $name2, $mbx1, $mbx2) = $lExists ? ("local", "remote", $lMailbox, $rMailbox)
+ : ("remote", "local", $rMailbox, $lMailbox);
+ my $subscribed = mbx_subscribed($name1, $mbx1);
+ db_create_mailbox($mailbox, $subscribed);
+ $IMAP->{$name2}->{client}->create($mbx2, 1);
+ $IMAP->{$name2}->{client}->subscribe($mbx2) if $subscribed;
$DBH->commit();
}
}
return @mailboxes;
}
-my @MAILBOXES = sync_mailbox_list();
($lIMAP, $rIMAP) = map {$IMAP->{$_}->{client}} qw/local remote/;
+my @MAILBOXES = sync_mailbox_list();
my $ATTRS = join ' ', qw/MODSEQ FLAGS INTERNALDATE BODY.PEEK[]/;
#############################################################################
# Synchronize messages
-# Get all cached states from the database.
-my $STH_GET_CACHE = $DBH->prepare(q{
- SELECT mailbox, m.idx AS idx,
- 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
-});
-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 = ?
-});
-
-# Find local/remote UID from the map.
-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(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 = ?});
my $STH_UPDATE_REMOTE_HIGHESTMODSEQ = $DBH->prepare(q{UPDATE remote SET HIGHESTMODSEQ = ? WHERE idx = ?});
@@ -611,34 +722,6 @@ my $STH_UPDATE_REMOTE = $DBH->prepare(q{UPDATE remote SET UIDNEXT = ?, HIGHESTMO
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)
-});
-
-# Count messages
-my $STH_COUNT_MESSAGES = $DBH->prepare(q{SELECT COUNT(*) FROM mapping WHERE idx = ?});
-
-# List last 1024 messages UIDs
-my $STH_LASTUIDs_LOCAL = $DBH->prepare(q{SELECT lUID FROM mapping WHERE idx = ? ORDER BY lUID DESC LIMIT 1024});
-my $STH_LASTUIDs_REMOTE = $DBH->prepare(q{SELECT rUID FROM mapping WHERE idx = ? ORDER BY rUID DESC LIMIT 1024});
-
-
# Download some missing UIDs from $source; returns the new allocated UIDs
sub download_missing($$$@) {
my $idx = shift;
@@ -647,22 +730,22 @@ sub download_missing($$$@) {
my @set = @_;
my @uids;
- my $target = $source eq 'local' ? 'remote' : 'local';
+ my ($target, $f) = $source eq 'local' ? ('remote', '%l') : ('local', '%r');
+ my $prefix = fmt("%s($f)", $source, $mailbox) unless $CONFIG{quiet};
my ($buff, $bufflen) = ([], 0);
undef $buff if ($target eq 'local' ? $lIMAP : $rIMAP)->incapable('MULTIAPPEND');
- my $attrs = $ATTRS.' ENVELOPE';
- ($source eq 'local' ? $lIMAP : $rIMAP)->fetch(compact_set(@set), "($attrs)", sub($) {
+ ($source eq 'local' ? $lIMAP : $rIMAP)->fetch(compact_set(@set), "($ATTRS ENVELOPE)", sub($) {
my $mail = shift;
return unless exists $mail->{RFC822}; # not for us
- my $uid = $mail->{UID};
- my $from = first { defined $_ and @$_ } @{$mail->{ENVELOPE}}[2,3,4];
- $from = (defined $from and defined $from->[0]->[2] and defined $from->[0]->[3])
- ? $from->[0]->[2].'@'.$from->[0]->[3] : '';
- msg(undef, "$source($mailbox): UID $uid from <$from> ($mail->{INTERNALDATE})") unless $CONFIG{quiet};
-
+ unless ($CONFIG{quiet}) {
+ my $from = first { defined $_ and @$_ } @{$mail->{ENVELOPE}}[2,3,4];
+ $from = (defined $from and defined $from->[0]->[2] and defined $from->[0]->[3])
+ ? $from->[0]->[2].'@'.$from->[0]->[3] : '';
+ msg($prefix, "UID $mail->{UID} from <$from> ($mail->{INTERNALDATE})");
+ }
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;
@@ -676,18 +759,24 @@ sub flag_conflict($$$$$) {
my %flags = map {$_ => 1} (split(/ /, $lFlags), split(/ /, $rFlags));
my $flags = join ' ', sort(keys %flags);
- msg(undef, "WARNING: Conflicting flag update in $mailbox for local UID $lUID ($lFlags) ".
- "and remote UID $rUID ($rFlags). Setting both to the union ($flags).");
-
+ msg(undef, fmt("WARNING: Conflicting flag update in %d for local UID $lUID (%s) ".
+ "and remote UID $rUID (%s). Setting both to the union (%s).",
+ $mailbox, $lFlags, $rFlags, $flags));
return $flags
}
-# Delete a mapping ($idx, $lUID)
+# Delete a mapping ($idx, $lUID) from the database
+# WARN: Never commit before the messages have been EXPUNGEd on both sides!
sub delete_mapping($$) {
my ($idx, $lUID) = @_;
- my $r = $STH_DELETE_MAPPING->execute($idx, $lUID);
- die if $r > 1; # sanity check
+ state $sth = $DBH->prepare(q{
+ DELETE FROM mapping WHERE idx = ? and lUID = ?
+ });
+ $sth->bind_param(1, $idx, SQL_INTEGER);
+ $sth->bind_param(2, $lUID, SQL_INTEGER);
+ my $r = $sth->execute();
+ die if $r > 1; # safety check (even if we have a UNIQUE constraint)
msg('database', "WARNING: Can't delete (idx,lUID) = ($idx,$lUID)") if $r == 0;
}
@@ -699,25 +788,23 @@ sub delete_mapping($$) {
# we let the server know that the messages have been EXPUNGEd [RFC7162,
# section 3.2.5.2].
# The UID set is the largest set of higest UIDs with at most 1024 UIDs,
-# of length (after compacting) at most 64.
+# of length (once compacted) at most 64.
# The reason why we sample with the highest UIDs is that lowest UIDs are
# less likely to be deleted.
-sub sample($$$) {
- my ($idx, $count, $sth) = @_;
+sub sample($$) {
+ my ($count, $sth) = @_;
return unless $count > 0;
-
my ($n, $uids, $min, $max);
- $sth->execute($idx);
+
+ $sth->execute(); # /!\ assume placeholders are bound already
while (defined (my $row = $sth->fetchrow_arrayref())) {
my $k = $row->[0];
if (!defined $min and !defined $max) {
$n = 0;
$min = $max = $k;
- }
- elsif ($k == $min - 1) {
+ } elsif ($k == $min - 1) {
$min--;
- }
- else {
+ } else {
$n += $max - $min + 1;
$uids = ($min == $max ? $min : "$min:$max")
.(defined $uids ? ','.$uids : '');
@@ -730,9 +817,10 @@ sub sample($$$) {
}
if (!defined $uids or length($uids) <= 64) {
$n += $max - $min + 1;
- $uids = ($min == $max ? $min : "$min:$max")
- .(defined $uids ? ','.$uids : '');
+ $uids = ($min == $max ? $min : "$min:$max")
+ . (defined $uids ? ','.$uids : '');
}
+ die unless $n <= $count; # impossible
return ( ($count - $n + 1).':'.$count, $uids );
}
@@ -741,12 +829,33 @@ sub sample($$$) {
sub select_mbx($$) {
my ($idx, $mailbox) = @_;
- $STH_COUNT_MESSAGES->execute($idx);
- my ($count) = $STH_COUNT_MESSAGES->fetchrow_array();
- die if defined $STH_COUNT_MESSAGES->fetch(); # sanity check
+ # Count messages
+ state $sth_count_messages = $DBH->prepare(q{
+ SELECT COUNT(*) FROM mapping WHERE idx = ?
+ });
+ $sth_count_messages->bind_param(1, $idx, SQL_INTEGER);
+ $sth_count_messages->execute();
+
+ my ($count) = $sth_count_messages->fetchrow_array();
+ $sth_count_messages->finish();
+
+ # List last 1024 messages UIDs
+ state $sth_last_lUIDs = $DBH->prepare(q{
+ SELECT lUID FROM mapping
+ WHERE idx = ?
+ ORDER BY lUID DESC
+ LIMIT 1024
+ });
+ state $sth_last_rUIDs = $DBH->prepare(q{
+ SELECT rUID FROM mapping
+ WHERE idx = ?
+ ORDER BY rUID DESC
+ LIMIT 1024
+ });
- $lIMAP->select($mailbox, sample($idx, $count, $STH_LASTUIDs_LOCAL));
- $rIMAP->select($mailbox, sample($idx, $count, $STH_LASTUIDs_REMOTE));
+ $_->bind_param(1, $idx, SQL_INTEGER) foreach ($sth_last_lUIDs, $sth_last_rUIDs);
+ $lIMAP->select(mbx_name(local => $mailbox), sample($count, $sth_last_lUIDs));
+ $rIMAP->select(mbx_name(remote => $mailbox), sample($count, $sth_last_rUIDs));
}
@@ -754,59 +863,56 @@ sub select_mbx($$) {
# (in a very crude way, by downloading all existing UID with their flags)
sub repair($) {
my $mailbox = shift;
+ my $idx = db_get_mailbox_idx($mailbox) // return; # not in the database
+ my $cache = db_get_cache_by_idx($idx) // return; # no cache
- $STH_GET_INDEX->execute($mailbox);
- my ($idx) = $STH_GET_INDEX->fetchrow_array();
- die if defined $STH_GET_INDEX->fetch(); # sanity check
-
- return unless defined $idx; # not in the database
- select_mbx($idx, $mailbox);
-
- $STH_GET_CACHE_BY_IDX->execute($idx);
- my $cache = $STH_GET_CACHE_BY_IDX->fetchrow_hashref() // return; # no cache
- die if defined $STH_GET_CACHE_BY_IDX->fetch(); # sanity check
+ # don't use select_mbx() as we don't need to sample here
+ $lIMAP->select(mbx_name(local => $mailbox));
+ $rIMAP->select(mbx_name(remote => $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 (%lVanished, %rVanished);
+ $lVanished{$_} = 1 foreach @$lVanished;
+ $rVanished{$_} = 1 foreach @$rVanished;
my (@lToRemove, %lToUpdate, @lMissing);
my (@rToRemove, %rToUpdate, @rMissing);
my @delete_mapping;
- # 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);
- while (defined (my $row = $STH_GET_MAPPING->fetch())) {
+ # process each pair ($lUID,$rUID) found in the mapping table for the given index,
+ # and compare with the result from the IMAP servers to detect anomalies
+ state $sth_get_mappings = $DBH->prepare(q{
+ SELECT lUID,rUID FROM mapping WHERE idx = ?
+ });
+ $sth_get_mappings->bind_param(1, $idx, SQL_INTEGER);
+ $sth_get_mappings->execute();
+ while (defined (my $row = $sth_get_mappings->fetchrow_arrayref())) {
my ($lUID, $rUID) = @$row;
- if (defined $lModified->{$lUID} and defined $rModified->{$rUID}) {
+ if (defined (my $l = $lModified->{$lUID}) and defined (my $r = $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]);
+ my ($lModSeq, $lFlags) = @$l;
+ my ($rModSeq, $rFlags) = @$r;
if ($lFlags eq $rFlags) {
- # no conflict
+ # no conflict, whee
}
- elsif ($lModified->{$lUID}->[0] <= $cache->{lHIGHESTMODSEQ} and
- $rModified->{$rUID}->[0] > $cache->{rHIGHESTMODSEQ}) {
+ elsif ($lModSeq <= $cache->{lHIGHESTMODSEQ} and $rModSeq > $cache->{rHIGHESTMODSEQ}) {
# set $lUID to $rFlags
$lToUpdate{$rFlags} //= [];
push @{$lToUpdate{$rFlags}}, $lUID;
}
- elsif ($lModified->{$lUID}->[0] > $cache->{lHIGHESTMODSEQ} and
- $rModified->{$rUID}->[0] <= $cache->{rHIGHESTMODSEQ}) {
+ elsif ($lModSeq > $cache->{lHIGHESTMODSEQ} and $rModSeq <= $cache->{rHIGHESTMODSEQ}) {
# set $rUID to $lFlags
$rToUpdate{$lFlags} //= [];
push @{$rToUpdate{$lFlags}}, $rUID;
}
else {
# conflict
- msg(undef, "WARNING: Missed flag update in $mailbox for (lUID,rUID) = ($lUID,$rUID). Repairing.")
- if $lModified->{$lUID}->[0] <= $cache->{lHIGHESTMODSEQ} and
- $rModified->{$rUID}->[0] <= $cache->{rHIGHESTMODSEQ};
+ msg(undef, fmt("WARNING: Missed flag update in %d for (lUID,rUID) = ($lUID,$rUID). Repairing.", $mailbox))
+ if $lModSeq <= $cache->{lHIGHESTMODSEQ} and $rModSeq <= $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} //= [];
@@ -816,17 +922,16 @@ sub repair($) {
}
}
elsif (!defined $lModified->{$lUID} and !defined $rModified->{$rUID}) {
- unless ($lVanished{$lUID} and $rVanished{$rUID}) {
- msg(undef, "WARNING: Pair (lUID,rUID) = ($lUID,$rUID) vanished from $mailbox. Repairing.");
- push @delete_mapping, $lUID;
- }
+ push @delete_mapping, $lUID;
+ msg(undef, fmt("WARNING: Pair (lUID,rUID) = ($lUID,$rUID) vanished from %d. Repairing.", $mailbox))
+ unless $lVanished{$lUID} and $rVanished{$rUID};
}
elsif (!defined $lModified->{$lUID}) {
push @delete_mapping, $lUID;
if ($lVanished{$lUID}) {
push @rToRemove, $rUID;
} else {
- msg("local($mailbox)", "WARNING: UID $lUID disappeared. Downloading remote UID $rUID again.");
+ msg(fmt("local(%l)", $mailbox), "WARNING: UID $lUID disappeared. Downloading remote UID $rUID again.");
push @rMissing, $rUID;
}
}
@@ -835,7 +940,7 @@ sub repair($) {
if ($rVanished{$rUID}) {
push @lToRemove, $lUID;
} else {
- msg("remote($mailbox)", "WARNING: UID $rUID disappeared. Downloading local UID $lUID again.");
+ msg(fmt("remote(%r)",$mailbox), "WARNING: UID $rUID disappeared. Downloading local UID $lUID again.");
push @lMissing, $lUID;
}
}
@@ -862,21 +967,20 @@ sub repair($) {
$rIMAP->push_flag_updates($rFlags, @$rUIDs);
}
-
# Process UID found in IMAP but not in the mapping table.
my @lDunno = keys %lVanished;
my @rDunno = keys %rVanished;
- msg("remote($mailbox)", "WARNING: No match for ".($#lDunno+1)." vanished local UID(s) "
+ msg(fmt("remote(%r)",$mailbox), "WARNING: No match for ".($#lDunno+1)." vanished local UID(s) "
.compact_set(@lDunno).". Ignoring.") if @lDunno;
- msg("local($mailbox)", "WARNING: No match for ".($#rDunno+1)." vanished remote UID(s) "
+ msg(fmt("local(%l)",$mailbox), "WARNING: No match for ".($#rDunno+1)." vanished remote UID(s) "
.compact_set(@rDunno).". Ignoring.") if @rDunno;
foreach my $lUID (keys %$lModified) {
- msg("remote($mailbox)", "WARNING: No match for modified local UID $lUID. Downloading again.");
+ msg(fmt("remote(%r)",$mailbox), "WARNING: No match for modified local UID $lUID. Downloading again.");
push @lMissing, $lUID;
}
foreach my $rUID (keys %$rModified) {
- msg("local($mailbox)", "WARNING: No match for modified remote UID $rUID. Downloading again.");
+ msg(fmt("local(%l)",$mailbox), "WARNING: No match for modified remote UID $rUID. Downloading again.");
push @rMissing, $rUID;
}
@@ -897,7 +1001,19 @@ sub sync_known_messages($$) {
my ($idx, $mailbox) = @_;
my $update = 0;
- # loop since processing might produce VANISHED or unsollicited FETCH responses
+ # Find local/remote UID from the mapping table.
+ state $sth_get_local_uid = $DBH->prepare(q{
+ SELECT lUID
+ FROM mapping
+ WHERE idx = ? and rUID = ?
+ });
+ state $sth_get_remote_uid = $DBH->prepare(q{
+ SELECT rUID
+ FROM mapping
+ WHERE idx = ? and lUID = ?
+ });
+
+ # loop since processing might produce VANISHED or unsolicited FETCH responses
while (1) {
my ($lVanished, $lModified, $rVanished, $rModified);
@@ -920,31 +1036,33 @@ sub sync_known_messages($$) {
my (@lToRemove, @rToRemove, @lDunno, @rDunno);
foreach my $lUID (@$lVanished) {
- $STH_GET_REMOTE_UID->execute($idx, $lUID);
- my ($rUID) = $STH_GET_REMOTE_UID->fetchrow_array();
- die if defined $STH_GET_REMOTE_UID->fetchrow_arrayref(); # sanity check
+ $sth_get_remote_uid->bind_param(1, $idx, SQL_INTEGER);
+ $sth_get_remote_uid->bind_param(2, $lUID, SQL_INTEGER);
+ $sth_get_remote_uid->execute();
+ my ($rUID) = $sth_get_remote_uid->fetchrow_array();
+ die if defined $sth_get_remote_uid->fetch(); # safety check
if (!defined $rUID) {
push @lDunno, $lUID;
- }
- elsif (!exists $rVanished{$rUID}) {
+ } elsif (!exists $rVanished{$rUID}) {
push @rToRemove, $rUID;
}
}
foreach my $rUID (@$rVanished) {
- $STH_GET_LOCAL_UID->execute($idx, $rUID);
- my ($lUID) = $STH_GET_LOCAL_UID->fetchrow_array();
- die if defined $STH_GET_LOCAL_UID->fetchrow_arrayref(); # sanity check
+ $sth_get_local_uid->bind_param(1, $idx, SQL_INTEGER);
+ $sth_get_local_uid->bind_param(2, $rUID, SQL_INTEGER);
+ $sth_get_local_uid->execute();
+ my ($lUID) = $sth_get_local_uid->fetchrow_array();
+ die if defined $sth_get_local_uid->fetch(); # safety check
if (!defined $lUID) {
push @rDunno, $rUID;
- }
- elsif (!exists $lVanished{$lUID}) {
+ } elsif (!exists $lVanished{$lUID}) {
push @lToRemove, $lUID;
}
}
- msg("remote($mailbox)", "WARNING: No match for ".($#lDunno+1)." vanished local UID(s) "
+ msg(fmt("remote(%r)",$mailbox), "WARNING: No match for ".($#lDunno+1)." vanished local UID(s) "
.compact_set(@lDunno).". Ignoring.") if @lDunno;
- msg("local($mailbox)", "WARNING: No match for ".($#rDunno+1)." vanished remote UID(s) "
+ msg(fmt("local(%l)",$mailbox), "WARNING: No match for ".($#rDunno+1)." vanished remote UID(s) "
.compact_set(@rDunno).". Ignoring.") if @rDunno;
$lIMAP->remove_message(@lToRemove) if @lToRemove;
@@ -971,13 +1089,14 @@ sub sync_known_messages($$) {
# trips.
while (my ($lUID,$lFlags) = each %$lModified) {
- $STH_GET_REMOTE_UID->execute($idx, $lUID);
- my ($rUID) = $STH_GET_REMOTE_UID->fetchrow_array();
- die if defined $STH_GET_REMOTE_UID->fetchrow_arrayref(); # sanity check
+ $sth_get_remote_uid->bind_param(1, $idx, SQL_INTEGER);
+ $sth_get_remote_uid->bind_param(2, $lUID, SQL_INTEGER);
+ $sth_get_remote_uid->execute();
+ my ($rUID) = $sth_get_remote_uid->fetchrow_array();
+ die if defined $sth_get_remote_uid->fetch(); # safety check
if (!defined $rUID) {
- msg("remote($mailbox)", "WARNING: No match for modified local UID $lUID. Try '--repair'.");
- }
- elsif (defined (my $rFlags = $rModified->{$rUID})) {
+ msg(fmt("remote(%r)",$mailbox), "WARNING: No match for modified local UID $lUID. Try '--repair'.");
+ } elsif (defined (my $rFlags = $rModified->{$rUID})) {
unless ($lFlags eq $rFlags) {
my $flags = flag_conflict($mailbox, $lUID => $lFlags, $rUID => $rFlags);
$lToUpdate{$flags} //= [];
@@ -985,20 +1104,20 @@ sub sync_known_messages($$) {
$rToUpdate{$flags} //= [];
push @{$rToUpdate{$flags}}, $rUID;
}
- }
- else {
+ } else {
$rToUpdate{$lFlags} //= [];
push @{$rToUpdate{$lFlags}}, $rUID;
}
}
while (my ($rUID,$rFlags) = each %$rModified) {
- $STH_GET_LOCAL_UID->execute($idx, $rUID);
- my ($lUID) = $STH_GET_LOCAL_UID->fetchrow_array();
- die if defined $STH_GET_LOCAL_UID->fetchrow_arrayref(); # sanity check
+ $sth_get_local_uid->bind_param(1, $idx, SQL_INTEGER);
+ $sth_get_local_uid->bind_param(2, $rUID, SQL_INTEGER);
+ $sth_get_local_uid->execute();
+ my ($lUID) = $sth_get_local_uid->fetchrow_array();
+ die if defined $sth_get_local_uid->fetch(); # safety check
if (!defined $lUID) {
- msg("local($mailbox)", "WARNING: No match for modified remote UID $rUID. Try '--repair'.");
- }
- elsif (!exists $lModified->{$lUID}) {
+ msg(fmt("local(%l)",$mailbox), "WARNING: No match for modified remote UID $rUID. Try '--repair'.");
+ } elsif (!exists $lModified->{$lUID}) {
# conflicts are taken care of above
$lToUpdate{$rFlags} //= [];
push @{$lToUpdate{$rFlags}}, $lUID;
@@ -1029,7 +1148,8 @@ sub callback_new_message($$$$;$$$) {
my $length = length ${$mail->{RFC822}};
if ($length == 0) {
- msg("$name($mailbox)", "WARNING: Ignoring new 0-length message (UID $mail->{UID})");
+ my $prefix = $name eq "local" ? "local(%l)" : "remote(%r)";
+ msg(fmt($prefix, $mailbox), "WARNING: Ignoring new 0-length message (UID $mail->{UID})");
return;
}
@@ -1058,16 +1178,23 @@ sub callback_new_message($$$$;$$$) {
sub callback_new_message_flush($$$@) {
my ($idx, $mailbox, $name, @messages) = @_;
- my $imap = $name eq 'local' ? $rIMAP : $lIMAP; # target client
+ my $target = $name eq "local" ? "remote" : "local";
+ my $imap = $target eq "local" ? $lIMAP : $rIMAP; # target client
my @sUID = map {$_->{UID}} @messages;
- my @tUID = $imap->append($mailbox, @messages);
+ my @tUID = $imap->append(mbx_name($target, $mailbox), @messages);
die unless $#sUID == $#tUID; # sanity check
+ state $sth = $DBH->prepare(q{
+ INSERT INTO mapping (idx,lUID,rUID) VALUES (?,?,?)
+ });
my ($lUIDs, $rUIDs) = $name eq 'local' ? (\@sUID,\@tUID) : (\@tUID,\@sUID);
for (my $k=0; $k<=$#messages; $k++) {
- logger(undef, "Adding mapping (lUID,rUID) = ($lUIDs->[$k],$rUIDs->[$k]) for $mailbox")
+ logger(undef, fmt("Adding mapping (lUID,rUID) = ($lUIDs->[$k],$rUIDs->[$k]) for %d", $mailbox))
if $CONFIG{debug};
- $STH_INSERT_MAPPING->execute($idx, $lUIDs->[$k], $rUIDs->[$k]);
+ $sth->bind_param(1, $idx, SQL_INTEGER);
+ $sth->bind_param(2, $lUIDs->[$k], SQL_INTEGER);
+ $sth->bind_param(3, $rUIDs->[$k], SQL_INTEGER);
+ $sth->execute();
}
$DBH->commit(); # commit only once per batch
@@ -1124,87 +1251,138 @@ sub sync_messages($$;$$) {
#############################################################################
# Resume interrupted mailbox syncs (before initializing the cache).
#
-my ($MAILBOX, $IDX);
-$STH_LIST_INTERRUPTED->execute();
-while (defined (my $row = $STH_LIST_INTERRUPTED->fetchrow_arrayref())) {
- next unless grep { $_ eq $row->[1] } @MAILBOXES; # skip ignored mailbox
- ($IDX, $MAILBOX) = @$row;
- msg(undef, "Resuming interrupted sync for $MAILBOX");
-
- 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
+my ($MAILBOX, $IDX); # current mailbox, and its index in our database
- $lIMAP->select($MAILBOX);
- $rIMAP->select($MAILBOX);
+sub db_get_cache_by_idx($) {
+ my $idx = shift;
+ state $sth = $DBH->prepare(q{
+ SELECT 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 local l JOIN remote r ON l.idx = r.idx
+ WHERE l.idx = ?
+ });
+ $sth->bind_param(1, $idx, SQL_INTEGER);
+ $sth->execute();
+ my $cache = $sth->fetchrow_hashref();
+ die if defined $sth->fetch(); # safety check
+ return $cache;
+}
- # FETCH all messages with their FLAGS to detect messages that have
- # vanished meanwhile, or for which there was a flag update.
+{
+ # Get the list of interrupted mailbox syncs.
+ my $sth_list = $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
+ });
- 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 });
+ # For an interrupted mailbox sync, get the pairs (lUID,rUID) that have
+ # already been downloaded.
+ my $sth_get_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 (lUID >= l.UIDNEXT OR rUID >= r.UIDNEXT)
+ AND m.idx = ?
+ });
- 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};
+ $sth_list->execute();
+ while (defined (my $row = $sth_list->fetchrow_arrayref())) {
+ next unless grep { $_ eq $row->[1] } @MAILBOXES; # skip ignored mailboxes
- delete_mapping($IDX, $lUID);
- }
+ ($IDX, $MAILBOX) = @$row;
+ msg(undef, fmt("Resuming interrupted sync for %d", $MAILBOX));
+ my $cache = db_get_cache_by_idx($IDX) // die; # safety check
+ my ($lMailbox, $rMailbox) = map {mbx_name($_, $MAILBOX)} qw/local remote/;
- $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.)
- $STH_GET_CACHE_BY_IDX->execute($IDX);
- if (defined (my $cache = $STH_GET_CACHE_BY_IDX->fetchrow_hashref())) {
- $lIMAP->set_cache($cache->{mailbox},
+ my %lUIDs;
+ $sth_get_by_idx->bind_param(1, $IDX, SQL_INTEGER);
+ $sth_get_by_idx->execute();
+ while (defined (my $row = $sth_get_by_idx->fetchrow_arrayref())) {
+ $lUIDs{$row->[0]} = $row->[1]; # pair ($lUID, $rUID)
+ }
+ die unless %lUIDs; # sanity check
+
+ $lIMAP->select($lMailbox);
+ $rIMAP->select($rMailbox);
+
+ # 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 = "(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.)
+ $lIMAP->set_cache($lMailbox,
UIDVALIDITY => $cache->{lUIDVALIDITY},
UIDNEXT => $cache->{lUIDNEXT}
);
- $rIMAP->set_cache($cache->{mailbox},
+ $rIMAP->set_cache($rMailbox,
UIDVALIDITY => $cache->{rUIDVALIDITY},
UIDNEXT => $cache->{rUIDNEXT}
);
- die if defined $STH_GET_CACHE_BY_IDX->fetch(); # sanity check
+ sync_messages($IDX, $MAILBOX, [keys %lList], [keys %rList]);
}
- sync_messages($IDX, $MAILBOX, [keys %lList], [keys %rList]);
}
#############################################################################
# Initialize $lIMAP and $rIMAP states to detect mailbox dirtyness.
#
+
my %KNOWN_INDEXES;
-$STH_GET_CACHE->execute();
-while (defined (my $row = $STH_GET_CACHE->fetchrow_hashref())) {
- next unless grep {$row->{mailbox} eq $_} @MAILBOXES;
- $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}
- );
- $KNOWN_INDEXES{$row->{idx}} = 1;
+{
+ # Get all cached states from the database.
+ my $sth = $DBH->prepare(q{
+ SELECT mailbox, m.idx AS idx,
+ 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
+ });
+
+ $sth->execute();
+ while (defined (my $row = $sth->fetchrow_hashref())) {
+ next unless grep {$row->{mailbox} eq $_} @MAILBOXES;
+ $lIMAP->set_cache(mbx_name(local => $row->{mailbox}),
+ UIDVALIDITY => $row->{lUIDVALIDITY},
+ UIDNEXT => $row->{lUIDNEXT},
+ HIGHESTMODSEQ => $row->{lHIGHESTMODSEQ}
+ );
+ $rIMAP->set_cache(mbx_name(remote => $row->{mailbox}),
+ UIDVALIDITY => $row->{rUIDVALIDITY},
+ UIDNEXT => $row->{rUIDNEXT},
+ HIGHESTMODSEQ => $row->{rHIGHESTMODSEQ}
+ );
+ $KNOWN_INDEXES{$row->{idx}} = 1;
+ }
}
if (defined $COMMAND and $COMMAND eq 'repair') {
@@ -1220,34 +1398,32 @@ if ($CONFIG{notify}) {
# in batch mode, update the HIGHESTMODSEQ, and *then* issue an explicit UID
# FETCH command to get new message, and process each FETCH response with a
# RFC822/BODY[] attribute as they arrive.
- my $mailboxes = join(' ', map {Net::IMAP::InterIMAP::quote($_)} @MAILBOXES);
- my %mailboxes = map { $_ => [qw/MessageNew MessageExpunge FlagChange/] }
- ( "MAILBOXES ($mailboxes)", 'SELECTED' );
- my %personal = ( personal => [qw/MailboxName SubscriptionChange/] );
+ foreach my $name (qw/local remote/) {
+ my $mailboxes = join(' ', map {Net::IMAP::InterIMAP::quote(mbx_name($name, $_))} @MAILBOXES);
+ my %mailboxes = map { $_ => [qw/MessageNew MessageExpunge FlagChange/] }
+ ( "MAILBOXES ($mailboxes)", 'SELECTED' );
+ my %personal = ( personal => [qw/MailboxName SubscriptionChange/] );
+ my $imap = $name eq "local" ? $lIMAP : $rIMAP;
- foreach ($lIMAP, $rIMAP) {
# require STATUS responses for our @MAILBOXES only
- $_->notify('SET STATUS', %mailboxes);
- $_->notify('SET', %mailboxes, %personal);
+ $imap->notify('SET STATUS', %mailboxes);
+ $imap->notify('SET', %mailboxes, %personal);
}
}
sub loop() {
while(@MAILBOXES) {
- if (defined $MAILBOX and ($lIMAP->is_dirty($MAILBOX) or $rIMAP->is_dirty($MAILBOX))) {
+ if (defined $MAILBOX and ($lIMAP->is_dirty(mbx_name(local => $MAILBOX)) or $rIMAP->is_dirty(mbx_name(remote => $MAILBOX)))) {
# $MAILBOX is dirty on either the local or remote mailbox
sync_messages($IDX, $MAILBOX);
}
else {
- $MAILBOX = $lIMAP->next_dirty_mailbox(@MAILBOXES) // $rIMAP->next_dirty_mailbox(@MAILBOXES) // last;
- $MAILBOX = 'INBOX' if uc $MAILBOX eq 'INBOX'; # INBOX is case insensitive
-
- $STH_GET_INDEX->execute($MAILBOX);
- ($IDX) = $STH_GET_INDEX->fetchrow_array();
- die if defined $STH_GET_INDEX->fetch(); # sanity check
- die unless defined $IDX; # sanity check;
+ $MAILBOX = mbx_unname(local => $lIMAP->next_dirty_mailbox(map {mbx_name(local => $_)} @MAILBOXES))
+ // mbx_unname(remote => $rIMAP->next_dirty_mailbox(map {mbx_name(remote => $_)} @MAILBOXES))
+ // last;
+ $IDX = db_get_mailbox_idx($MAILBOX) // die; # safety check
select_mbx($IDX, $MAILBOX);
if (!$KNOWN_INDEXES{$IDX}) {