From 25362c873c7641341f17e9c2e8d17d82cb3d94c5 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Wed, 15 May 2019 05:06:07 +0200 Subject: interimap: avoid caching hierarchy delimiters forever in the database. Following recommendation from https://www.imapwiki.org/ClientImplementation/MailboxList#Hierarchy_separators 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. We're using SQLite's user_version PRAGMA to keep track of schema version; beware that `.dump` doesn't export its value! In logging messages, local and remote mailbox names are shown as is (with their respective delimiters) while database mailbox names are shown by replacing null characters with the *local* hierarchy delimiter. Moreover for mailbox names specified on the command line or the configuration file (with the "list-mailbox" option) the *local* hierarchy delimiter should be used. --- Changelog | 13 + interimap | 1016 ++++++++++++++++++++++++++++++++++++------------------------- 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 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}) { -- cgit v1.2.3