From 87e1211a4bd101bf6909f42eda826711af7066ae Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Thu, 9 May 2019 17:47:19 +0200 Subject: wibble --- interimap | 4 ++-- interimap.service | 1 + pullimap@.service | 3 ++- 3 files changed, 5 insertions(+), 3 deletions(-) diff --git a/interimap b/interimap index 454d311..5b1bc63 100755 --- a/interimap +++ b/interimap @@ -68,7 +68,7 @@ usage(1) if defined $COMMAND and (defined $CONFIG{watch} or defined $CONFIG{noti usage(1) if $CONFIG{target} and !(defined $COMMAND and ($COMMAND eq 'delete' or $COMMAND eq 'rename')); $CONFIG{watch} = $CONFIG{notify} ? 900 : 60 if (defined $CONFIG{watch} or $CONFIG{notify}) and !$CONFIG{watch}; @ARGV = map {uc $_ eq 'INBOX' ? 'INBOX' : $_ } @ARGV; # INBOX is case-insensitive -die "Invalid mailbox name $_" foreach grep !/\A([\x01-\x7F]+)\z/, @ARGV; +die "Invalid mailbox name $_" foreach grep !/\A[\x01-\x7F]+\z/, @ARGV; my $CONF = do { @@ -564,7 +564,7 @@ my $STH_LASTUIDs_LOCAL = $DBH->prepare(q{SELECT lUID FROM mapping WHERE idx = ? 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 thew allocated UIDs +# Download some missing UIDs from $source; returns the new allocated UIDs sub download_missing($$$@) { my $idx = shift; my $mailbox = shift; diff --git a/interimap.service b/interimap.service index 8e9915f..6d7fa45 100644 --- a/interimap.service +++ b/interimap.service @@ -1,5 +1,6 @@ [Unit] Description=Fast bidirectional synchronization for QRESYNC-capable IMAP servers +Documentation=man:interimap(1) Wants=network-online.target After=network-online.target diff --git a/pullimap@.service b/pullimap@.service index d066886..53694da 100644 --- a/pullimap@.service +++ b/pullimap@.service @@ -1,5 +1,6 @@ [Unit] -Description=Pull mails from an IMAP mailbox and deliver them to a SMTP session +Description=Pull mails from an IMAP mailbox and deliver them to a SMTP session (instance %i) +Documentation=man:pullimap(1) Wants=network-online.target After=network-online.target -- cgit v1.2.3 From 2be6268e01a368817b27cdbbee7b2641ec1653c6 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Fri, 10 May 2019 01:03:50 +0200 Subject: libinterimap: bugfix: fix escaped hierarchy delimiters in LIST reponses. The were returned as escaped quoted specials, like "\\", not as a single character (backslash in this case). --- Changelog | 8 ++++++++ interimap | 4 ++-- lib/Net/IMAP/InterIMAP.pm | 4 ++-- pullimap | 2 +- 4 files changed, 13 insertions(+), 5 deletions(-) diff --git a/Changelog b/Changelog index 5a9074a..17f4661 100644 --- a/Changelog +++ b/Changelog @@ -1,3 +1,11 @@ +interimap (0.5) upstream; + + - libinterimap: bugfix: hierarchy delimiters in LIST responses were + returned as an escaped quoted special, like "\\", not as a single + character (backslash in this case). + + -- Guilhem Moulin Fri, 10 May 2019 00:58:14 +0200 + interimap (0.4) upstream; * pullimap: replace non RFC 5321-compliant envelope sender addresses diff --git a/interimap b/interimap index 5b1bc63..bb7013d 100755 --- a/interimap +++ b/interimap @@ -22,7 +22,7 @@ use v5.14.2; use strict; use warnings; -our $VERSION = '0.4'; +our $VERSION = '0.5'; my $NAME = 'interimap'; use Getopt::Long qw/:config posix_default no_ignore_case gnu_compat bundling auto_version/; @@ -32,7 +32,7 @@ use Fcntl qw/F_GETFD F_SETFD FD_CLOEXEC/; use List::Util 'first'; use lib 'lib'; -use Net::IMAP::InterIMAP 0.0.4 qw/xdg_basedir read_config compact_set/; +use Net::IMAP::InterIMAP 0.0.5 qw/xdg_basedir read_config compact_set/; # Clean up PATH $ENV{PATH} = join ':', qw{/usr/bin /bin}; diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index a773f08..37616f4 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -16,7 +16,7 @@ # along with this program. If not, see . #---------------------------------------------------------------------- -package Net::IMAP::InterIMAP v0.0.4; +package Net::IMAP::InterIMAP v0.0.5; use warnings; use strict; @@ -2368,7 +2368,7 @@ sub _resp($$;&$$) { $self->panic($_) unless $_ eq ''; $mailbox = 'INBOX' if uc $mailbox eq 'INBOX'; # INBOX is case-insensitive undef $delim if uc $delim eq 'NIL'; - $delim =~ s/\A"(.*)"\z/$1/ if defined $delim; + $self->panic($_) if defined $delim and $delim !~ s/\A"\\?(.)"\z/$1/; $self->_update_cache_for($mailbox, DELIMITER => $delim); $self->_update_cache_for($mailbox, LIST_ATTRIBUTES => \@attrs); $callback->($mailbox, $delim, @attrs) if defined $callback and $cmd eq 'LIST'; diff --git a/pullimap b/pullimap index 495b99e..84587fe 100755 --- a/pullimap +++ b/pullimap @@ -32,7 +32,7 @@ use List::Util 'first'; use Socket qw/PF_INET PF_INET6 SOCK_STREAM/; use lib 'lib'; -use Net::IMAP::InterIMAP 0.0.4 qw/xdg_basedir read_config compact_set/; +use Net::IMAP::InterIMAP 0.0.5 qw/xdg_basedir read_config compact_set/; # Clean up PATH $ENV{PATH} = join ':', qw{/usr/bin /bin}; -- cgit v1.2.3 From 1c5274b67308c10512e275d018ee18befcfb487f Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Thu, 16 May 2019 00:06:17 +0200 Subject: libinterimap: quote() the empty string as "" instead of a 0-length literal. Compression asside, this saves 3 bytes and one round-trip on servers not supporting non-synchronizing literals, and 4 bytes otherwise. --- Changelog | 3 +++ lib/Net/IMAP/InterIMAP.pm | 2 +- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/Changelog b/Changelog index 17f4661..9cce062 100644 --- a/Changelog +++ b/Changelog @@ -3,6 +3,9 @@ interimap (0.5) upstream; - libinterimap: bugfix: hierarchy delimiters in LIST responses were returned as an escaped quoted special, like "\\", not as a single character (backslash in this case). + - libinterimap: quote() the empty string as "" instead of a 0-length + literal. (This saves 3 bytes + one round-trip on servers not + supporting non-synchronizing literals, and 4 bytes otherwise.) -- Guilhem Moulin Fri, 10 May 2019 00:58:14 +0200 diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index 37616f4..26c3712 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -239,7 +239,7 @@ sub quote($) { if ($str =~ qr/\A$RE_ASTRING_CHAR+\z/) { return $str; } - elsif ($str =~ qr/\A$RE_TEXT_CHAR+\z/) { + elsif ($str =~ qr/\A$RE_TEXT_CHAR*\z/) { $str =~ s/([\x22\x5C])/\\$1/g; return "\"$str\""; } -- cgit v1.2.3 From 735c861de4d662f5bfe4fddff9fbfa8bc5a503c1 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Fri, 24 May 2019 23:52:37 +0200 Subject: libinterimap: astring is 1*ASTRING-CHAR / string. Not 1*ATOM-CHAR / string. Also accept LIST responses mailbox names containing '%', '*', or ']'. From RFC 3501: astring = 1*ASTRING-CHAR / string ASTRING-CHAR = ATOM-CHAR / resp-specials list = "LIST" SP mailbox SP list-mailbox list-mailbox = 1*list-char / string list-char = ATOM-CHAR / list-wildcards / resp-specials list-wildcards = "%" / "*" resp-specials = "]" --- Changelog | 3 +++ lib/Net/IMAP/InterIMAP.pm | 13 ++++++++++--- 2 files changed, 13 insertions(+), 3 deletions(-) diff --git a/Changelog b/Changelog index 9cce062..587dc9b 100644 --- a/Changelog +++ b/Changelog @@ -3,6 +3,9 @@ interimap (0.5) upstream; - libinterimap: bugfix: hierarchy delimiters in LIST responses were returned as an escaped quoted special, like "\\", not as a single character (backslash in this case). + - libinterimap: the parser choked on responses with non-quoted/literal + astring containing ']' characters. And LIST responses with + non-quoted/literal list-mailbox names '%', '*' or ']' characters. - libinterimap: quote() the empty string as "" instead of a 0-length literal. (This saves 3 bytes + one round-trip on servers not supporting non-synchronizing literals, and 4 bytes otherwise.) diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index 26c3712..86f08a9 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -40,9 +40,10 @@ BEGIN { } -# Regexes for RFC 3501's 'ATOM-CHAR', 'ASTRING-CHAR' and 'TEXT-CHAR'. +# Regexes for RFC 3501's 'ATOM-CHAR', 'ASTRING-CHAR', 'list-char' and 'TEXT-CHAR'. my $RE_ATOM_CHAR = qr/[\x21\x23\x24\x26\x27\x2B-\x5B\x5E-\x7A\x7C-\x7E]/; my $RE_ASTRING_CHAR = qr/[\x21\x23\x24\x26\x27\x2B-\x5B\x5D-\x7A\x7C-\x7E]/; +my $RE_LIST_CHAR = qr/[\x21\x23-\x27\x2A\x2B-\x5B\x5D-\x7A\x7C-\x7E]/; my $RE_TEXT_CHAR = qr/[\x01-\x09\x0B\x0C\x0E-\x7F]/; my $RE_SSL_PROTO = qr/(?:SSLv[23]|TLSv1|TLSv1\.[0-3])/; @@ -2192,7 +2193,13 @@ sub _nstring($$) { # Parse and consume an RFC 3501 astring (1*ASTRING-CHAR / string). sub _astring($$) { my ($self, $stream) = @_; - return $$stream =~ s/\A($RE_ATOM_CHAR+)// ? $1 : $self->_string($stream); + return $$stream =~ s/\A$RE_ASTRING_CHAR+//p ? ${^MATCH} : $self->_string($stream); +} + +# Parse and consume an RFC 3501 list-mailbox (1*list-char / string). +sub _list_mailbox($$) { + my ($self, $stream) = @_; + return $$stream =~ s/\A$RE_LIST_CHAR+//p ? ${^MATCH} : $self->_string($stream); } # Parse and consume an RFC 3501 string (quoted / literal). @@ -2364,7 +2371,7 @@ sub _resp($$;&$$) { elsif (s/\ALIST \((\\?$RE_ATOM_CHAR+(?: \\?$RE_ATOM_CHAR+)*)?\) ("(?:\\[\x22\x5C]|[\x01-\x09\x0B\x0C\x0E-\x21\x23-\x5B\x5D-\x7F])"|NIL) //) { my ($delim, $attrs) = ($2, $1); my @attrs = defined $attrs ? split(/ /, $attrs) : (); - my $mailbox = $self->_astring(\$_); + my $mailbox = $self->_list_mailbox(\$_); $self->panic($_) unless $_ eq ''; $mailbox = 'INBOX' if uc $mailbox eq 'INBOX'; # INBOX is case-insensitive undef $delim if uc $delim eq 'NIL'; -- cgit v1.2.3 From b59e3b1416c54a2ce8be7f4aaa9c04ff52ff65a9 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Wed, 15 May 2019 17:08:07 +0200 Subject: interimap: Factor out error throwing. Also, write which --target to use in --delete command suggestions. --- Changelog | 2 ++ interimap | 31 ++++++++++++++----------------- 2 files changed, 16 insertions(+), 17 deletions(-) diff --git a/Changelog b/Changelog index 587dc9b..f261a98 100644 --- a/Changelog +++ b/Changelog @@ -1,5 +1,7 @@ interimap (0.5) upstream; + + interimap: write which --target to use in --delete command + suggestions. - libinterimap: bugfix: hierarchy delimiters in LIST responses were returned as an escaped quoted special, like "\\", not as a single character (backslash in this case). diff --git a/interimap b/interimap index bb7013d..fa65241 100755 --- a/interimap +++ b/interimap @@ -216,6 +216,11 @@ sub logger($@) { $prefix .= "$name: " if defined $name; $LOGGER_FD->say($prefix, @_); } +sub fail($@) { + my $name = shift; + msg($name, "ERROR: ", @_); + exit 1; +} logger(undef, ">>> $NAME $VERSION"); @@ -355,19 +360,15 @@ elsif (defined $COMMAND and $COMMAND eq 'rename') { # tagged NO response foreach my $name (qw/local remote/) { next if defined $CONFIG{target} and !grep {$_ eq $name} @{$CONFIG{target}}; - if (mbx_exists($name, $to)) { - msg($name, "ERROR: Mailbox $to exists. Run `$NAME --delete $to` to delete."); - exit 1; - } + fail($name, "Mailbox $to exists. Run `$NAME --target=$name --delete $to` to delete.") + if mbx_exists($name, $to); } # ensure the target name doesn't already exist in the database $STH_GET_INDEX->execute($to); - if (defined $STH_GET_INDEX->fetch() and - (!defined $CONFIG{target} or grep {$_ eq 'database'} @{$CONFIG{target}})) { - msg('database', "ERROR: Mailbox $to exists. Run `$NAME --delete $to` to delete."); - exit 1; - } + fail("database", "Mailbox $to exists. Run `$NAME --target=database --delete $to` to delete.") + if defined $STH_GET_INDEX->fetch() + and (!defined $CONFIG{target} or grep {$_ eq 'database'} @{$CONFIG{target}}); # rename $from to $to on servers where $from exists. again there is @@ -467,10 +468,8 @@ sub sync_mailbox_list() { } elsif ($lExists and !$rExists) { # $mailbox is on 'local' only - if (defined $idx) { - msg('database', "ERROR: Mailbox $mailbox exists. Run `$NAME --delete $mailbox` to delete."); - exit 1; - } + fail("database", "Mailbox $mailbox exists. Run `$NAME --target=database --delete $mailbox` to delete.") + if defined $idx; my $subscribed = mbx_subscribed('local', $mailbox); $STH_INSERT_MAILBOX->execute($mailbox, $subscribed); $IMAP->{remote}->{client}->create($mailbox, 1); @@ -479,10 +478,8 @@ sub sync_mailbox_list() { } elsif (!$lExists and $rExists) { # $mailbox is on 'remote' only - if (defined $idx) { - msg('database', "ERROR: Mailbox $mailbox exists. Run `$NAME --delete $mailbox` to delete."); - exit 1; - } + 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); -- cgit v1.2.3 From 7d50d83ab52148285c642158bd57bdd18a1ee6d4 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Thu, 16 May 2019 01:05:25 +0200 Subject: interimap: accept C-style escape sequences in 'list-mailbox'. This is useful for defining names containing control characters (incl. \0 for unspecified hierarchy delimiter). --- Changelog | 6 ++++++ interimap | 63 ++++++++++++++++++++++++++++++++++++++++++------------------ interimap.md | 18 ++++++++++------- 3 files changed, 61 insertions(+), 26 deletions(-) diff --git a/Changelog b/Changelog index f261a98..209bb25 100644 --- a/Changelog +++ b/Changelog @@ -1,5 +1,8 @@ interimap (0.5) upstream; + * interimap: the space-speparated list of names and/or patterns in + 'list-mailbox' can now contain C-style escape sequences (backslash + and hexadecimal escape). + interimap: write which --target to use in --delete command suggestions. - libinterimap: bugfix: hierarchy delimiters in LIST responses were @@ -11,6 +14,9 @@ interimap (0.5) upstream; - libinterimap: quote() the empty string as "" instead of a 0-length literal. (This saves 3 bytes + one round-trip on servers not supporting non-synchronizing literals, and 4 bytes otherwise.) + - interimap: unlike what the documentation said, spaces where not + allowed in the 'list-select-opts' configuration option, so at maximum + one selector could be used for the initial LIST command. -- Guilhem Moulin Fri, 10 May 2019 00:58:14 +0200 diff --git a/interimap b/interimap index fa65241..8aeaba4 100755 --- a/interimap +++ b/interimap @@ -2,7 +2,7 @@ #---------------------------------------------------------------------- # Fast bidirectional synchronization for QRESYNC-capable IMAP servers -# Copyright © 2015-2018 Guilhem Moulin +# Copyright © 2015-2019 Guilhem Moulin # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by @@ -79,11 +79,11 @@ my $CONF = do { , database => qr/\A(\P{Control}+)\z/ , logfile => qr/\A(\/\P{Control}+)\z/ , 'list-mailbox' => qr/\A([\x01-\x09\x0B\x0C\x0E-\x7F]+)\z/ - , 'list-select-opts' => qr/\A([\x21\x23\x24\x26\x27\x2B-\x5B\x5E-\x7A\x7C-\x7E]+)\z/ + , 'list-select-opts' => qr/\A([\x20\x21\x23\x24\x26\x27\x2B-\x5B\x5E-\x7A\x7C-\x7E]*)\z/ , 'ignore-mailbox' => qr/\A([\x01-\x09\x0B\x0C\x0E-\x7F]+)\z/ ); }; -my ($DBFILE, $LOGGER_FD); +my ($DBFILE, $LOGGER_FD, %LIST); { $DBFILE = $CONF->{_}->{database} if defined $CONF->{_}; @@ -104,6 +104,31 @@ my ($DBFILE, $LOGGER_FD); elsif ($CONFIG{debug}) { $LOGGER_FD = \*STDERR; } + + $LIST{mailbox} = [@ARGV]; + if (!defined $COMMAND or $COMMAND eq 'repair') { + if (!@ARGV and defined (my $v = $CONF->{_}->{'list-mailbox'})) { + my @mailbox; + do { + if ($v =~ s/\A[\x21\x23-\x27\x2A-\x5B\x5D-\x7A\x7C-\x7E]+//p) { + push @mailbox, ${^MATCH}; + } elsif ($v =~ s/\A\"((?: + [\x20\x21\x23-\x5B\x5D-\x7E] | # the above plus \x20\x28\x29\x7B + (?:\\(?:[\x22\x5C0abtnvfr] | x\p{AHex}{2})) # quoted char or hex-encoded pair + )+)\"//x) { + push @mailbox, $1 =~ s/\\(?:[\x22\x5C0abtnvfr]|x\p{AHex}{2})/"\"${^MATCH}\""/greep; + } + } while ($v =~ s/\A\s+//); + die "Invalid value for list-mailbox: ".$CONF->{_}->{'list-mailbox'}."\n" if $v ne ""; + $LIST{mailbox} = \@mailbox; + } + $LIST{'select-opts'} = uc($CONF->{_}->{'list-select-opts'}) + if defined $CONF->{_}->{'list-select-opts'} and $CONF->{_}->{'list-select-opts'} ne ""; + $LIST{params} = [ "SUBSCRIBED" ]; # RFC 5258 - LIST Command Extensions + push @{$LIST{params}}, "STATUS (UIDVALIDITY UIDNEXT HIGHESTMODSEQ)" + # RFC 5819 - Returning STATUS Information in Extended LIST + unless $CONFIG{notify}; + } } my $DBH; @@ -227,20 +252,6 @@ logger(undef, ">>> $NAME $VERSION"); ############################################################################# # Connect to the local and remote IMAP servers -my $LIST = '"" '; -my @LIST_PARAMS; -my %LIST_PARAMS_STATUS = (STATUS => [qw/UIDVALIDITY UIDNEXT HIGHESTMODSEQ/]); -if (!defined $COMMAND or $COMMAND eq 'repair') { - $LIST = '('.uc($CONF->{_}->{'list-select-opts'}).') '.$LIST if defined $CONF->{_}->{'list-select-opts'}; - $LIST .= (defined $CONF->{_}->{'list-mailbox'} ? '('.$CONF->{_}->{'list-mailbox'}.')' : '*') unless @ARGV; - @LIST_PARAMS = ('SUBSCRIBED'); - push @LIST_PARAMS, map { "$_ (".join(' ', @{$LIST_PARAMS_STATUS{$_}}).")" } keys %LIST_PARAMS_STATUS - unless $CONFIG{notify}; -} -$LIST .= $#ARGV == 0 ? Net::IMAP::InterIMAP::quote($ARGV[0]) - : ('('.join(' ',map {Net::IMAP::InterIMAP::quote($_)} @ARGV).')') if @ARGV; - - foreach my $name (qw/local remote/) { my %config = %{$CONF->{$name}}; $config{$_} = $CONFIG{$_} foreach grep {defined $CONFIG{$_}} qw/quiet debug/; @@ -257,7 +268,21 @@ foreach my $name (qw/local remote/) { die "Non LIST-STATUS-capable IMAP server.\n" if !$CONFIG{notify} and $client->incapable('LIST-STATUS'); } -@{$IMAP->{$_}}{qw/mailboxes delims/} = $IMAP->{$_}->{client}->list($LIST, @LIST_PARAMS) for qw/local remote/; +# List mailboxes; don't return anything but update $IMAP->{$name}->{mailboxes} and +# $IMAP->{$name}->{delims} +sub list_mailboxes($) { + my $name = shift; + my $list = ""; + $list .= "(" .$LIST{'select-opts'}. ") " if defined $LIST{'select-opts'}; + $list .= "\"\" "; + my @mailboxes = @{$LIST{mailbox}} ? map {Net::IMAP::InterIMAP::quote($_)} @{$LIST{mailbox}} : "*"; + $list .= $#mailboxes == 0 ? $mailboxes[0] : "(".join(" ", @mailboxes).")"; + my ($mbx, $delims) = $IMAP->{$name}->{client}->list($list, @{$LIST{params} // []}); + $IMAP->{$name}->{mailboxes} = $mbx; + $IMAP->{$name}->{delims} = $delims; +} + +list_mailboxes($_) for qw/local remote/; ############################################################################## @@ -1239,7 +1264,7 @@ while (1) { sleep $CONFIG{watch}; # refresh the mailbox list and status - @{$IMAP->{$_}}{qw/mailboxes delims/} = $IMAP->{$_}->{client}->list($LIST, @LIST_PARAMS) for qw/local remote/; + list_mailboxes($_) for qw/local remote/; @MAILBOXES = sync_mailbox_list(); } } diff --git a/interimap.md b/interimap.md index 4d85eaf..a230c09 100644 --- a/interimap.md +++ b/interimap.md @@ -82,10 +82,10 @@ the *list-mailbox*, *list-select-opts* and *ignore-mailbox* options from the [configuration file](#configuration-file) can be used to shrink that list and save bandwidth. However if some extra argument are provided on the command line, -`interimap` ignores said options and synchronizes the given +`interimap` ignores these options and synchronizes the given *MAILBOX*es instead. Note that each *MAILBOX* is taken “as is”; in particular, it must be [UTF-7 encoded][RFC 2152], unquoted, and the list -wildcards ‘\*’ and ‘%’ are not expanded. +wildcards ‘\*’ and ‘%’ are passed verbatim to the IMAP server. If the synchronization was interrupted during a previous run while some messages were being replicated (but before the `UIDNEXT` or @@ -219,12 +219,16 @@ Valid options are: : A space separated list of mailbox patterns to use when issuing the initial `LIST` command (overridden by the *MAILBOX*es given as command-line arguments). - Note that each pattern containing special characters such as spaces - or brackets (see [RFC 3501] for the exact syntax) must be quoted. + Names containing special characters such as spaces or brackets need + to be enclosed in double quotes. Within double quotes C-style + backslash escape sequences can be used (‘\\t’ for an horizontal tab, + ‘\\n’ for a new line, ‘\\\\’ for a backslash, etc.), as well as + hexadecimal escape sequences ‘\\xHH’. Furthermore, non-ASCII names must be [UTF-7 encoded][RFC 2152]. - Two wildcards are available: a ‘\*’ character matches zero or more - characters, while a ‘%’ character matches zero or more characters up - to the mailbox's hierarchy delimiter. + Two wildcards are available, and passed verbatim to the IMAP server: + a ‘\*’ character matches zero or more characters, while a ‘%’ + character matches zero or more characters up to the hierarchy + delimiter. This option is only available in the default section. (The default pattern, `*`, matches all visible mailboxes on the server.) -- cgit v1.2.3 From 646300f60aaae976d49cf524b66feba2dda2d2ee Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Thu, 16 May 2019 01:13:31 +0200 Subject: interimap: fail when two non-INBOX LIST replies return different separators. This never happens for a single LIST command, but may happen if mailboxes from different namespaces are being listed. The workaround here is to run a new interimap instance for each namespace. --- Changelog | 7 +++++ interimap | 103 ++++++++++++++++++++++++++++++++++++++++++++------------------ 2 files changed, 81 insertions(+), 29 deletions(-) diff --git a/Changelog b/Changelog index 209bb25..4dd8800 100644 --- a/Changelog +++ b/Changelog @@ -3,6 +3,11 @@ interimap (0.5) upstream; * interimap: the space-speparated list of names and/or patterns in 'list-mailbox' can now contain C-style escape sequences (backslash and hexadecimal escape). + * interimap: fail when two non-INBOX LIST replies return different + separators. This never happens for a single LIST command, but may + happen if mailboxes from different namespaces are being listed. The + workaround here is to run a new interimap instance for each + namespace. + interimap: write which --target to use in --delete command suggestions. - libinterimap: bugfix: hierarchy delimiters in LIST responses were @@ -17,6 +22,8 @@ interimap (0.5) upstream; - interimap: unlike what the documentation said, spaces where not allowed in the 'list-select-opts' configuration option, so at maximum one selector could be used for the initial LIST command. + - interimap: unlike what the documentation said, 'ignore-mailbox' was + not ignored when names were specified as command line arguments. -- Guilhem Moulin Fri, 10 May 2019 00:58:14 +0200 diff --git a/interimap b/interimap index 8aeaba4..c09d51f 100755 --- a/interimap +++ b/interimap @@ -268,22 +268,79 @@ foreach my $name (qw/local remote/) { die "Non LIST-STATUS-capable IMAP server.\n" if !$CONFIG{notify} and $client->incapable('LIST-STATUS'); } -# List mailboxes; don't return anything but update $IMAP->{$name}->{mailboxes} and -# $IMAP->{$name}->{delims} +# Pretty-print hierarchy delimiter: DQUOTE QUOTED-CHAR DQUOTE / nil +sub print_delimiter($) { + my $d = shift // return "NIL"; + $d =~ s/([\x22\x5C])/\\$1/g; + return "\"".$d."\""; +} + +# List mailboxes; don't return anything but update $IMAP->{$name}->{mailboxes} sub list_mailboxes($) { my $name = shift; my $list = ""; $list .= "(" .$LIST{'select-opts'}. ") " if defined $LIST{'select-opts'}; $list .= "\"\" "; - my @mailboxes = @{$LIST{mailbox}} ? map {Net::IMAP::InterIMAP::quote($_)} @{$LIST{mailbox}} : "*"; - $list .= $#mailboxes == 0 ? $mailboxes[0] : "(".join(" ", @mailboxes).")"; + $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; - $IMAP->{$name}->{delims} = $delims; + + # 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 + # and https://www.imapwiki.org/ClientImplementation/MailboxList#Hierarchy_separators + # (We assume all list-mailbox arguments given live in the same namespace. Otherwise + # 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. + if (%$delims) { + # Got a non-INBOX LIST reply, use the first one as authoritative value. + my ($m) = sort keys %$delims; + $IMAP->{$name}->{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]; + } + logger($name, "Using ", print_delimiter($IMAP->{$name}->{delimiter}), + " as hierarchy delimiter") if $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}; + foreach my $m (keys %$delims) { + fail($name, "Mailbox $m has hierarchy delimiter ", print_delimiter($delims->{$m}), + ", while ", print_delimiter($d), " was expected.") + if (defined $d xor defined $delims->{$m}) + or (defined $d and defined $delims->{$m} and $d ne $delims->{$m}); + } } list_mailboxes($_) for qw/local remote/; +# 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}); + ############################################################################## # @@ -294,22 +351,6 @@ my $STH_INSERT_MAILBOX = $DBH->prepare(q{INSERT INTO mailboxes (mailbox,subscrib # Get the index associated with a mailbox. my $STH_GET_INDEX = $DBH->prepare(q{SELECT idx,subscribed FROM mailboxes WHERE mailbox = ?}); -# Ensure local and remote delimiter match -sub check_delim($) { - my $mbx = shift; - my ($lDelims, $rDelims) = map {$IMAP->{$_}->{delims}} qw/local remote/; - if (exists $lDelims->{$mbx} and exists $rDelims->{$mbx} and - ((defined $lDelims->{$mbx} xor defined $rDelims->{$mbx}) or - (defined $lDelims->{$mbx} and defined $rDelims->{$mbx} and $lDelims->{$mbx} ne $rDelims->{$mbx}))) { - my ($ld, $rd) = ($lDelims->{$mbx}, $rDelims->{$mbx}); - $ld =~ s/([\x22\x5C])/\\$1/g if defined $ld; - $rd =~ s/([\x22\x5C])/\\$1/g if defined $rd; - die "Error: Hierarchy delimiter for $mbx don't match: " - ."local \"". ($ld // '')."\", remote \"".($rd // '')."\"\n" - } - return exists $lDelims->{$mbx} ? $lDelims->{$mbx} : exists $rDelims->{$mbx} ? $rDelims->{$mbx} : undef; -} - # Return true if $mailbox exists on $name sub mbx_exists($$) { my ($name, $mailbox) = @_; @@ -376,9 +417,6 @@ elsif (defined $COMMAND and $COMMAND eq 'rename') { my ($idx) = $STH_GET_INDEX->fetchrow_array(); die if defined $STH_GET_INDEX->fetch(); # sanity check - # ensure the local and remote hierarchy delimiter match - my $delim = check_delim($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 @@ -411,7 +449,8 @@ elsif (defined $COMMAND and $COMMAND eq 'rename') { 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 - if (defined $delim) { + # (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,?) @@ -432,12 +471,19 @@ elsif (defined $COMMAND and $COMMAND eq 'rename') { sub sync_mailbox_list() { my (%mailboxes, @mailboxes); - $mailboxes{$_} = 1 foreach keys %{$IMAP->{local}->{mailboxes}}; - $mailboxes{$_} = 1 foreach keys %{$IMAP->{remote}->{mailboxes}}; + foreach my $name (qw/local remote/) { + foreach my $mbx (keys %{$IMAP->{$name}->{mailboxes}}) { + # 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"} + and $mbx =~ /$CONF->{_}->{"ignore-mailbox"}/o; + $mailboxes{$mbx} = 1; + } + } + my $sth_subscribe = $DBH->prepare(q{UPDATE mailboxes SET subscribed = ? WHERE idx = ?}); foreach my $mailbox (keys %mailboxes) { - next if defined $CONF->{_}->{'ignore-mailbox'} and $mailbox =~ /$CONF->{_}->{'ignore-mailbox'}/o; my ($lExists, $rExists) = map {mbx_exists($_,$mailbox)} qw/local remote/; next unless $lExists or $rExists; @@ -447,7 +493,6 @@ sub sync_mailbox_list() { keys %attrs; }; - check_delim($mailbox); # ensure that the delimiter match push @mailboxes, $mailbox unless grep {lc $_ eq lc '\NoSelect'} @attrs; $STH_GET_INDEX->execute($mailbox); -- cgit v1.2.3 From ce35ea5f320184a9626f945fdf5a1648062d3e18 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Sun, 19 May 2019 14:53:08 +0200 Subject: interimap: Refactor --target handling. Also, accept comma-separated values for --target. --- Changelog | 1 + interimap | 22 +++++++++++++++------- 2 files changed, 16 insertions(+), 7 deletions(-) diff --git a/Changelog b/Changelog index 4dd8800..791df24 100644 --- a/Changelog +++ b/Changelog @@ -24,6 +24,7 @@ interimap (0.5) upstream; one selector could be used for the initial LIST command. - 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. -- Guilhem Moulin Fri, 10 May 2019 00:58:14 +0200 diff --git a/interimap b/interimap index c09d51f..07c2b24 100755 --- a/interimap +++ b/interimap @@ -129,6 +129,15 @@ my ($DBFILE, $LOGGER_FD, %LIST); # RFC 5819 - Returning STATUS Information in Extended LIST unless $CONFIG{notify}; } + if (defined (my $t = $CONFIG{target})) { + @$t = map { split(",", $_) } @$t; + die "Invalid target $_\n" foreach grep !/^(?:local|remote|database)$/, @$t; + $CONFIG{target} = {}; + $CONFIG{target}->{$_} = 1 foreach @$t; + } else { + $CONFIG{target} = {}; + $CONFIG{target}->{$_} = 1 foreach qw/local remote database/; + } } my $DBH; @@ -384,11 +393,11 @@ if (defined $COMMAND and $COMMAND eq 'delete') { # there is a race condition where the mailbox could have # appeared meanwhile foreach my $name (qw/local remote/) { - next if defined $CONFIG{target} and !grep {$_ eq $name} @{$CONFIG{target}}; + next unless $CONFIG{target}->{$name}; $IMAP->{$name}->{client}->delete($mailbox) if mbx_exists($name, $mailbox); } - if (defined $idx and (!defined $CONFIG{target} or grep {$_ eq 'database'} @{$CONFIG{target}})) { + 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); @@ -422,7 +431,7 @@ elsif (defined $COMMAND and $COMMAND eq 'rename') { # issue the RENAME command, then the server would reply with a # tagged NO response foreach my $name (qw/local remote/) { - next if defined $CONFIG{target} and !grep {$_ eq $name} @{$CONFIG{target}}; + next unless $CONFIG{target}->{$name}; fail($name, "Mailbox $to exists. Run `$NAME --target=$name --delete $to` to delete.") if mbx_exists($name, $to); } @@ -430,20 +439,19 @@ elsif (defined $COMMAND and $COMMAND eq 'rename') { # 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 (!defined $CONFIG{target} or grep {$_ eq 'database'} @{$CONFIG{target}}); + if defined $STH_GET_INDEX->fetch() and $CONFIG{target}->{database}; # 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 foreach my $name (qw/local remote/) { - next if defined $CONFIG{target} and !grep {$_ eq $name} @{$CONFIG{target}}; + next unless $CONFIG{target}->{$name}; $IMAP->{$name}->{client}->rename($from, $to) if mbx_exists($name, $from); } # rename from to $to in the database - if (defined $idx and (!defined $CONFIG{target} or grep {$_ eq 'database'} @{$CONFIG{target}})) { + 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; -- cgit v1.2.3 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 From 06e459f3ccfb407d7587c470c37328df386b6ff6 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Sun, 19 May 2019 15:00:45 +0200 Subject: interimap: Enforce SQLite foreign key constraints. Setting the 'foreign_keys' PRAGMA during a multi-statement transaction (when SQLite is not in autocommit mode) is a no-op. https://www.sqlite.org/pragma.html#pragma_foreign_keys https://www.sqlite.org/foreignkeys.html#fk_enable --- Changelog | 2 ++ interimap | 11 +++++++---- 2 files changed, 9 insertions(+), 4 deletions(-) diff --git a/Changelog b/Changelog index 0a31639..3d8cd72 100644 --- a/Changelog +++ b/Changelog @@ -38,6 +38,8 @@ interimap (0.5) upstream; 'mailboxes' table. - interimap: don't try to delete \NoSelect mailboxes (it's an error per RFC 3501 sec. 6.3.4). + - interimap: SQLite were not enforcing foreign key constraints (setting + the 'foreign_keys' PRAGMA during a transaction is a documented no-op). -- Guilhem Moulin Fri, 10 May 2019 00:58:14 +0200 diff --git a/interimap b/interimap index 3e1979b..78f50fa 100755 --- a/interimap +++ b/interimap @@ -162,7 +162,6 @@ $SIG{TERM} = sub { cleanup(); exit 0; }; my %dbi_attrs = ( AutoCommit => 0, RaiseError => 1, - sqlite_see_if_its_a_number => 1, # see if the bind values are numbers or not sqlite_use_immediate_transaction => 1, sqlite_open_flags => SQLITE_OPEN_READWRITE ); @@ -174,7 +173,8 @@ $SIG{TERM} = sub { cleanup(); exit 0; }; # 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"); + $DBH->{AutoCommit} = 1; # turned back off later + $DBH->do("PRAGMA foreign_keys = OFF"); # toggled later (no-op if not in autocommit mode) } sub msg($@) { @@ -380,6 +380,7 @@ fail(undef, "Local and remote namespaces are neither both flat nor both hierarch if ($schema_version < $DATABASE_VERSION) { # schema creation or upgrade required + $DBH->begin_work(); if ($schema_version == 0) { my $sth = $DBH->table_info(undef, undef, undef, "TABLE"); unless (defined $sth->fetch()) { @@ -401,7 +402,6 @@ fail(undef, "Local and remote namespaces are neither both flat nor both hierarch 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}, @@ -419,12 +419,15 @@ fail(undef, "Local and remote namespaces are neither both flat nor both hierarch } $DBH->do("DROP TABLE mailboxes"); $DBH->do("ALTER TABLE _tmp${DATABASE_VERSION}_mailboxes RENAME TO mailboxes"); - $DBH->do("PRAGMA foreign_keys = ON"); } + fail("database", "Broken referential integrity! Refusing to commit changes.") + if defined $DBH->selectrow_arrayref("PRAGMA foreign_key_check"); SCHEMA_DONE: $DBH->do("PRAGMA user_version = $DATABASE_VERSION"); $DBH->commit(); } + $DBH->do("PRAGMA foreign_keys = ON"); # no-op if not in autocommit mode + $DBH->{AutoCommit} = 0; # always explicitly commit changes } -- cgit v1.2.3 From b86a1141f7e71cb9244ba4c5609b554417b506bb Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Wed, 22 May 2019 21:36:21 +0200 Subject: interimap: fix handling of mod-sequence values greater or equal than 2 << 63. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit SQLite processes every INTEGER values as a 8-byte signed integer, so we need to manually do the conversion from/to uint64_t client-side if we don't want to overflow or receive floats. https://www.sqlite.org/datatype3.html#storage_classes_and_datatypes http://jakegoulding.com/blog/2011/02/06/sqlite-64-bit-integers/ We could also do the same trick for local/remote UIDs, UIDVALITY and UIDNEXT values to slim the database down at the expense of pre/post- processing. (Values of SQLite's INTEGER class are 1, 2, 3, 4, 6, or 8 bytes signed integers depending on the manitudes, so we could save some space for values ≥2³¹.) But that seems a little overkill. --- Changelog | 2 ++ interimap | 93 +++++++++++++++++++++++++++++++++++++++++++++------------------ 2 files changed, 69 insertions(+), 26 deletions(-) diff --git a/Changelog b/Changelog index 3d8cd72..251d5dc 100644 --- a/Changelog +++ b/Changelog @@ -40,6 +40,8 @@ interimap (0.5) upstream; RFC 3501 sec. 6.3.4). - interimap: SQLite were not enforcing foreign key constraints (setting the 'foreign_keys' PRAGMA during a transaction is a documented no-op). + - interimap: fix handling of mod-sequence values greater or equal than + 2 << 63. -- Guilhem Moulin Fri, 10 May 2019 00:58:14 +0200 diff --git a/interimap b/interimap index 78f50fa..2dd0eb5 100755 --- a/interimap +++ b/interimap @@ -352,7 +352,7 @@ fail(undef, "Local and remote namespaces are neither both flat nor both hierarch # 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 + q{HIGHESTMODSEQ UNSIGNED BIGINT NOT NULL} # 0 initially (/!\ converted to 8-byte signed integer) # one-to-one correspondence between local.idx and remote.idx ], remote => [ @@ -360,7 +360,7 @@ fail(undef, "Local and remote namespaces are neither both flat nor both hierarch # 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 + q{HIGHESTMODSEQ UNSIGNED BIGINT NOT NULL} # 0 initially (/!\ converted to 8-byte signed integer) # one-to-one correspondence between local.idx and remote.idx ], mapping => [ @@ -713,18 +713,6 @@ my $ATTRS = join ' ', qw/MODSEQ FLAGS INTERNALDATE BODY.PEEK[]/; ############################################################################# # Synchronize messages -# 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 = ?}); - -# Update the HIGHESTMODSEQ and UIDNEXT. -my $STH_UPDATE_LOCAL = $DBH->prepare(q{UPDATE local SET UIDNEXT = ?, HIGHESTMODSEQ = ? WHERE idx = ?}); -my $STH_UPDATE_REMOTE = $DBH->prepare(q{UPDATE remote SET UIDNEXT = ?, HIGHESTMODSEQ = ? WHERE idx = ?}); - -# Add a new mailbox. -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)}); - # Download some missing UIDs from $source; returns the new allocated UIDs sub download_missing($$$@) { my $idx = shift; @@ -1243,10 +1231,30 @@ sub sync_messages($$;$$) { # don't store the new UIDNEXTs before to avoid downloading these # mails again in the event of a crash - $STH_UPDATE_LOCAL->execute($lIMAP->get_cache( qw/UIDNEXT HIGHESTMODSEQ/), $idx) or - msg('database', "WARNING: Can't update remote UIDNEXT/HIGHESTMODSEQ for $mailbox"); - $STH_UPDATE_REMOTE->execute($rIMAP->get_cache(qw/UIDNEXT HIGHESTMODSEQ/), $idx) or - msg('database', "WARNING: Can't update remote UIDNEXT/HIGHESTMODSEQ for $mailbox"); + + state $sth_update_local = $DBH->prepare(q{ + UPDATE local + SET UIDNEXT = ?, HIGHESTMODSEQ = ? + WHERE idx = ? + }); + state $sth_update_remote = $DBH->prepare(q{ + UPDATE remote + SET UIDNEXT = ?, HIGHESTMODSEQ = ? + WHERE idx = ? + }); + + my ($lUIDNEXT, $lHIGHESTMODSEQ) = $lIMAP->get_cache(qw/UIDNEXT HIGHESTMODSEQ/); + $sth_update_local->bind_param(1, $lUIDNEXT, SQL_INTEGER); + $sth_update_local->bind_param(2, sprintf("%lld", $lHIGHESTMODSEQ), SQL_BIGINT); + $sth_update_local->bind_param(3, $idx, SQL_INTEGER); + $sth_update_local->execute(); + + my ($rUIDNEXT, $rHIGHESTMODSEQ) = $rIMAP->get_cache(qw/UIDNEXT HIGHESTMODSEQ/); + $sth_update_remote->bind_param(1, $rUIDNEXT, SQL_INTEGER); + $sth_update_remote->bind_param(2, sprintf("%lld", $rHIGHESTMODSEQ), SQL_BIGINT); + $sth_update_remote->bind_param(3, $idx, SQL_INTEGER); + $sth_update_remote->execute(); + $DBH->commit(); } @@ -1268,6 +1276,9 @@ sub db_get_cache_by_idx($) { $sth->execute(); my $cache = $sth->fetchrow_hashref(); die if defined $sth->fetch(); # safety check + if (defined $cache) { + $cache->{$_} = sprintf("%llu", $cache->{$_}) foreach qw/lHIGHESTMODSEQ rHIGHESTMODSEQ/; + } return $cache; } @@ -1377,12 +1388,12 @@ my %KNOWN_INDEXES; $lIMAP->set_cache(mbx_name(local => $row->{mailbox}), UIDVALIDITY => $row->{lUIDVALIDITY}, UIDNEXT => $row->{lUIDNEXT}, - HIGHESTMODSEQ => $row->{lHIGHESTMODSEQ} + HIGHESTMODSEQ => sprintf("%llu", $row->{lHIGHESTMODSEQ}) ); $rIMAP->set_cache(mbx_name(remote => $row->{mailbox}), UIDVALIDITY => $row->{rUIDVALIDITY}, UIDNEXT => $row->{rUIDNEXT}, - HIGHESTMODSEQ => $row->{rHIGHESTMODSEQ} + HIGHESTMODSEQ => sprintf("%llu", $row->{rHIGHESTMODSEQ}) ); $KNOWN_INDEXES{$row->{idx}} = 1; } @@ -1416,6 +1427,24 @@ if ($CONFIG{notify}) { sub loop() { + state $sth_insert_local = $DBH->prepare(q{ + INSERT INTO local (idx,UIDVALIDITY,UIDNEXT,HIGHESTMODSEQ) VALUES (?,?,0,0) + }); + state $sth_insert_remote = $DBH->prepare(q{ + INSERT INTO remote (idx,UIDVALIDITY,UIDNEXT,HIGHESTMODSEQ) VALUES (?,?,0,0) + }); + + state $sth_update_local_highestmodseq = $DBH->prepare(q{ + UPDATE local + SET HIGHESTMODSEQ = ? + WHERE idx = ? + }); + state $sth_update_remote_highestmodseq = $DBH->prepare(q{ + UPDATE remote + SET HIGHESTMODSEQ = ? + WHERE idx = ? + }); + while(@MAILBOXES) { 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 @@ -1430,8 +1459,15 @@ sub loop() { select_mbx($IDX, $MAILBOX); if (!$KNOWN_INDEXES{$IDX}) { - $STH_INSERT_LOCAL->execute( $IDX, $lIMAP->uidvalidity($MAILBOX)); - $STH_INSERT_REMOTE->execute($IDX, $rIMAP->uidvalidity($MAILBOX)); + my $lUIDVALIDITY = $lIMAP->uidvalidity(mbx_name(local => $MAILBOX)); + $sth_insert_local->bind_param(1, $IDX, SQL_INTEGER); + $sth_insert_local->bind_param(2, $lUIDVALIDITY, SQL_INTEGER); + $sth_insert_local->execute(); + + my $rUIDVALIDITY = $rIMAP->uidvalidity(mbx_name(remote => $MAILBOX)); + $sth_insert_remote->bind_param(1, $IDX, SQL_INTEGER); + $sth_insert_remote->bind_param(2, $rUIDVALIDITY, SQL_INTEGER); + $sth_insert_remote->execute(); # no need to commit before the first mapping (lUID,rUID) $KNOWN_INDEXES{$IDX} = 1; @@ -1439,10 +1475,15 @@ sub loop() { elsif (sync_known_messages($IDX, $MAILBOX)) { # sync updates to known messages before fetching new messages # get_cache is safe after pull_update - $STH_UPDATE_LOCAL_HIGHESTMODSEQ->execute( $lIMAP->get_cache('HIGHESTMODSEQ'), $IDX) or - msg('database', "WARNING: Can't update local HIGHESTMODSEQ for $MAILBOX"); - $STH_UPDATE_REMOTE_HIGHESTMODSEQ->execute($rIMAP->get_cache('HIGHESTMODSEQ'), $IDX) or - msg('database', "WARNING: Can't update remote HIGHESTMODSEQ for $MAILBOX"); + my $lHIGHESTMODSEQ = sprintf "%lld", $lIMAP->get_cache(qw/HIGHESTMODSEQ/); + $sth_update_local_highestmodseq->bind_param(1, $lHIGHESTMODSEQ, SQL_BIGINT); + $sth_update_local_highestmodseq->bind_param(2, $IDX, SQL_INTEGER); + $sth_update_local_highestmodseq->execute(); + + my $rHIGHESTMODSEQ = sprintf "%lld", $rIMAP->get_cache(qw/HIGHESTMODSEQ/); + $sth_update_remote_highestmodseq->bind_param(1, $rHIGHESTMODSEQ, SQL_BIGINT); + $sth_update_remote_highestmodseq->bind_param(2, $IDX, SQL_INTEGER); + $sth_update_remote_highestmodseq->execute(); $DBH->commit(); } sync_messages($IDX, $MAILBOX); -- cgit v1.2.3 From bacb78530555f9a73d86564837a11d6e75236de5 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Sat, 25 May 2019 15:27:59 +0200 Subject: libinterimap: use socketpair(2) in tunnel mode. Rather than two pipe(2). Also, use SOCK_CLOEXEC to save a fcntl() call when setting the close-on-exec flag on the socket (even though Perl will likely call fcntl() anyway). --- Changelog | 4 ++++ interimap.md | 5 ++-- lib/Net/IMAP/InterIMAP.pm | 60 +++++++++++++++++------------------------------ 3 files changed, 28 insertions(+), 41 deletions(-) diff --git a/Changelog b/Changelog index 251d5dc..cd03304 100644 --- a/Changelog +++ b/Changelog @@ -8,6 +8,10 @@ interimap (0.5) upstream; happen if mailboxes from different namespaces are being listed. The workaround here is to run a new interimap instance for each namespace. + * libinterimap: in tunnel mode, use a socketpair rather than two pipes + for IPC between the interimap and the IMAP server. Also, use + SOCK_CLOEXEC to save a fcntl() call when setting the close-on-exec + flag on the socket. + interimap: write which --target to use in --delete command suggestions. + interimap: avoid caching hierarchy delimiters forever in the diff --git a/interimap.md b/interimap.md index a230c09..2f064e1 100644 --- a/interimap.md +++ b/interimap.md @@ -265,8 +265,9 @@ Valid options are: : One of `imap`, `imaps` or `tunnel`. `type=imap` and `type=imaps` are respectively used for IMAP and IMAP over SSL/TLS connections over a INET socket. - `type=tunnel` causes `interimap` to open a pipe to a *command* - instead of a raw socket. + `type=tunnel` causes `interimap` to create an unnamed pair of + connected sockets for interprocess communication with a *command* + instead of a opening a network socket. Note that specifying `type=tunnel` in the `[remote]` section makes the default *database* to be `localhost.db`. (Default: `imaps`.) diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index 86f08a9..1dd54b7 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -23,11 +23,10 @@ use strict; use Compress::Raw::Zlib qw/Z_OK Z_FULL_FLUSH Z_SYNC_FLUSH MAX_WBITS/; use Config::Tiny (); use Errno qw/EEXIST EINTR/; -use Fcntl qw/F_GETFD F_SETFD FD_CLOEXEC/; use Net::SSLeay 1.73 (); use List::Util qw/all first/; use POSIX ':signal_h'; -use Socket qw/SOCK_STREAM IPPROTO_TCP AF_INET AF_INET6 SOCK_RAW :addrinfo/; +use Socket qw/SOCK_STREAM SOCK_RAW IPPROTO_TCP AF_UNIX AF_INET AF_INET6 PF_UNSPEC SOCK_CLOEXEC :addrinfo/; use Exporter 'import'; BEGIN { @@ -304,18 +303,13 @@ sub new($%) { if ($self->{type} eq 'tunnel') { my $command = $self->{command} // $self->fail("Missing tunnel command"); - - pipe $self->{STDOUT}, my $wd or $self->panic("Can't pipe: $!"); - pipe my $rd, $self->{STDIN} or $self->panic("Can't pipe: $!"); - - my $pid = fork // $self->panic("Can't fork: $!"); + socketpair($self->{S}, my $s, AF_UNIX, SOCK_STREAM|SOCK_CLOEXEC, PF_UNSPEC) or $self->panic("socketpair: $!"); + my $pid = fork // $self->panic("fork: $!"); unless ($pid) { # children - foreach (\*STDIN, \*STDOUT, $self->{STDIN}, $self->{STDOUT}) { - close $_ or $self->panic("Can't close: $!"); - } - open STDIN, '<&', $rd or $self->panic("Can't dup: $!"); - open STDOUT, '>&', $wd or $self->panic("Can't dup: $!"); + close($self->{S}) or $self->panic("Can't close: $!"); + open STDIN, '<&', $s or $self->panic("Can't dup: $!"); + open STDOUT, '>&', $s or $self->panic("Can't dup: $!"); my $stderr2; if ($self->{'null-stderr'} // 0) { @@ -338,30 +332,24 @@ sub new($%) { } # parent - foreach ($rd, $wd) { - close $_ or $self->panic("Can't close: $!"); - } - foreach (qw/STDIN STDOUT/) { - binmode($self->{$_}) // $self->panic("binmode: $!") - } + close($s) or $self->panic("Can't close: $!"); } else { foreach (qw/host port/) { $self->fail("Missing option $_") unless defined $self->{$_}; } - my $socket = defined $self->{proxy} ? $self->_proxify(@$self{qw/proxy host port/}) + $self->{S} = defined $self->{proxy} ? $self->_proxify(@$self{qw/proxy host port/}) : $self->_tcp_connect(@$self{qw/host port/}); if (defined $self->{keepalive}) { - setsockopt($socket, Socket::SOL_SOCKET, Socket::SO_KEEPALIVE, 1) + setsockopt($self->{S}, Socket::SOL_SOCKET, Socket::SO_KEEPALIVE, 1) or $self->fail("Can't setsockopt SO_KEEPALIVE: $!"); - setsockopt($socket, Socket::IPPROTO_TCP, Socket::TCP_KEEPIDLE, 60) + setsockopt($self->{S}, Socket::IPPROTO_TCP, Socket::TCP_KEEPIDLE, 60) or $self->fail("Can't setsockopt TCP_KEEPIDLE: $!"); } - binmode($socket) // $self->panic("binmode: $!"); - $self->_start_ssl($socket) if $self->{type} eq 'imaps'; - $self->{$_} = $socket for qw/STDOUT STDIN/; } + binmode($self->{S}) // $self->panic("binmode: $!"); + $self->_start_ssl($self->{S}) if $self->{type} eq 'imaps'; # command counter $self->{_TAG} = 0; @@ -413,7 +401,7 @@ sub new($%) { if ($self->{type} eq 'imap' and $self->{STARTTLS}) { # RFC 2595 section 5.1 $self->fail("Server did not advertise STARTTLS capability.") unless grep {$_ eq 'STARTTLS'} @caps; - $self->_start_ssl($self->{STDIN}) if $self->{type} eq 'imaps'; + $self->_start_ssl($self->{S}) if $self->{type} eq 'imaps'; # refresh the previous CAPABILITY list since the previous one could have been spoofed delete $self->{_CAPABILITIES}; @@ -526,11 +514,8 @@ sub DESTROY($) { Net::SSLeay::free($self->{_SSL}) if defined $self->{_SSL}; Net::SSLeay::CTX_free($self->{_SSL_CTX}) if defined $self->{_SSL_CTX}; - shutdown($self->{STDIN}, 2) if $self->{type} ne 'tunnel' and defined $self->{STDIN}; - foreach (qw/STDIN STDOUT/) { - $self->{$_}->close() if defined $self->{$_} and $self->{$_}->opened(); - } - + shutdown($self->{S}, 2) if $self->{type} ne 'tunnel' and defined $self->{S}; + $self->{S}->close() if defined $self->{S} and $self->{S}->opened(); $self->stats() unless $self->{quiet}; } @@ -677,7 +662,7 @@ sub unselect($) { sub logout($) { my $self = shift; # don't bother if the connection is already closed - $self->_send('LOGOUT') if $self->{STDIN}->opened(); + $self->_send('LOGOUT') if $self->{S}->opened(); $self->{_STATE} = 'LOGOUT'; undef $self; } @@ -968,7 +953,7 @@ sub slurp($$$) { my $aborted = 0; my $rin = ''; - vec($rin, fileno($_->{STDOUT}), 1) = 1 foreach @$selfs; + vec($rin, fileno($_->{S}), 1) = 1 foreach @$selfs; while (1) { # first, consider only unprocessed data without our own output @@ -983,7 +968,7 @@ sub slurp($$$) { next if $r == -1 and $! == EINTR; # select(2) was interrupted die "select: $!" if $r == -1; return $aborted if $r == 0; # nothing more to read (timeout reached) - @ready = grep {vec($rout, fileno($_->{STDOUT}), 1)} @$selfs; + @ready = grep {vec($rout, fileno($_->{S}), 1)} @$selfs; $timeout = $timeleft if $timeout > 0; } @@ -1421,7 +1406,7 @@ sub _tcp_connect($$$) { SOCKETS: foreach my $ai (@res) { - socket (my $s, $ai->{family}, $ai->{socktype}, $ai->{protocol}) or $self->panic("connect: $!"); + socket (my $s, $ai->{family}, $ai->{socktype}|SOCK_CLOEXEC, $ai->{protocol}) or $self->panic("socket: $!"); # timeout connect/read/write/... after 30s # XXX we need to pack the struct timeval manually: not portable! @@ -1436,9 +1421,6 @@ sub _tcp_connect($$$) { next if $! == EINTR; # try again if connect(2) was interrupted by a signal next SOCKETS; } - - my $flags = fcntl($s, F_GETFD, 0) or $self->panic("fcntl F_GETFD: $!"); - fcntl($s, F_SETFD, $flags | FD_CLOEXEC) or $self->panic("fcntl F_SETFD: $!"); return $s; } $self->fail("Can't connect to $host:$port"); @@ -1704,7 +1686,7 @@ sub _getline($;$) { my $self = shift; my $len = shift // 0; - my ($stdout, $ssl) = @$self{qw/STDOUT _SSL/}; + my ($stdout, $ssl) = @$self{qw/S _SSL/}; $self->fail("Lost connection") unless $stdout->opened(); my (@lit, @line); @@ -1903,7 +1885,7 @@ sub _cmd_flush($;$$) { my $self = shift; $self->_cmd_extend_( $_[0] // \$CRLF ); my $z_flush = $_[1] // Z_SYNC_FLUSH; # the flush point type to use - my ($stdin, $ssl) = @$self{qw/STDIN _SSL/}; + my ($stdin, $ssl) = @$self{qw/S _SSL/}; if ($self->{debug}) { # remove $CRLF and literals -- cgit v1.2.3 From 456946609aa1e64a42578ff1c4962ea939d31da4 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Tue, 21 May 2019 14:12:26 +0200 Subject: New option 'list-reference' to specify a reference name. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This is useful for synchronizing multiple remote servers against different namespaces belonging to the same local IMAP server (using a different InterIMAP instance for each local namespace ↔ remote synchronization, for instance with the newy provided systemd template unit file). --- Changelog | 6 ++++++ interimap | 45 ++++++++++++++++++++++++++++----------------- interimap.md | 17 +++++++++++++++++ interimap@.service | 14 ++++++++++++++ 4 files changed, 65 insertions(+), 17 deletions(-) create mode 100644 interimap@.service diff --git a/Changelog b/Changelog index cd03304..a9f1ae3 100644 --- a/Changelog +++ b/Changelog @@ -12,6 +12,12 @@ interimap (0.5) upstream; for IPC between the interimap and the IMAP server. Also, use SOCK_CLOEXEC to save a fcntl() call when setting the close-on-exec flag on the socket. + * interimap: new option 'list-reference' to specify a reference name. + This is useful for synchronizing multiple remote servers against + different namespaces belonging to the same local IMAP server (using a + different InterIMAP instance for each local namespace <-> remote + synchronization, for instance with the newly provided systemd + template unit file). + interimap: write which --target to use in --delete command suggestions. + interimap: avoid caching hierarchy delimiters forever in the diff --git a/interimap b/interimap index 2dd0eb5..7054f88 100755 --- a/interimap +++ b/interimap @@ -79,6 +79,7 @@ my $CONF = do { , [qw/_ local remote/] , database => qr/\A(\P{Control}+)\z/ , logfile => qr/\A(\/\P{Control}+)\z/ + , 'list-reference' => qr/\A([\x01-\x09\x0B\x0C\x0E-\x7F]*)\z/ , 'list-mailbox' => qr/\A([\x01-\x09\x0B\x0C\x0E-\x7F]+)\z/ , 'list-select-opts' => qr/\A([\x20\x21\x23\x24\x26\x27\x2B-\x5B\x5E-\x7A\x7C-\x7E]*)\z/ , 'ignore-mailbox' => qr/\A([\x01-\x09\x0B\x0C\x0E-\x7F]+)\z/ @@ -139,6 +140,7 @@ my ($DBFILE, $LOGGER_FD, %LIST); $CONFIG{target} = {}; $CONFIG{target}->{$_} = 1 foreach qw/local remote database/; } + $CONF->{$_}->{'list-reference'} //= "" foreach qw/local remote/; } my $DBH; @@ -231,20 +233,21 @@ sub print_delimiter($) { 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) = @_; +# Return the delimiter of the default namespace or reference, 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, $ref) = @_; # Use the cached value if present return $imap->{delimiter} if exists $imap->{delimiter}; - my (undef, $d) = $imap->{client}->list("\"\" \"\""); + my (undef, $d) = $imap->{client}->list($ref." \"\""); # $ref is already quoted 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. + # a hierarchy delimiter of the root node or reference (we can't + # match the root against the reference as it might not be rooted). fail($name, "Missing or unexpected (unsolicited) LIST response.") unless $#d == 0; return $imap->{delimiter} = $d[0]; # cache value and return it @@ -254,16 +257,17 @@ sub get_delimiter($$) { sub list_mailboxes($) { my $name = shift; my $imap = $IMAP->{$name}; + my $ref = Net::IMAP::InterIMAP::quote($CONF->{$name}->{'list-reference'}); my $list = ""; $list .= "(" .$LIST{'select-opts'}. ") " if defined $LIST{'select-opts'}; - $list .= "\"\" "; + $list .= $ref." "; 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) // + my $d = get_delimiter($name, $imap, $ref) // fail($name, "Mailbox name contains null characters but the namespace is flat!"); s/\x00/$d/g foreach @mailboxes; } @@ -291,7 +295,7 @@ sub list_mailboxes($) { } else { # didn't get a non-INBOX LIST reply so we need to explicitely query # the hierarchy delimiter - get_delimiter($name, $imap); + get_delimiter($name, $imap, $ref); } } logger($name, "Using ", print_delimiter($imap->{delimiter}), @@ -299,7 +303,7 @@ sub list_mailboxes($) { # 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. + # its children) match the one at the top level (root or reference). my $d = $imap->{delimiter}; foreach my $m (keys %$delims) { fail($name, "Mailbox $m has hierarchy delimiter ", print_delimiter($delims->{$m}), @@ -457,25 +461,30 @@ sub db_get_mailbox_idx($) { 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. +# Transform mailbox name from internal representation (with \0 as hierarchy delimiters +# and without reference prefix) to a name understandable by the local/remote IMAP server. sub mbx_name($$) { my ($name, $mailbox) = @_; - my $x = $name // "local"; + my $x = $name // "local"; # don't add reference if $name is undefined 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; + return defined $name ? ($CONF->{$name}->{"list-reference"} . $mailbox) : $mailbox; } # Transform mailbox name from local/remote IMAP server to the internal representation -# (with \0 as hierarchy delimiters). +# (with \0 as hierarchy delimiters and without reference prefix). Return undef if +# the name doesn't start with the right reference. sub mbx_unname($$) { my ($name, $mailbox) = @_; return unless defined $mailbox; + my $ref = $CONF->{$name}->{"list-reference"}; + return unless rindex($mailbox, $ref, 0) == 0; # not for us + $mailbox = substr($mailbox, length $ref); + if (defined (my $d = $IMAP->{$name}->{delimiter})) { $mailbox =~ s/\Q$d\E/\x00/g; } elsif (!exists $IMAP->{$name}->{delimiter}) { @@ -631,7 +640,9 @@ sub sync_mailbox_list() { foreach my $name (qw/local remote/) { foreach my $mbx (keys %{$IMAP->{$name}->{mailboxes}}) { - $mbx = mbx_unname($name, $mbx); + # exclude names not starting with the given LIST reference; for instance + # if "list-mailbox" specifies a name starting with a "breakout" character + $mbx = mbx_unname($name, $mbx) // next; # exclude ignored mailboxes (taken from the default config as it doesn't # make sense to ignore mailboxes from one side but not the other diff --git a/interimap.md b/interimap.md index 2f064e1..50c1832 100644 --- a/interimap.md +++ b/interimap.md @@ -214,6 +214,23 @@ Valid options are: (Default: `HOST.db`, where *HOST* is taken from the `[remote]` or `[local]` sections, in that order.) +*list-reference* + +: An optional “reference name” to use for the initial `LIST` command, + indicating the context in which the *MAILBOX*es are interpreted. + For instance, by specifying `list-reference=perso/` in the `[local]` + section, *MAILBOX* names are interpreted relative to `perso/` on the + local server; in other words the remote mailbox hierarchy is mapped + to the `perso/` sub-hierarchy on the local server. This is useful + for synchronizing multiple remote servers against different + namespaces belonging to the same local IMAP server (using a + different InterIMAP instance for each local namespace ↔ remote + synchronization). + + (Note that if the reference name is not a level of mailbox hierarchy + and/or does not end with the hierarchy delimiter, by [RFC 3501] its + interpretation by the IMAP server is implementation-dependent.) + *list-mailbox* : A space separated list of mailbox patterns to use when issuing the diff --git a/interimap@.service b/interimap@.service new file mode 100644 index 0000000..6957b79 --- /dev/null +++ b/interimap@.service @@ -0,0 +1,14 @@ +[Unit] +Description=Fast bidirectional synchronization for QRESYNC-capable IMAP servers (instance %i) +Documentation=man:interimap(1) +PartOf=interimap.service +Wants=network-online.target +After=network-online.target + +[Service] +ExecStart=/usr/bin/interimap --config=%i --watch=60 +RestartSec=10min +Restart=on-failure + +[Install] +WantedBy=default.target -- cgit v1.2.3 From 8e379c62a48d68cd5ab2a32c6fc9244b1ae94084 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Sun, 26 May 2019 23:28:04 +0200 Subject: Add test-suite (requires dovecot-imapd). --- Changelog | 1 + Makefile | 5 +- tests/00-db-exclusive/local.conf | 5 + tests/00-db-exclusive/remote.conf | 5 + tests/00-db-exclusive/run | 25 ++ .../before.sql | 1 + .../local.conf | 6 + .../remote.conf | 6 + tests/00-db-migration-0-to-1-delim-mismatch/run | 8 + .../local.conf | 6 + .../remote.conf | 6 + .../run | 23 ++ tests/00-db-migration-0-to-1/after.sql | 14 + tests/00-db-migration-0-to-1/before.sql | 14 + tests/00-db-migration-0-to-1/local.conf | 6 + tests/00-db-migration-0-to-1/remote.conf | 6 + tests/00-db-migration-0-to-1/run | 26 ++ tests/01-rename-exists-db/local.conf | 6 + tests/01-rename-exists-db/remote.conf | 6 + tests/01-rename-exists-db/run | 14 + tests/01-rename-exists-local/local.conf | 6 + tests/01-rename-exists-local/remote.conf | 6 + tests/01-rename-exists-local/run | 13 + tests/01-rename-exists-remote/local.conf | 6 + tests/01-rename-exists-remote/remote.conf | 6 + tests/01-rename-exists-remote/run | 13 + tests/01-rename/local.conf | 6 + tests/01-rename/remote.conf | 6 + tests/01-rename/run | 84 ++++++ tests/02-delete/local.conf | 6 + tests/02-delete/remote.conf | 6 + tests/02-delete/run | 67 ++++ tests/03-sync-mailbox-list-partial/interimap.conf | 1 + tests/03-sync-mailbox-list-partial/local.conf | 6 + tests/03-sync-mailbox-list-partial/remote.conf | 6 + tests/03-sync-mailbox-list-partial/run | 57 ++++ tests/03-sync-mailbox-list-ref/local.conf | 6 + tests/03-sync-mailbox-list-ref/remote.conf | 6 + tests/03-sync-mailbox-list-ref/run | 28 ++ tests/03-sync-mailbox-list/local.conf | 6 + tests/03-sync-mailbox-list/remote.conf | 6 + tests/03-sync-mailbox-list/run | 73 +++++ tests/04-resume/local.conf | 6 + tests/04-resume/remote.conf | 6 + tests/04-resume/run | 98 ++++++ tests/05-repair/local.conf | 6 + tests/05-repair/remote.conf | 6 + tests/05-repair/run | 107 +++++++ tests/06-largeint/local.conf | 5 + tests/06-largeint/remote.conf | 5 + tests/06-largeint/run | 38 +++ tests/07-sync-live-multi/local.conf | 30 ++ tests/07-sync-live-multi/remote.conf | 6 + tests/07-sync-live-multi/remote2.conf | 6 + tests/07-sync-live-multi/remote3.conf | 6 + tests/07-sync-live-multi/run | 138 +++++++++ tests/07-sync-live/local.conf | 6 + tests/07-sync-live/remote.conf | 6 + tests/07-sync-live/run | 80 +++++ tests/run | 336 +++++++++++++++++++++ 60 files changed, 1499 insertions(+), 1 deletion(-) create mode 100644 tests/00-db-exclusive/local.conf create mode 100644 tests/00-db-exclusive/remote.conf create mode 100644 tests/00-db-exclusive/run create mode 120000 tests/00-db-migration-0-to-1-delim-mismatch/before.sql create mode 100644 tests/00-db-migration-0-to-1-delim-mismatch/local.conf create mode 100644 tests/00-db-migration-0-to-1-delim-mismatch/remote.conf create mode 100644 tests/00-db-migration-0-to-1-delim-mismatch/run create mode 100644 tests/00-db-migration-0-to-1-foreign-key-violation/local.conf create mode 100644 tests/00-db-migration-0-to-1-foreign-key-violation/remote.conf create mode 100644 tests/00-db-migration-0-to-1-foreign-key-violation/run create mode 100644 tests/00-db-migration-0-to-1/after.sql create mode 100644 tests/00-db-migration-0-to-1/before.sql create mode 100644 tests/00-db-migration-0-to-1/local.conf create mode 100644 tests/00-db-migration-0-to-1/remote.conf create mode 100644 tests/00-db-migration-0-to-1/run create mode 100644 tests/01-rename-exists-db/local.conf create mode 100644 tests/01-rename-exists-db/remote.conf create mode 100644 tests/01-rename-exists-db/run create mode 100644 tests/01-rename-exists-local/local.conf create mode 100644 tests/01-rename-exists-local/remote.conf create mode 100644 tests/01-rename-exists-local/run create mode 100644 tests/01-rename-exists-remote/local.conf create mode 100644 tests/01-rename-exists-remote/remote.conf create mode 100644 tests/01-rename-exists-remote/run create mode 100644 tests/01-rename/local.conf create mode 100644 tests/01-rename/remote.conf create mode 100644 tests/01-rename/run create mode 100644 tests/02-delete/local.conf create mode 100644 tests/02-delete/remote.conf create mode 100644 tests/02-delete/run create mode 100644 tests/03-sync-mailbox-list-partial/interimap.conf create mode 100644 tests/03-sync-mailbox-list-partial/local.conf create mode 100644 tests/03-sync-mailbox-list-partial/remote.conf create mode 100644 tests/03-sync-mailbox-list-partial/run create mode 100644 tests/03-sync-mailbox-list-ref/local.conf create mode 100644 tests/03-sync-mailbox-list-ref/remote.conf create mode 100644 tests/03-sync-mailbox-list-ref/run create mode 100644 tests/03-sync-mailbox-list/local.conf create mode 100644 tests/03-sync-mailbox-list/remote.conf create mode 100644 tests/03-sync-mailbox-list/run create mode 100644 tests/04-resume/local.conf create mode 100644 tests/04-resume/remote.conf create mode 100644 tests/04-resume/run create mode 100644 tests/05-repair/local.conf create mode 100644 tests/05-repair/remote.conf create mode 100644 tests/05-repair/run create mode 100644 tests/06-largeint/local.conf create mode 100644 tests/06-largeint/remote.conf create mode 100644 tests/06-largeint/run create mode 100644 tests/07-sync-live-multi/local.conf create mode 100644 tests/07-sync-live-multi/remote.conf create mode 100644 tests/07-sync-live-multi/remote2.conf create mode 100644 tests/07-sync-live-multi/remote3.conf create mode 100644 tests/07-sync-live-multi/run create mode 100644 tests/07-sync-live/local.conf create mode 100644 tests/07-sync-live/remote.conf create mode 100644 tests/07-sync-live/run create mode 100755 tests/run diff --git a/Changelog b/Changelog index a9f1ae3..a13801a 100644 --- a/Changelog +++ b/Changelog @@ -18,6 +18,7 @@ interimap (0.5) upstream; different InterIMAP instance for each local namespace <-> remote synchronization, for instance with the newly provided systemd template unit file). + * Add a small test-suite (requires dovecot-imapd). + interimap: write which --target to use in --delete command suggestions. + interimap: avoid caching hierarchy delimiters forever in the diff --git a/Makefile b/Makefile index d7b7133..ec35011 100644 --- a/Makefile +++ b/Makefile @@ -31,7 +31,10 @@ all: pullimap.1 interimap.1 install: +test: + @for t in tests/*; do [ -d "$$t" ] || continue; ./tests/run "$$t" || exit 1; done + clean: rm -f pullimap.1 interimap.1 -.PHONY: all install clean +.PHONY: all install clean test diff --git a/tests/00-db-exclusive/local.conf b/tests/00-db-exclusive/local.conf new file mode 100644 index 0000000..9c838fd --- /dev/null +++ b/tests/00-db-exclusive/local.conf @@ -0,0 +1,5 @@ +namespace inbox { + location = maildir:~/inbox:LAYOUT=index + inbox = yes + list = yes +} diff --git a/tests/00-db-exclusive/remote.conf b/tests/00-db-exclusive/remote.conf new file mode 100644 index 0000000..9c838fd --- /dev/null +++ b/tests/00-db-exclusive/remote.conf @@ -0,0 +1,5 @@ +namespace inbox { + location = maildir:~/inbox:LAYOUT=index + inbox = yes + list = yes +} diff --git a/tests/00-db-exclusive/run b/tests/00-db-exclusive/run new file mode 100644 index 0000000..1ae27b6 --- /dev/null +++ b/tests/00-db-exclusive/run @@ -0,0 +1,25 @@ +# verify that database isn't created in --watch mode +! interimap --watch=60 +xgrep -E "^DBI connect\(.*\) failed: unable to open database file at " <"$STDERR" + +# now create database +interimap + +# start a background process +interimap --watch=60 & pid=$! +cleanup() { + # kill interimap process and its children + pkill -P "$pid" -TERM + kill -TERM "$pid" + wait +} +trap cleanup EXIT INT TERM + +sleep .05 # wait a short while so we have time to lock the database (ugly and racy...) +# verify that subsequent runs fail as we can't acquire the exclusive lock +! interimap + +# line 177 is `$DBH->do("PRAGMA locking_mode = EXCLUSIVE");` +xgrep -Fx "DBD::SQLite::db do failed: database is locked at ./interimap line 177." <"$STDERR" + +# vim: set filetype=sh : diff --git a/tests/00-db-migration-0-to-1-delim-mismatch/before.sql b/tests/00-db-migration-0-to-1-delim-mismatch/before.sql new file mode 120000 index 0000000..0abb9bf --- /dev/null +++ b/tests/00-db-migration-0-to-1-delim-mismatch/before.sql @@ -0,0 +1 @@ +../00-db-migration-0-to-1/before.sql \ No newline at end of file diff --git a/tests/00-db-migration-0-to-1-delim-mismatch/local.conf b/tests/00-db-migration-0-to-1-delim-mismatch/local.conf new file mode 100644 index 0000000..08438cb --- /dev/null +++ b/tests/00-db-migration-0-to-1-delim-mismatch/local.conf @@ -0,0 +1,6 @@ +namespace inbox { + separator = "\"" + location = maildir:~/inbox:LAYOUT=index + inbox = yes + list = yes +} diff --git a/tests/00-db-migration-0-to-1-delim-mismatch/remote.conf b/tests/00-db-migration-0-to-1-delim-mismatch/remote.conf new file mode 100644 index 0000000..cc6781d --- /dev/null +++ b/tests/00-db-migration-0-to-1-delim-mismatch/remote.conf @@ -0,0 +1,6 @@ +namespace inbox { + separator = ^ + location = maildir:~/inbox:LAYOUT=index + inbox = yes + list = yes +} diff --git a/tests/00-db-migration-0-to-1-delim-mismatch/run b/tests/00-db-migration-0-to-1-delim-mismatch/run new file mode 100644 index 0000000..434c678 --- /dev/null +++ b/tests/00-db-migration-0-to-1-delim-mismatch/run @@ -0,0 +1,8 @@ +# import an existing non-migrated database +sqlite3 "$XDG_DATA_HOME/interimap/remote.db" <"$TESTDIR/before.sql" +! interimap + +# may happen if the server(s) software or its configuration changed +xgrep -Fx 'ERROR: Local and remote hierachy delimiters differ (local "\"", remote "^"), refusing to update `mailboxes` table.' <"$STDERR" + +# vim: set filetype=sh : diff --git a/tests/00-db-migration-0-to-1-foreign-key-violation/local.conf b/tests/00-db-migration-0-to-1-foreign-key-violation/local.conf new file mode 100644 index 0000000..93497d9 --- /dev/null +++ b/tests/00-db-migration-0-to-1-foreign-key-violation/local.conf @@ -0,0 +1,6 @@ +namespace inbox { + separator = . + location = maildir:~/inbox:LAYOUT=index + inbox = yes + list = yes +} diff --git a/tests/00-db-migration-0-to-1-foreign-key-violation/remote.conf b/tests/00-db-migration-0-to-1-foreign-key-violation/remote.conf new file mode 100644 index 0000000..93497d9 --- /dev/null +++ b/tests/00-db-migration-0-to-1-foreign-key-violation/remote.conf @@ -0,0 +1,6 @@ +namespace inbox { + separator = . + location = maildir:~/inbox:LAYOUT=index + inbox = yes + list = yes +} diff --git a/tests/00-db-migration-0-to-1-foreign-key-violation/run b/tests/00-db-migration-0-to-1-foreign-key-violation/run new file mode 100644 index 0000000..f2d12a9 --- /dev/null +++ b/tests/00-db-migration-0-to-1-foreign-key-violation/run @@ -0,0 +1,23 @@ +# create new schema and add INBOX +interimap +xgrep "^Creating new schema in database file " <"$STDERR" +xgrep -Fx "database: Created mailbox INBOX" <"$STDERR" + +# empty table `mailboxes` and revert its schema to version 0 +sqlite3 "$XDG_DATA_HOME/interimap/remote.db" <<-EOF + PRAGMA foreign_keys = OFF; + PRAGMA user_version = 0; + DROP TABLE mailboxes; + CREATE TABLE mailboxes ( + idx INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT, + mailbox TEXT NOT NULL CHECK (mailbox != '') UNIQUE, + subscribed BOOLEAN NOT NULL + ); +EOF + +# check that migration fails due to broken referential integrity +! interimap +xgrep -Fx "Upgrading database version from 0" <"$STDERR" +xgrep -Fx "database: ERROR: Broken referential integrity! Refusing to commit changes." <"$STDERR" + +# vim: set filetype=sh : diff --git a/tests/00-db-migration-0-to-1/after.sql b/tests/00-db-migration-0-to-1/after.sql new file mode 100644 index 0000000..18b0ad7 --- /dev/null +++ b/tests/00-db-migration-0-to-1/after.sql @@ -0,0 +1,14 @@ +PRAGMA foreign_keys=OFF; +BEGIN TRANSACTION; +CREATE TABLE local (idx INTEGER NOT NULL PRIMARY KEY REFERENCES mailboxes(idx), UIDVALIDITY UNSIGNED INT NOT NULL CHECK (UIDVALIDITY > 0), UIDNEXT UNSIGNED INT NOT NULL, HIGHESTMODSEQ UNSIGNED BIGINT NOT NULL); +CREATE TABLE remote (idx INTEGER NOT NULL PRIMARY KEY REFERENCES mailboxes(idx), UIDVALIDITY UNSIGNED INT NOT NULL CHECK (UIDVALIDITY > 0), UIDNEXT UNSIGNED INT NOT NULL, HIGHESTMODSEQ UNSIGNED BIGINT NOT NULL); +CREATE TABLE mapping (idx INTEGER NOT NULL REFERENCES mailboxes(idx), lUID UNSIGNED INT NOT NULL CHECK (lUID > 0), rUID UNSIGNED INT NOT NULL CHECK (rUID > 0), PRIMARY KEY (idx,lUID), UNIQUE (idx,rUID)); +CREATE TABLE IF NOT EXISTS "mailboxes" (idx INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT, mailbox BLOB COLLATE BINARY NOT NULL CHECK (mailbox != '') UNIQUE, subscribed BOOLEAN NOT NULL); +INSERT INTO mailboxes VALUES(1,X'61006231006332',0); +INSERT INTO mailboxes VALUES(2,X'61006231006331',0); +INSERT INTO mailboxes VALUES(3,X'494e424f58',0); +INSERT INTO mailboxes VALUES(4,X'6132',0); +INSERT INTO mailboxes VALUES(5,X'610062320063',0); +DELETE FROM sqlite_sequence; +INSERT INTO sqlite_sequence VALUES('mailboxes',5); +COMMIT; diff --git a/tests/00-db-migration-0-to-1/before.sql b/tests/00-db-migration-0-to-1/before.sql new file mode 100644 index 0000000..333a1dc --- /dev/null +++ b/tests/00-db-migration-0-to-1/before.sql @@ -0,0 +1,14 @@ +PRAGMA foreign_keys=OFF; +BEGIN TRANSACTION; +CREATE TABLE mailboxes (idx INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT, mailbox TEXT NOT NULL CHECK (mailbox != '') UNIQUE, subscribed BOOLEAN NOT NULL); +INSERT INTO mailboxes VALUES(1,'a.b1.c2',0); +INSERT INTO mailboxes VALUES(2,'a.b1.c1',0); +INSERT INTO mailboxes VALUES(3,'INBOX',0); +INSERT INTO mailboxes VALUES(4,'a2',0); +INSERT INTO mailboxes VALUES(5,'a.b2.c',0); +CREATE TABLE local (idx INTEGER NOT NULL PRIMARY KEY REFERENCES mailboxes(idx), UIDVALIDITY UNSIGNED INT NOT NULL CHECK (UIDVALIDITY > 0), UIDNEXT UNSIGNED INT NOT NULL, HIGHESTMODSEQ UNSIGNED BIGINT NOT NULL); +CREATE TABLE remote (idx INTEGER NOT NULL PRIMARY KEY REFERENCES mailboxes(idx), UIDVALIDITY UNSIGNED INT NOT NULL CHECK (UIDVALIDITY > 0), UIDNEXT UNSIGNED INT NOT NULL, HIGHESTMODSEQ UNSIGNED BIGINT NOT NULL); +CREATE TABLE mapping (idx INTEGER NOT NULL REFERENCES mailboxes(idx), lUID UNSIGNED INT NOT NULL CHECK (lUID > 0), rUID UNSIGNED INT NOT NULL CHECK (rUID > 0), PRIMARY KEY (idx,lUID), UNIQUE (idx,rUID)); +DELETE FROM sqlite_sequence; +INSERT INTO sqlite_sequence VALUES('mailboxes',5); +COMMIT; diff --git a/tests/00-db-migration-0-to-1/local.conf b/tests/00-db-migration-0-to-1/local.conf new file mode 100644 index 0000000..93497d9 --- /dev/null +++ b/tests/00-db-migration-0-to-1/local.conf @@ -0,0 +1,6 @@ +namespace inbox { + separator = . + location = maildir:~/inbox:LAYOUT=index + inbox = yes + list = yes +} diff --git a/tests/00-db-migration-0-to-1/remote.conf b/tests/00-db-migration-0-to-1/remote.conf new file mode 100644 index 0000000..93497d9 --- /dev/null +++ b/tests/00-db-migration-0-to-1/remote.conf @@ -0,0 +1,6 @@ +namespace inbox { + separator = . + location = maildir:~/inbox:LAYOUT=index + inbox = yes + list = yes +} diff --git a/tests/00-db-migration-0-to-1/run b/tests/00-db-migration-0-to-1/run new file mode 100644 index 0000000..e4eb770 --- /dev/null +++ b/tests/00-db-migration-0-to-1/run @@ -0,0 +1,26 @@ +# create some mailboxes +doveadm -u "local" mailbox create "a.b1.c1" "a.b1.c2" "a.b2.c" "a2" +doveadm -u "remote" mailbox create "a.b1.c1" "a.b1.c2" "a.b2.c" "a2" + +# import an existing non-migrated database +sqlite3 "$XDG_DATA_HOME/interimap/remote.db" <"$TESTDIR/before.sql" + +# migrate +interimap + +xgrep -Fx "Upgrading database version from 0" <"$STDERR" +check_mailboxes_status "a.b1.c1" "a.b1.c2" "a.b2.c" "a2" + +# verify that the new schema is as expected +sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/dump.sql" <<-EOF + DELETE FROM local; + DELETE FROM remote; + .dump +EOF + +# XXX need 'user_version' PRAGMA in the dump for future migrations +# http://sqlite.1065341.n5.nabble.com/dump-command-and-user-version-td101228.html +diff -u --label="a/dump.sql" --label="b/dump.sql" \ + "$TESTDIR/after.sql" "$TMPDIR/dump.sql" + +# vim: set filetype=sh : diff --git a/tests/01-rename-exists-db/local.conf b/tests/01-rename-exists-db/local.conf new file mode 100644 index 0000000..93497d9 --- /dev/null +++ b/tests/01-rename-exists-db/local.conf @@ -0,0 +1,6 @@ +namespace inbox { + separator = . + location = maildir:~/inbox:LAYOUT=index + inbox = yes + list = yes +} diff --git a/tests/01-rename-exists-db/remote.conf b/tests/01-rename-exists-db/remote.conf new file mode 100644 index 0000000..61e3d0d --- /dev/null +++ b/tests/01-rename-exists-db/remote.conf @@ -0,0 +1,6 @@ +namespace inbox { + separator = "\\" + location = maildir:~/inbox:LAYOUT=index + inbox = yes + list = yes +} diff --git a/tests/01-rename-exists-db/run b/tests/01-rename-exists-db/run new file mode 100644 index 0000000..29cb075 --- /dev/null +++ b/tests/01-rename-exists-db/run @@ -0,0 +1,14 @@ +doveadm -u "local" mailbox create "root.from" "root.from.child" "t.o" +doveadm -u "remote" mailbox create "root\\from" "root\\from\\child" "t\\o" + +interimap +check_mailbox_list + +# delete a mailbox on both servers but leave it in the database, then try to use it as target for --rename +doveadm -u "local" mailbox delete "t.o" +doveadm -u "remote" mailbox delete "t\\o" + +! interimap --rename "root.from" "t.o" +xgrep -Fx 'database: ERROR: Mailbox t.o exists. Run `interimap --target=database --delete t.o` to delete.' <"$STDERR" + +# vim: set filetype=sh : diff --git a/tests/01-rename-exists-local/local.conf b/tests/01-rename-exists-local/local.conf new file mode 100644 index 0000000..93497d9 --- /dev/null +++ b/tests/01-rename-exists-local/local.conf @@ -0,0 +1,6 @@ +namespace inbox { + separator = . + location = maildir:~/inbox:LAYOUT=index + inbox = yes + list = yes +} diff --git a/tests/01-rename-exists-local/remote.conf b/tests/01-rename-exists-local/remote.conf new file mode 100644 index 0000000..61e3d0d --- /dev/null +++ b/tests/01-rename-exists-local/remote.conf @@ -0,0 +1,6 @@ +namespace inbox { + separator = "\\" + location = maildir:~/inbox:LAYOUT=index + inbox = yes + list = yes +} diff --git a/tests/01-rename-exists-local/run b/tests/01-rename-exists-local/run new file mode 100644 index 0000000..17d8fcc --- /dev/null +++ b/tests/01-rename-exists-local/run @@ -0,0 +1,13 @@ +doveadm -u "local" mailbox create "root.from" "root.from.child" "t.o" +doveadm -u "remote" mailbox create "root\\from" "root\\from\\child" + +interimap +check_mailbox_list + +# delete a mailbox on the remote server, then try to use it as target for --rename +doveadm -u "remote" mailbox delete "t\\o" + +! interimap --rename "root.from" "t.o" +xgrep -Fx 'local: ERROR: Mailbox t.o exists. Run `interimap --target=local --delete t.o` to delete.' <"$STDERR" + +# vim: set filetype=sh : diff --git a/tests/01-rename-exists-remote/local.conf b/tests/01-rename-exists-remote/local.conf new file mode 100644 index 0000000..93497d9 --- /dev/null +++ b/tests/01-rename-exists-remote/local.conf @@ -0,0 +1,6 @@ +namespace inbox { + separator = . + location = maildir:~/inbox:LAYOUT=index + inbox = yes + list = yes +} diff --git a/tests/01-rename-exists-remote/remote.conf b/tests/01-rename-exists-remote/remote.conf new file mode 100644 index 0000000..61e3d0d --- /dev/null +++ b/tests/01-rename-exists-remote/remote.conf @@ -0,0 +1,6 @@ +namespace inbox { + separator = "\\" + location = maildir:~/inbox:LAYOUT=index + inbox = yes + list = yes +} diff --git a/tests/01-rename-exists-remote/run b/tests/01-rename-exists-remote/run new file mode 100644 index 0000000..c867a77 --- /dev/null +++ b/tests/01-rename-exists-remote/run @@ -0,0 +1,13 @@ +doveadm -u "local" mailbox create "root.from" "root.from.child" "t.o" +doveadm -u "remote" mailbox create "root\\from" "root\\from\\child" "t\\o" + +interimap +check_mailbox_list + +# delete a mailbox on the local server, then try to use it as target for --rename +doveadm -u "local" mailbox delete "t.o" + +! interimap --rename "root.from" "t.o" +xgrep -Fx 'remote: ERROR: Mailbox t\o exists. Run `interimap --target=remote --delete t.o` to delete.' <"$STDERR" + +# vim: set filetype=sh : diff --git a/tests/01-rename/local.conf b/tests/01-rename/local.conf new file mode 100644 index 0000000..93497d9 --- /dev/null +++ b/tests/01-rename/local.conf @@ -0,0 +1,6 @@ +namespace inbox { + separator = . + location = maildir:~/inbox:LAYOUT=index + inbox = yes + list = yes +} diff --git a/tests/01-rename/remote.conf b/tests/01-rename/remote.conf new file mode 100644 index 0000000..cc6781d --- /dev/null +++ b/tests/01-rename/remote.conf @@ -0,0 +1,6 @@ +namespace inbox { + separator = ^ + location = maildir:~/inbox:LAYOUT=index + inbox = yes + list = yes +} diff --git a/tests/01-rename/run b/tests/01-rename/run new file mode 100644 index 0000000..6541c5c --- /dev/null +++ b/tests/01-rename/run @@ -0,0 +1,84 @@ +doveadm -u "local" mailbox create "root.from" "root.from.child" "root.from.child2" "root.from.child.grandchild" +doveadm -u "remote" mailbox create "root^sibbling" "root^sibbling^grandchild" "root2" + +for m in "root.from" "root.from.child" "root.from.child2" "root.from.child.grandchild" "INBOX"; do + sample_message | deliver -u "local" -- -m "$m" +done +for m in "root^sibbling" "root^sibbling^grandchild" "root2" "INBOX"; do + sample_message | deliver -u "remote" -- -m "$m" +done + +interimap +check_mailboxes_status "root.from" "root.from.child" "root.from.child2" "root.from.child.grandchild" \ + "root.sibbling" "root.sibbling.grandchild" "root2" "INBOX" +sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/mailboxes.csv" <<-EOF + .mode csv + SELECT idx, hex(mailbox) + FROM mailboxes + ORDER BY idx +EOF + +# renaming a non-existent mailbox doesn't yield an error +interimap --rename "nonexistent" "nonexistent2" +check_mailbox_list + +# renaming to an existing name yields an error +! interimap --rename "root2" "root" +xgrep -E "^local: ERROR: Couldn't rename mailbox root2: NO \[ALREADYEXISTS\] .*" <"$STDERR" + +# rename 'root.from' to 'from.root', including inferiors +interimap --rename "root.from" "from.root" +xgrep -Fx 'local: Renamed mailbox root.from to from.root' <"$STDERR" +xgrep -Fx 'remote: Renamed mailbox root^from to from^root' <"$STDERR" +xgrep -Fx 'database: Renamed mailbox root.from to from.root' <"$STDERR" + +check_mailbox_list +check_mailboxes_status "from.root" "from.root.child" "from.root.child2" "from.root.child.grandchild" \ + "root.sibbling" "root.sibbling.grandchild" "root2" "INBOX" + +before="$(printf "%s\\0%s" "root" "from" | xxd -u -ps)" +after="$(printf "%s\\0%s" "from" "root" | xxd -ps)" +sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/mailboxes2.csv" <<-EOF + .mode csv + SELECT idx, + CASE + WHEN mailbox = x'$after' OR hex(mailbox) LIKE '${after}00%' + THEN '$before' || SUBSTR(hex(mailbox), $((${#after}+1))) + ELSE hex(mailbox) + END + FROM mailboxes + ORDER BY idx +EOF +diff -u --label="a/mailboxes.csv" --label="b/mailboxes.csv" \ + "$TMPDIR/mailboxes.csv" "$TMPDIR/mailboxes2.csv" + + +# Try to rename \NonExistent root and check that its children move +interimap --rename "root" "newroot" +xgrep -Fq 'local: Renamed mailbox root to newroot' <"$STDERR" +xgrep -Fq 'remote: Renamed mailbox root to newroot' <"$STDERR" +xgrep -Fq 'database: Renamed mailbox root to newroot' <"$STDERR" + +check_mailbox_list +check_mailboxes_status "from.root" "from.root.child" "from.root.child2" "from.root.child.grandchild" \ + "newroot.sibbling" "newroot.sibbling.grandchild" "root2" "INBOX" + +before2="$(printf "%s" "root" | xxd -u -ps)" +after2="$(printf "%s" "newroot" | xxd -ps)" +sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/mailboxes3.csv" <<-EOF + .mode csv + SELECT idx, + CASE + WHEN mailbox = x'$after' OR hex(mailbox) LIKE '${after}00%' + THEN '$before' || SUBSTR(hex(mailbox), $((${#after}+1))) + WHEN hex(mailbox) LIKE '${after2}00%' + THEN '$before2' || SUBSTR(hex(mailbox), $((${#after2}+1))) + ELSE hex(mailbox) + END + FROM mailboxes + ORDER BY idx +EOF +diff -u --label="a/mailboxes.csv" --label="b/mailboxes.csv" \ + "$TMPDIR/mailboxes2.csv" "$TMPDIR/mailboxes3.csv" + +# vim: set filetype=sh : diff --git a/tests/02-delete/local.conf b/tests/02-delete/local.conf new file mode 100644 index 0000000..93497d9 --- /dev/null +++ b/tests/02-delete/local.conf @@ -0,0 +1,6 @@ +namespace inbox { + separator = . + location = maildir:~/inbox:LAYOUT=index + inbox = yes + list = yes +} diff --git a/tests/02-delete/remote.conf b/tests/02-delete/remote.conf new file mode 100644 index 0000000..cc6781d --- /dev/null +++ b/tests/02-delete/remote.conf @@ -0,0 +1,6 @@ +namespace inbox { + separator = ^ + location = maildir:~/inbox:LAYOUT=index + inbox = yes + list = yes +} diff --git a/tests/02-delete/run b/tests/02-delete/run new file mode 100644 index 0000000..f63c52c --- /dev/null +++ b/tests/02-delete/run @@ -0,0 +1,67 @@ +doveadm -u "local" mailbox create "foo.bar" "foo.bar.baz" + +for m in "foo.bar" "foo.bar.baz" "INBOX"; do + sample_message | deliver -u "local" -- -m "$m" +done + +interimap +check_mailbox_list +check_mailboxes_status "foo.bar" "foo.bar.baz" "INBOX" +sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/dump.sql" <<-EOF + .dump +EOF + +# delete non-existent mailbox is a no-op +interimap --target="local,remote" --target="database" --delete "nonexistent" + +check_mailbox_list +check_mailboxes_status "foo.bar" "foo.bar.baz" "INBOX" +sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/dump2.sql" <<-EOF + .dump +EOF +diff -u --label="a/dump.sql" --label="b/dump.sql" \ + "$TMPDIR/dump.sql" "$TMPDIR/dump2.sql" + +# foo.bar will become \NoSelect in local, per RFC 3501: "It is permitted +# to delete a name that has inferior hierarchical names and does not +# have the \Noselect mailbox name attribute. In this case, all messages +# in that mailbox are removed, and the name will acquire the \Noselect +# mailbox name attribute." +interimap --target="local" --delete "foo.bar" + +check_mailbox_list +check_mailboxes_status "foo.bar.baz" "INBOX" + +sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/dump2.sql" <<-EOF + .dump +EOF +diff -u --label="a/dump.sql" --label="b/dump.sql" "$TMPDIR/dump.sql" "$TMPDIR/dump2.sql" + +! doveadm -u "local" mailbox status uidvalidity "foo.bar" # gone + doveadm -u "remote" mailbox status uidvalidity "foo^bar" + +sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/mailboxes.csv" <<-EOF + SELECT idx, mailbox + FROM mailboxes + WHERE mailbox != x'$(printf "%s\\0%s" "foo" "bar" | xxd -ps)' +EOF + + +# now delete from the remote server and the database +interimap --delete "foo.bar" + +! doveadm -u "local" mailbox status uidvalidity "foo.bar" +! doveadm -u "remote" mailbox status uidvalidity "foo^bar" + +sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/mailboxes2.csv" <<-EOF + SELECT idx, mailbox + FROM mailboxes + WHERE mailbox != x'$(printf "%s\\0%s" "foo" "bar" | xxd -ps)' +EOF +diff -u --label="a/mailboxes.csv" --label="b/mailboxes.csv" \ + "$TMPDIR/mailboxes.csv" "$TMPDIR/mailboxes2.csv" + +check_mailbox_list +check_mailboxes_status "foo.bar.baz" "INBOX" + +# vim: set filetype=sh : diff --git a/tests/03-sync-mailbox-list-partial/interimap.conf b/tests/03-sync-mailbox-list-partial/interimap.conf new file mode 100644 index 0000000..4970867 --- /dev/null +++ b/tests/03-sync-mailbox-list-partial/interimap.conf @@ -0,0 +1 @@ +list-mailbox = * diff --git a/tests/03-sync-mailbox-list-partial/local.conf b/tests/03-sync-mailbox-list-partial/local.conf new file mode 100644 index 0000000..93497d9 --- /dev/null +++ b/tests/03-sync-mailbox-list-partial/local.conf @@ -0,0 +1,6 @@ +namespace inbox { + separator = . + location = maildir:~/inbox:LAYOUT=index + inbox = yes + list = yes +} diff --git a/tests/03-sync-mailbox-list-partial/remote.conf b/tests/03-sync-mailbox-list-partial/remote.conf new file mode 100644 index 0000000..352cdd4 --- /dev/null +++ b/tests/03-sync-mailbox-list-partial/remote.conf @@ -0,0 +1,6 @@ +namespace inbox { + separator = ~ + location = maildir:~/inbox:LAYOUT=index + inbox = yes + list = yes +} diff --git a/tests/03-sync-mailbox-list-partial/run b/tests/03-sync-mailbox-list-partial/run new file mode 100644 index 0000000..449115d --- /dev/null +++ b/tests/03-sync-mailbox-list-partial/run @@ -0,0 +1,57 @@ +# try a bunch of invalid 'list-mailbox' values: +# empty string, missing space between values, unterminated string +for v in '""' '"f o o""bar"' '"f o o" "bar" "baz\" x'; do + sed -ri "s/^(list-mailbox\\s*=\\s*).*/\\1${v//\\/\\\\}/" "$XDG_CONFIG_HOME/interimap/config" + ! interimap + xgrep -xF "Invalid value for list-mailbox: $v" <"$STDERR" +done + +# create some mailboxes +doveadm -u "local" mailbox create "foo" "foo bar" "f\\\"o!o.bar" "f.o.o" "bad" +for m in "foo" "foo bar" "f\\\"o!o.bar" "f.o.o" "bad" "INBOX"; do + sample_message | deliver -u "local" -- -m "$m" +done + +# restrict 'list-mailbox' to the above minus "bad" +sed -ri 's/^(list-mailbox\s*=\s*).*/\1foo "foo bar" "f\\\\\\"o\\x21o.*" "f\\0o\\0o"/' \ + "$XDG_CONFIG_HOME/interimap/config" + +# run partial sync +interimap +check_mailbox_list "foo" "foo bar" "f\\\"o!o.bar" "f.o.o" "INBOX" "f\\\"o!o" "f" "f.o" +check_mailboxes_status "foo" "foo bar" "f\\\"o!o.bar" "f.o.o" + +# check that "bad" isn't in the remote imap server +! doveadm -u "remote" mailbox status uidvalidity "bad" + +# check that "bad" and "INBOX" aren't in the database +sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/count" <<-EOF + SELECT COUNT(*) + FROM mailboxes + WHERE mailbox = x'$(printf "%s" "bad" | xxd -ps)' + OR mailbox = x'$(printf "%s" "INBOX" | xxd -ps)' +EOF +[ $(< "$TMPDIR/count") -eq 0 ] + + +# run partial sync +doveadm -u "remote" mailbox create "f\\\"o!o~baz" "f\\\"o!o~bad" +for m in "f\\\"o!o~baz" "f\\\"o!o~bad"; do + sample_message | deliver -u "remote" -- -m "$m" +done +interimap "f\\\"o!o.baz" + +check_mailbox_list "foo" "foo bar" "f\\\"o!o.bar" "f.o.o" "INBOX" "f\\\"o!o" "f" "f.o" "f\\\"o!o.baz" +check_mailboxes_status "foo" "foo bar" "f\\\"o!o.bar" "f.o.o" "f\\\"o!o.baz" + +# check that "bad", "f\\\"o!o.bad" and "INBOX" aren't in the database +sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/count" <<-EOF + SELECT COUNT(*) + FROM mailboxes + WHERE mailbox = x'$(printf "%s" "bad" | xxd -ps)' + OR mailbox = x'$(printf "%s" "INBOX" | xxd -ps)' + OR mailbox = x'$(printf "%s\\0%s" "f\\\"o!o" "bad" | xxd -ps)' +EOF +[ $(< "$TMPDIR/count") -eq 0 ] + +# vim: set filetype=sh : diff --git a/tests/03-sync-mailbox-list-ref/local.conf b/tests/03-sync-mailbox-list-ref/local.conf new file mode 100644 index 0000000..6eccf43 --- /dev/null +++ b/tests/03-sync-mailbox-list-ref/local.conf @@ -0,0 +1,6 @@ +namespace inbox { + separator = / + location = maildir:~/inbox:LAYOUT=index + inbox = yes + list = yes +} diff --git a/tests/03-sync-mailbox-list-ref/remote.conf b/tests/03-sync-mailbox-list-ref/remote.conf new file mode 100644 index 0000000..61e3d0d --- /dev/null +++ b/tests/03-sync-mailbox-list-ref/remote.conf @@ -0,0 +1,6 @@ +namespace inbox { + separator = "\\" + location = maildir:~/inbox:LAYOUT=index + inbox = yes + list = yes +} diff --git a/tests/03-sync-mailbox-list-ref/run b/tests/03-sync-mailbox-list-ref/run new file mode 100644 index 0000000..3ead25d --- /dev/null +++ b/tests/03-sync-mailbox-list-ref/run @@ -0,0 +1,28 @@ +# Note: implementation-dependent as the reference name is not a level of +# mailbox hierarchy nor ends with the hierarchy delimiter +sed -ri 's#^\[local\]$#&\nlist-reference = foo#; s#^\[remote\]$#&\nlist-reference = bar#' \ + "$XDG_CONFIG_HOME/interimap/config" + +# create a bunch of mailboxes in and out the respective list # references +doveadm -u "local" mailbox create "foo" "foobar" "foo/bar/baz" "foo/baz" "bar" +doveadm -u "remote" mailbox create "foo" + +# deliver somemessages to these mailboxes +for m in "foo" "foobar" "foo/bar/baz" "foo/baz" "bar"; do + sample_message | deliver -u "local" -- -m "$m" +done +sample_message | deliver -u "remote" -- -m "foo" + +interimap + +# check that the mailbox lists match +diff -u --label="local/mailboxes" --label="remote/mailboxes" \ + <( doveadm -u "local" mailbox list | sed -n "s/^foo//p" | sort ) \ + <( doveadm -u "remote" mailbox list | sed -n "s/^bar//p" | tr '\\' '/' | sort ) + +for m in "" "bar" "/bar/baz" "/baz"; do + blob="x'$(printf "%s" "$m" | tr "/" "\\0" | xxd -c256 -ps)'" + check_mailbox_status2 "$blob" "foo$m" "remote" "bar${m//\//\\}" +done + +# vim: set filetype=sh : diff --git a/tests/03-sync-mailbox-list/local.conf b/tests/03-sync-mailbox-list/local.conf new file mode 100644 index 0000000..93497d9 --- /dev/null +++ b/tests/03-sync-mailbox-list/local.conf @@ -0,0 +1,6 @@ +namespace inbox { + separator = . + location = maildir:~/inbox:LAYOUT=index + inbox = yes + list = yes +} diff --git a/tests/03-sync-mailbox-list/remote.conf b/tests/03-sync-mailbox-list/remote.conf new file mode 100644 index 0000000..352cdd4 --- /dev/null +++ b/tests/03-sync-mailbox-list/remote.conf @@ -0,0 +1,6 @@ +namespace inbox { + separator = ~ + location = maildir:~/inbox:LAYOUT=index + inbox = yes + list = yes +} diff --git a/tests/03-sync-mailbox-list/run b/tests/03-sync-mailbox-list/run new file mode 100644 index 0000000..e9fda06 --- /dev/null +++ b/tests/03-sync-mailbox-list/run @@ -0,0 +1,73 @@ +# pre-create some mailboxes and susbscribe to some +# foo: present on both, subscribed to both +# bar: present on both, subscribed to local only +# baz: present on both, subscribed to remote only +# foo.bar: present on local only +# foo.baz: present on remote only +doveadm -u "local" mailbox create "foo" "bar" "baz" "foo.bar" "fo!o [b*a%r]" +doveadm -u "local" mailbox subscribe "foo" "bar" +doveadm -u "remote" mailbox create "foo" "bar" "baz" "foo~baz" "foo]bar" +doveadm -u "remote" mailbox subscribe "foo" "baz" + +interimap +xgrep -Fx "local: Subscribe to baz" <"$STDERR" +xgrep -Fx "remote: Subscribe to bar" <"$STDERR" +xgrep -Fx "local: Created mailbox foo.baz" <"$STDERR" +xgrep -Fx "remote: Created mailbox foo~bar" <"$STDERR" + +# check syncing +check_mailbox_list +check_mailboxes_status "foo" "bar" "baz" "foo.bar" "foo.baz" "INBOX" "fo!o [b*a%r]" "foo]bar" +check_mailbox_list -s + + +# delete a mailbox one server and verify that synchronization fails as it's still in the database +doveadm -u "remote" mailbox delete "foo~baz" +! interimap +xgrep -Fx 'database: ERROR: Mailbox foo.baz exists. Run `interimap --target=database --delete foo.baz` to delete.' <"$STDERR" +interimap --target="database" --delete "foo.baz" +xgrep -Fx 'database: Removed mailbox foo.baz' <"$STDERR" +interimap # create again +xgrep -Fx 'database: Created mailbox foo.baz' <"$STDERR" +xgrep -Fx 'remote: Created mailbox foo~baz' <"$STDERR" + +doveadm -u "local" mailbox delete "foo.bar" +! interimap +xgrep -Fx 'database: ERROR: Mailbox foo.bar exists. Run `interimap --target=database --delete foo.bar` to delete.' <"$STDERR" +interimap --target="database" --delete "foo.bar" +xgrep -Fx 'database: Removed mailbox foo.bar' <"$STDERR" +interimap +xgrep -Fx 'database: Created mailbox foo.bar' <"$STDERR" +xgrep -Fx 'local: Created mailbox foo.bar' <"$STDERR" + +check_mailbox_list +check_mailboxes_status "foo" "bar" "baz" "foo.bar" "foo.baz" "INBOX" "fo!o [b*a%r]" "foo]bar" +check_mailbox_list -s + + +# (un)subscribe from some mailboxes, including a non-existent one +doveadm -u "local" mailbox unsubscribe "foo" +doveadm -u "remote" mailbox unsubscribe "bar" +doveadm -u "local" mailbox subscribe "foo.bar" "foo.nonexistent" "foo.baz" +doveadm -u "remote" mailbox subscribe "foo~bar" "bar~nonexistent" + +interimap +xgrep -Fx 'remote: Unsubscribe to foo' <"$STDERR" +xgrep -Fx 'local: Unsubscribe to bar' <"$STDERR" +xgrep -Fx 'remote: Subscribe to foo~baz' <"$STDERR" +check_mailbox_list +check_mailbox_list -s $(doveadm -u "local" mailbox list) # exclude "foo.nonexistent" and "bar~nonexistent" + +# check that "baz", "foo.bar" and "foo.baz" are the only subscribed mailboxes +sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/count" <<-EOF + SELECT COUNT(*) + FROM mailboxes + WHERE subscribed <> (mailbox IN ( + x'$(printf "%s" "baz" | xxd -ps)', + x'$(printf "%s\\0%s" "foo" "bar" | xxd -ps)', + x'$(printf "%s\\0%s" "foo" "baz" | xxd -ps)' + )) +EOF +[ $(< "$TMPDIR/count") -eq 0 ] + +# vim: set filetype=sh : diff --git a/tests/04-resume/local.conf b/tests/04-resume/local.conf new file mode 100644 index 0000000..93497d9 --- /dev/null +++ b/tests/04-resume/local.conf @@ -0,0 +1,6 @@ +namespace inbox { + separator = . + location = maildir:~/inbox:LAYOUT=index + inbox = yes + list = yes +} diff --git a/tests/04-resume/remote.conf b/tests/04-resume/remote.conf new file mode 100644 index 0000000..352cdd4 --- /dev/null +++ b/tests/04-resume/remote.conf @@ -0,0 +1,6 @@ +namespace inbox { + separator = ~ + location = maildir:~/inbox:LAYOUT=index + inbox = yes + list = yes +} diff --git a/tests/04-resume/run b/tests/04-resume/run new file mode 100644 index 0000000..22d66bc --- /dev/null +++ b/tests/04-resume/run @@ -0,0 +1,98 @@ +# create and populate a bunch of mailboxes +doveadm -u "local" mailbox create "foo" "foo.bar" "baz" +for ((i = 0; i < 8; i++)); do + sample_message | deliver -u "local" -- -m "foo" + sample_message | deliver -u "local" -- -m "foo.bar" + sample_message | deliver -u "local" -- -m "INBOX" +done +interimap +check_mailbox_list +check_mailboxes_status "foo" "foo.bar" "baz" "INBOX" + +# spoof UIDNEXT in the database +set_uidnext() { + local imap="$1" mailbox="$2" uidnext="$3" + sqlite3 "$XDG_DATA_HOME/interimap/remote.db" <<-EOF + UPDATE $imap + SET UIDNEXT = $uidnext + WHERE idx = ( + SELECT idx + FROM mailboxes + WHERE mailbox = x'$mailbox' + ); + EOF +} + +# spoof "foo"'s UIDVALIDITY and UIDNEXT values +uidvalidity="$(doveadm -u "local" -f flow mailbox status uidvalidity "foo" | sed 's/.*=//')" +[ $uidvalidity -eq 4294967295 ] && uidvalidity2=1 || uidvalidity2=$((uidvalidity+1)) +doveadm -u "local" mailbox update --uid-validity "$uidvalidity2" "foo" +set_uidnext "local" "$(printf "%s" "foo" | xxd -ps)" 1 + +# verify that interimap chokes on the UIDVALIDITY change without doing any changes +sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/dump.sql" <<-EOF + .dump +EOF +doveadm -u "local" mailbox status "all" "foo" >"$TMPDIR/foo.local" +doveadm -u "remote" mailbox status "all" "foo" >"$TMPDIR/foo.remote" + +! interimap +xgrep -Fx "Resuming interrupted sync for foo" <"$STDERR" +xgrep -Fx "local(foo): ERROR: UIDVALIDITY changed! ($uidvalidity2 != $uidvalidity) Need to invalidate the UID cache." <"$STDERR" + +sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/dump2.sql" <<-EOF + .dump +EOF +doveadm -u "local" mailbox status "all" "foo" >"$TMPDIR/foo.local2" +doveadm -u "remote" mailbox status "all" "foo" >"$TMPDIR/foo.remote2" + +diff -u --label="a/dump.sql" --label="b/dump.sql" "$TMPDIR/dump2.sql" "$TMPDIR/dump.sql" +diff -u --label="a/foo.local" --label="b/foo.remote" "$TMPDIR/foo.local" "$TMPDIR/foo.local2" +diff -u --label="a/foo.local" --label="b/foo.remote" "$TMPDIR/foo.remote" "$TMPDIR/foo.remote2" + + +# spoof UIDNEXT values for INBOX (local+remote) and foo.bar (remote) +set_uidnext "local" "$(printf "%s" "INBOX" | xxd -ps)" 2 +set_uidnext "remote" "$(printf "%s" "INBOX" | xxd -ps)" 2 +set_uidnext "remote" "$(printf "%s\\0%s" "foo" "bar" | xxd -ps)" 0 + +# set some flags and remove some messages for UIDs >2 +doveadm -u "local" flags add "\\Seen" mailbox "INBOX" 6,7 +doveadm -u "remote" flags add "\\Deleted" mailbox "INBOX" 6,8 + +doveadm -u "local" expunge mailbox "INBOX" 4,5 +doveadm -u "remote" expunge mailbox "INBOX" 3,4 +doveadm -u "remote" expunge mailbox "foo~bar" 5 + +# add new messages +sample_message | deliver -u "local" -- -m "foo.bar" +sample_message | deliver -u "remote" -- -m "foo~bar" +sample_message | deliver -u "local" -- -m "baz" + +interimap "foo.bar" "InBoX" "baz" # ignore "foo" +xgrep -Fx "Resuming interrupted sync for foo.bar" <"$STDERR" +xgrep -Fx "Resuming interrupted sync for INBOX" <"$STDERR" +check_mailbox_list +check_mailboxes_status "foo.bar" "INBOX" "baz" # ignore "foo" + + +# count entries in the mapping table +sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/count" <<-EOF + SELECT COUNT(*) + FROM mapping NATURAL JOIN mailboxes + WHERE mailbox != x'$(printf "%s" "foo" | xxd -ps)' + GROUP BY idx + ORDER BY mailbox; +EOF + +# count messages: +# INBOX: 8-2-1 = 5 +# baz: 1 +# foo.bar: 8-1+1+1 = 9 +diff -u --label="a/count" --label="b/count" "$TMPDIR/count" - <<-EOF + 5 + 1 + 9 +EOF + +# vim: set filetype=sh : diff --git a/tests/05-repair/local.conf b/tests/05-repair/local.conf new file mode 100644 index 0000000..93497d9 --- /dev/null +++ b/tests/05-repair/local.conf @@ -0,0 +1,6 @@ +namespace inbox { + separator = . + location = maildir:~/inbox:LAYOUT=index + inbox = yes + list = yes +} diff --git a/tests/05-repair/remote.conf b/tests/05-repair/remote.conf new file mode 100644 index 0000000..352cdd4 --- /dev/null +++ b/tests/05-repair/remote.conf @@ -0,0 +1,6 @@ +namespace inbox { + separator = ~ + location = maildir:~/inbox:LAYOUT=index + inbox = yes + list = yes +} diff --git a/tests/05-repair/run b/tests/05-repair/run new file mode 100644 index 0000000..747b974 --- /dev/null +++ b/tests/05-repair/run @@ -0,0 +1,107 @@ +# create some mailboxes and populate them +doveadm -u "local" mailbox create "foo.bar" +doveadm -u "remote" mailbox create "foo~bar" "baz" +for ((i = 0; i < 8; i++)); do + sample_message | deliver -u "local" -- -m "foo.bar" + sample_message | deliver -u "remote" -- -m "foo~bar" +done +for ((i = 0; i < 64; i++)); do + sample_message | deliver -u "remote" -- -m "baz" +done + +interimap +check_mailbox_list +check_mailboxes_status "foo.bar" "baz" "INBOX" + +# make more changes (flag updates, new massages, deletions) +sample_message | deliver -u "remote" -- -m "INBOX" +doveadm -u "local" expunge mailbox "baz" 1:10 +doveadm -u "remote" expunge mailbox "baz" "$(seq -s"," 1 2 32),$(seq -s"," 40 2 64)" +doveadm -u "local" expunge mailbox "foo.bar" 2,3,5:7,10 +doveadm -u "remote" expunge mailbox "foo~bar" 4,5,7,10 +doveadm -u "local" flags add "\\Answered" mailbox "foo.bar" 2,3,5:7,10 +doveadm -u "remote" flags add "\\Seen" mailbox "foo~bar" 4,5,7 + +# spoof HIGHESTMODSEQ value in the database, to make it look that we recorded the new changes already +spoof() { + local k="$1" v m hex="$(printf "%s\\0%s" "foo" "bar" | xxd -ps)" + shift + while [ $# -gt 0 ]; do + [ "$1" = "local" ] && m="foo.bar" || m="$(printf "%s" "foo.bar" | tr "." "~")" + v="$(doveadm -u "$1" -f flow mailbox status "${k,,[A-Z]}" "$m" | sed 's/.*=//')" + sqlite3 "$XDG_DATA_HOME/interimap/remote.db" <<-EOF + UPDATE \`$1\` SET $k = $v + WHERE idx = (SELECT idx FROM mailboxes WHERE mailbox = x'$hex'); + EOF + shift + done +} + +spoof HIGHESTMODSEQ "local" "remote" +sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/dump.sql" <<-EOF + .dump +EOF +doveadm -u "local" mailbox status "all" "foo.bar" >"$TMPDIR/foo-bar.status.local" +doveadm -u "remote" mailbox status "all" "foo~bar" >"$TMPDIR/foo-bar.status.remote" + + +# verify that without --repair interimap does nothing due to the spoofed HIGHESTMODSEQ values +interimap "foo.bar" + +sqlite3 "$XDG_DATA_HOME/interimap/remote.db" >"$TMPDIR/dump2.sql" <<-EOF + .dump +EOF +doveadm -u "local" mailbox status all "foo.bar" >"$TMPDIR/foo-bar.status2.local" +doveadm -u "remote" mailbox status all "foo~bar" >"$TMPDIR/foo-bar.status2.remote" +diff -u --label="a/dump.sql" --label="b/dump.sql" "$TMPDIR/dump.sql" "$TMPDIR/dump2.sql" +diff -u --label="a/foo_bar.local" --label="a/foo_bar.local" "$TMPDIR/foo-bar.status.local" "$TMPDIR/foo-bar.status2.local" +diff -u --label="a/foo_bar.remote" --label="a/foo_bar.remote" "$TMPDIR/foo-bar.status.remote" "$TMPDIR/foo-bar.status2.remote" + + +# deliver more messages and spoof UIDNEXT, on one side only +sample_message | deliver -u "local" -- -m "foo.bar" +sample_message | deliver -u "remote" -- -m "foo~bar" +spoof UIDNEXT "local" +spoof HIGHESTMODSEQ "local" "remote" + +# now repair +interimap --repair "baz" "foo.bar" + +# 6 updates with \Answered (luid 4,8,11:13,16), 2 of which (luid 12,13) vanished from remote +# 3 updates with \Seen (ruid 6,8,10), 1 of which (uid 10) vanished from remote +# luid 16 <-> ruid 8 has both \Answered and \Seen +xcgrep 5 '^WARNING: Missed flag update in foo\.bar for ' <"$STDERR" +xcgrep 5 '^WARNING: Conflicting flag update in foo\.bar ' <"$STDERR" + +# luid 2 <-> ruid 10 +xcgrep 1 -E '^WARNING: Pair \(lUID,rUID\) = \([0-9]+,[0-9]+\) vanished from foo\.bar\. Repairing\.$' <"$STDERR" + +# 6-1 (luid 2 <-> ruid 10 is gone from both) +xcgrep 5 -E '^local\(foo\.bar\): WARNING: UID [0-9]+ disappeared\. Downloading remote UID [0-9]+ again\.$' <"$STDERR" + +# 6-1 (luid 2 <-> ruid 10 is gone from both) +xcgrep 3 -E '^remote\(foo~bar\): WARNING: UID [0-9]+ disappeared\. Downloading local UID [0-9]+ again\.$' <"$STDERR" + +xgrep -E '^local\(baz\): Removed 24 UID\(s\) ' <"$STDERR" +xgrep -E '^remote\(baz\): Removed 5 UID\(s\) ' <"$STDERR" + +# pining UIDs here is not very robust... +xgrep -E '^local\(foo\.bar\): Updated flags \(\\Answered \\Seen\) for UID 16$' <"$STDERR" +xgrep -E '^local\(foo\.bar\): Updated flags \(\\Seen\) for UID 14$' <"$STDERR" +xgrep -E '^remote\(foo~bar\): Updated flags \(\\Answered \\Seen\) for UID 8$' <"$STDERR" +xgrep -E '^remote\(foo~bar\): Updated flags \(\\Answered\) for UID 3,12,16$' <"$STDERR" + +# luid 17 +xcgrep 1 -E '^remote\(foo~bar\): WARNING: No match for modified local UID [0-9]+\. Downloading again\.' <"$STDERR" + +xgrep -E '^local\(foo\.bar\): Added 5 UID\(s\) ' <"$STDERR" +xgrep -E '^remote\(foo~bar\): Added 4 UID\(s\) ' <"$STDERR" +xgrep -E '^local\(foo\.bar\): Added 1 UID\(s\) ' <"$STDERR" # the new message + +check_mailbox_list +check_mailboxes_status "baz" "foo.bar" + +interimap +check_mailboxes_status "baz" "foo.bar" "INBOX" + +# vim: set filetype=sh : diff --git a/tests/06-largeint/local.conf b/tests/06-largeint/local.conf new file mode 100644 index 0000000..9c838fd --- /dev/null +++ b/tests/06-largeint/local.conf @@ -0,0 +1,5 @@ +namespace inbox { + location = maildir:~/inbox:LAYOUT=index + inbox = yes + list = yes +} diff --git a/tests/06-largeint/remote.conf b/tests/06-largeint/remote.conf new file mode 100644 index 0000000..9c838fd --- /dev/null +++ b/tests/06-largeint/remote.conf @@ -0,0 +1,5 @@ +namespace inbox { + location = maildir:~/inbox:LAYOUT=index + inbox = yes + list = yes +} diff --git a/tests/06-largeint/run b/tests/06-largeint/run new file mode 100644 index 0000000..edcbd31 --- /dev/null +++ b/tests/06-largeint/run @@ -0,0 +1,38 @@ +doveadm -u "local" mailbox create "foo" "bar" "baz" +doveadm -u "remote" mailbox create "foo" "bar" "baz" + +doveadm -u "local" mailbox update --uid-validity 1 "INBOX" +doveadm -u "local" mailbox update --uid-validity 2147483647 "foo" # 2^31-1 +doveadm -u "local" mailbox update --uid-validity 2147483648 "bar" # 2^31 +doveadm -u "local" mailbox update --uid-validity 4294967295 "baz" # 2^32-1 + +doveadm -u "remote" mailbox update --uid-validity 4294967295 "INBOX" # 2^32-1 +doveadm -u "remote" mailbox update --uid-validity 2147483648 "foo" # 2^31 +doveadm -u "remote" mailbox update --uid-validity 2147483647 "bar" # 2^31-1 +doveadm -u "remote" mailbox update --uid-validity 1 "baz" # + +run() { + local u m + for u in local remote; do + for m in "INBOX" "foo" "bar" "baz"; do + sample_message | deliver -u "$u" -- -m "$m" + done + done + interimap + check_mailbox_status "INBOX" "foo" "bar" "baz" +} +run + +# raise UIDNEXT AND HIGHESTMODSEQ close to the max values (resp. 2^32-1 och 2^63-1) +doveadm -u "local" mailbox update --min-next-uid 2147483647 --min-highest-modseq 9223372036854775807 "INBOX" # 2^31-1, 2^63-1 +doveadm -u "local" mailbox update --min-next-uid 2147483647 --min-highest-modseq 9223372036854775807 "foo" # 2^31-1, 2^63-1 +doveadm -u "local" mailbox update --min-next-uid 2147483648 --min-highest-modseq 9223372036854775808 "bar" # 2^31, 2^63 +doveadm -u "local" mailbox update --min-next-uid 2147483648 --min-highest-modseq 9223372036854775808 "baz" # 2^31, 2^63 + +doveadm -u "remote" mailbox update --min-next-uid 4294967168 --min-highest-modseq 18446744073709551488 "INBOX" # 2^32-128, 2^64-128 +doveadm -u "remote" mailbox update --min-next-uid 2147483776 --min-highest-modseq 9223372036854775936 "foo" # 2^31+128, 2^63+128 +doveadm -u "remote" mailbox update --min-next-uid 2147483648 --min-highest-modseq 9223372036854775808 "bar" # 2^31, 2^63 + +run + +# vim: set filetype=sh : diff --git a/tests/07-sync-live-multi/local.conf b/tests/07-sync-live-multi/local.conf new file mode 100644 index 0000000..baae39d --- /dev/null +++ b/tests/07-sync-live-multi/local.conf @@ -0,0 +1,30 @@ +namespace inbox { + separator = / + location = dbox:~/inbox:LAYOUT=index + inbox = yes + list = yes +} + +namespace foo { + separator = / + prefix = foo/ + location = dbox:~/foo:LAYOUT=index + inbox = no + list = yes +} + +namespace bar { + separator = / + prefix = bar/ + location = dbox:~/bar:LAYOUT=index + inbox = no + list = yes +} + +namespace baz { + separator = / + prefix = baz/ + location = dbox:~/baz:LAYOUT=index + inbox = no + list = yes +} diff --git a/tests/07-sync-live-multi/remote.conf b/tests/07-sync-live-multi/remote.conf new file mode 100644 index 0000000..3267182 --- /dev/null +++ b/tests/07-sync-live-multi/remote.conf @@ -0,0 +1,6 @@ +namespace inbox { + separator = ^ + location = dbox:~/inbox:LAYOUT=index + inbox = yes + list = yes +} diff --git a/tests/07-sync-live-multi/remote2.conf b/tests/07-sync-live-multi/remote2.conf new file mode 100644 index 0000000..062429e --- /dev/null +++ b/tests/07-sync-live-multi/remote2.conf @@ -0,0 +1,6 @@ +namespace inbox { + separator = "\\" + location = dbox:~/inbox:LAYOUT=index + inbox = yes + list = yes +} diff --git a/tests/07-sync-live-multi/remote3.conf b/tests/07-sync-live-multi/remote3.conf new file mode 100644 index 0000000..a4b9b1c --- /dev/null +++ b/tests/07-sync-live-multi/remote3.conf @@ -0,0 +1,6 @@ +namespace inbox { + separator = "?" + location = dbox:~/inbox:LAYOUT=index + inbox = yes + list = yes +} diff --git a/tests/07-sync-live-multi/run b/tests/07-sync-live-multi/run new file mode 100644 index 0000000..bf0d2f5 --- /dev/null +++ b/tests/07-sync-live-multi/run @@ -0,0 +1,138 @@ +# add references to each interimap instance +sed -ri 's#^\[local\]$#&\nlist-reference = foo/#' "$XDG_CONFIG_HOME/interimap/config" +sed -ri 's#^\[local\]$#&\nlist-reference = bar/#' "$XDG_CONFIG_HOME/interimap/config2" +sed -ri 's#^\[local\]$#&\nlist-reference = baz/#' "$XDG_CONFIG_HOME/interimap/config3" + +# create databases +interimap --config="config" +interimap --config="config2" +interimap --config="config3" + +# start long-lived interimap processes +interimap --config="config" --watch=1 & pid=$! +interimap --config="config2" --watch=1 & pid2=$! +interimap --config="config3" --watch=1 & pid3=$! + +abort() { + # kill interimap process and its children + pkill -P "$pid" -TERM + kill -TERM "$pid" + pkill -P "$pid2" -TERM + kill -TERM "$pid2" + pkill -P "$pid3" -TERM + kill -TERM "$pid3" + wait +} +trap abort EXIT INT TERM + + +# mailbox list (as seen on local) and alphabet +declare -a mailboxes=( "INBOX" ) alphabet=() +str="#+-0123456789@ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz" +for ((i=0; i < ${#str}; i++)); do + alphabet[i]="${str:i:1}" +done + +declare -a targets=( "local" "remote" "remote2" "remote3" ) + +timer=$(( $(date +%s) + 30 )) +while [ $(date +%s) -le $timer ]; do + # create new mailbox with 10% probability + if [ $(shuf -n1 -i0-9) -eq 0 ]; then + u="$(shuf -n1 -e -- "${targets[@]}")" # choose target at random + case "$u" in + local) ns="$(shuf -n1 -e "foo/" "bar/" "baz/")";; + remote) ns="foo/";; + remote2) ns="bar/";; + remote3) ns="baz/";; + *) echo "Uh?" >&2; exit 1;; + esac + + m= + d=$(shuf -n1 -i1-3) # random depth + for (( i=0; i < d; i++)); do + l=$(shuf -n1 -i1-16) + m="${m:+$m/}$(shuf -n "$l" -e -- "${alphabet[@]}" | tr -d '\n')" + done + mailboxes+=( "$ns$m" ) + case "$u" in + local) m="$ns$m";; + remote) m="${m//\//^}";; + remote2) m="${m//\//\\}";; + remote3) m="${m//\//\?}";; + *) echo "Uh?" >&2; exit 1;; + esac + doveadm -u "$u" mailbox create -- "$m" + fi + + # EXPUNGE some messages + u="$(shuf -n1 -e -- "${targets[@]}")" # choose target at random + n="$(shuf -n1 -i0-3)" + while read guid uid; do + doveadm -u "$u" expunge mailbox-guid "$guid" uid "$uid" + done < <(doveadm -u "$u" search all | shuf -n "$n") + + # mark some existing messages as read (toggle \Seen flag as unlike other + # flags it's easier to query and check_mailboxes_status checks it) + u="$(shuf -n1 -e -- "${targets[@]}")" # choose target at random + n="$(shuf -n1 -i0-9)" + while read guid uid; do + a="$(shuf -n1 -e add remove replace)" + doveadm -u "$u" flags "$a" "\\Seen" mailbox-guid "$guid" uid "$uid" + done < <(doveadm -u "$u" search all | shuf -n "$n") + + # select at random a mailbox where to deliver some messages + u="$(shuf -n1 -e "local" "remote")" # choose target at random + m="$(shuf -n1 -e -- "${mailboxes[@]}")" + if [ "$u" = "remote" ]; then + case "$m" in + foo/*) u="remote"; m="${m#foo/}"; m="${m//\//^}";; + bar/*) u="remote2"; m="${m#bar/}"; m="${m//\//\\}";; + baz/*) u="remote3"; m="${m#baz/}"; m="${m//\//\?}";; + INBOX) u="$(shuf -n1 -e "remote" "remote2" "remote3")";; + *) echo "Uh? $m" >&2; exit 1;; + esac + fi + + # deliver between 1 and 5 messages to the chosen mailbox + n="$(shuf -n1 -i1-5)" + for (( i=0; i < n; i++)); do + sample_message | deliver -u "$u" -- -m "$m" + done + + # sleep a little bit + sleep "0.$(shuf -n1 -i1-99)" +done + +# wait a little longer so interimap has time to run loop() again and +# synchronize outstanding changes, then terminate the processes we +# started above +sleep 2 + +abort +trap - EXIT INT TERM + +# check that the mailbox lists match +diff -u --label="local/mailboxes" --label="remote/mailboxes" \ + <( doveadm -u "local" mailbox list | sed -n "s,^foo/,,p" | sort ) \ + <( doveadm -u "remote" mailbox list | tr '^' '/' | sort ) +diff -u --label="local/mailboxes" --label="remote2/mailboxes" \ + <( doveadm -u "local" mailbox list | sed -n "s,^bar/,,p" | sort ) \ + <( doveadm -u "remote2" mailbox list | tr '\\' '/' | sort ) +diff -u --label="local/mailboxes" --label="remote3/mailboxes" \ + <( doveadm -u "local" mailbox list | sed -n "s,^baz/,,p" | sort ) \ + <( doveadm -u "remote3" mailbox list | tr '?' '/' | sort ) + +for m in "${mailboxes[@]}"; do + case "$m" in + foo/*) u="remote"; mb="${m#foo/}"; mr="${mb//\//^}";; + bar/*) u="remote2"; mb="${m#bar/}"; mr="${mb//\//\\}";; + baz/*) u="remote3"; mb="${m#baz/}"; mr="${mb//\//\?}";; + INBOX) continue;; + *) echo "Uh? $m" >&2; exit 1;; + esac + blob="x'$(printf "%s" "$mb" | tr "/" "\\0" | xxd -c256 -ps)'" + check_mailbox_status2 "$blob" "$m" "$u" "$mr" +done + +# vim: set filetype=sh : diff --git a/tests/07-sync-live/local.conf b/tests/07-sync-live/local.conf new file mode 100644 index 0000000..1333540 --- /dev/null +++ b/tests/07-sync-live/local.conf @@ -0,0 +1,6 @@ +namespace inbox { + separator = . + location = dbox:~/inbox:LAYOUT=index + inbox = yes + list = yes +} diff --git a/tests/07-sync-live/remote.conf b/tests/07-sync-live/remote.conf new file mode 100644 index 0000000..3267182 --- /dev/null +++ b/tests/07-sync-live/remote.conf @@ -0,0 +1,6 @@ +namespace inbox { + separator = ^ + location = dbox:~/inbox:LAYOUT=index + inbox = yes + list = yes +} diff --git a/tests/07-sync-live/run b/tests/07-sync-live/run new file mode 100644 index 0000000..1950e0b --- /dev/null +++ b/tests/07-sync-live/run @@ -0,0 +1,80 @@ +# create database +interimap + +# start a long-lived interimap process +interimap --watch=1 & pid=$! + +abort() { + # kill interimap process and its children + pkill -P "$pid" -TERM + kill -TERM "$pid" + wait +} +trap abort EXIT INT TERM + +# mailbox list and alphabet (exclude &, / and ~, which dovecot treats specially) +declare -a mailboxes=( "INBOX" ) alphabet=() +str="!\"#\$'()+,-0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ\[\\\]_\`abcdefghijklmnopqrstuvwxyz{|}" +for ((i=0; i < ${#str}; i++)); do + alphabet[i]="${str:i:1}" +done + +timer=$(( $(date +%s) + 30 )) +while [ $(date +%s) -le $timer ]; do + # create new mailbox with 10% probability + if [ $(shuf -n1 -i0-9) -eq 0 ]; then + m= + d=$(shuf -n1 -i1-3) # random depth + for (( i=0; i < d; i++)); do + l=$(shuf -n1 -i1-16) + m="${m:+$m.}$(shuf -n "$l" -e -- "${alphabet[@]}" | tr -d '\n')" + done + mailboxes+=( "$m" ) + u="$(shuf -n1 -e "local" "remote")" # choose target at random + [ "$u" = "local" ] || m="${m//./^}" + doveadm -u "$u" mailbox create -- "$m" + fi + + # EXPUNGE some messages + u="$(shuf -n1 -e "local" "remote")" # choose target at random + n="$(shuf -n1 -i0-3)" + while read guid uid; do + doveadm -u "$u" expunge mailbox-guid "$guid" uid "$uid" + done < <(doveadm -u "$u" search all | shuf -n "$n") + + # mark some existing messages as read (toggle \Seen flag as unlike other + # flags it's easier to query and check_mailboxes_status checks it) + u="$(shuf -n1 -e "local" "remote")" # choose target at random + n="$(shuf -n1 -i0-9)" + while read guid uid; do + a="$(shuf -n1 -e add remove replace)" + doveadm -u "$u" flags "$a" "\\Seen" mailbox-guid "$guid" uid "$uid" + done < <(doveadm -u "$u" search all | shuf -n "$n") + + # select at random a mailbox where to deliver some messages + u="$(shuf -n1 -e "local" "remote")" # choose target at random + m="$(shuf -n1 -e -- "${mailboxes[@]}")" + [ "$u" = "local" ] || m="${m//./^}" + + # deliver between 1 and 5 messages to the chosen mailbox + n="$(shuf -n1 -i1-5)" + for (( i=0; i < n; i++)); do + sample_message | deliver -u "$u" -- -m "$m" + done + + # sleep a little bit + sleep "0.$(shuf -n1 -i1-99)" +done + +# wait a little longer so interimap has time to run loop() again and +# synchronize outstanding changes, then terminate the process we started +# above +sleep 2 + +abort +trap - EXIT INT TERM + +check_mailbox_list +check_mailboxes_status "${mailboxes[@]}" + +# vim: set filetype=sh : diff --git a/tests/run b/tests/run new file mode 100755 index 0000000..31af03e --- /dev/null +++ b/tests/run @@ -0,0 +1,336 @@ +#!/bin/bash + +#---------------------------------------------------------------------- +# Test suite for InterIMAP +# Copyright © 2019 Guilhem Moulin +# +# This program is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . +#---------------------------------------------------------------------- + +set -ue +PATH=/usr/bin:/bin +export PATH + +if [ $# -ne 1 ]; then + printf "Usage: %s TESTNAME\\n" "$0" >&2 + exit 1 +fi + +TEST="${1%/}" +TEST="${TEST##*/}" +NAME="${TEST#[0-9]*-}" +TESTDIR="$(dirname -- "$0")/$TEST" +if [ ! -d "$TESTDIR" ]; then + printf "ERROR: Not a directory: %s\\n" "$TESTDIR" >&2 + exit 1 +fi + +ROOTDIR="$(mktemp --tmpdir=/dev/shm --directory "$NAME.XXXXXXXXXX")" +trap 'rm -rf -- "$ROOTDIR"' EXIT INT TERM + +STDOUT="$ROOTDIR/stdout" +STDERR="$ROOTDIR/stderr" +TMPDIR="$ROOTDIR/tmp" +mkdir -- "$TMPDIR" "$ROOTDIR/home" + +# Set environment for the given user +environ_set() { + local user="$1" home + eval home="\$HOME_$user" + ENVIRON=( + PATH="$PATH" + USER="$user" + HOME="$home" + XDG_CONFIG_HOME="$home/.config" + XDG_DATA_HOME="$home/.local/share" + ) +} + +# Prepare the test harness +prepare() { + declare -a ENVIRON=() + local src cfg target u home + # copy dovecot config + for src in "$TESTDIR/local.conf" "$TESTDIR"/remote*.conf; do + [ -r "$src" ] || continue + u="${src#"$TESTDIR/"}" + u="${u%.conf}" + home="$ROOTDIR/home/$u" + export "HOME_$u"="$home" + mkdir -pm0755 -- "$home/.local/bin" + mkdir -pm0700 -- "$home/.config/dovecot" + cat >"$home/.config/dovecot/config" <<-EOF + log_path = /dev/null + mail_home = $ROOTDIR/home/%u + ssl = no + EOF + cat >>"$home/.config/dovecot/config" <"$src" + environ_set "$u" + cat >"$home/.local/bin/doveadm" <<-EOF + #!/bin/sh + exec env -i ${ENVIRON[@]@Q} \\ + doveadm -c ${home@Q}/.config/dovecot/config "\$@" + EOF + chmod +x -- "$home/.local/bin/doveadm" + done + + # copy interimap config + mkdir -pm0700 -- "$HOME_local/.local/share/interimap" + mkdir -pm0700 -- "$HOME_local/.config/interimap" + for cfg in "$TESTDIR"/remote*.conf; do + cfg="${cfg#"$TESTDIR/remote"}" + cfg="${cfg%.conf}" + u="remote$cfg" + eval home="\$HOME_$u" + if [ -f "$TESTDIR/interimap.conf" ]; then + cat <"$TESTDIR/interimap.conf" >>"$HOME_local/.config/interimap/config$cfg" + fi + cat >>"$HOME_local/.config/interimap/config$cfg" <<-EOF + database = $u.db + + [local] + type = tunnel + command = exec ${HOME_local@Q}/.local/bin/doveadm exec imap + null-stderr = YES + + [remote] + type = tunnel + command = exec ${home@Q}/.local/bin/doveadm exec imap + null-stderr = YES + EOF + done +} +prepare + +# Wrappers for interimap(1) and doveadm(1) +interimap() { + declare -a ENVIRON=() + environ_set "local" + env -i "${ENVIRON[@]}" perl -I./lib -T ./interimap "$@" +} +doveadm() { + if [ $# -le 2 ] || [ "$1" != "-u" ]; then + echo "Usage: doveadm -u USER ..." >&2 + exit 1 + fi + local u="$2" home + eval home="\$HOME_$u" + shift 2 + "$home/.local/bin/doveadm" "$@" +} + +# Sample (random) message +sample_message() { + cat <<-EOF + From: + To: + Date: $(date -R) + Message-ID: <$(< /proc/sys/kernel/random/uuid)@example.net> + + EOF + local len="$(shuf -i1-4096 -n1)" + xxd -ps -c30 -l"$len" /dev/urandom # 3 to 8329 bytes +} + +# Wrapper for dovecot-lda(1) +deliver() { + local -a argv + while [ $# -gt 0 ] && [ "$1" != "--" ]; do + argv+=( "$1" ) + shift + done + if [ $# -gt 0 ] && [ "$1" = "--" ]; then + shift + fi + doveadm "${argv[@]}" exec dovecot-lda -e "$@" +} + +# Dump test results +dump_test_result() { + local below=">>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>" + local above="<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<" + local src u home + declare -a ENVIRON=() + for src in "$TESTDIR/local.conf" "$TESTDIR"/remote*.conf; do + u="${src#"$TESTDIR/"}" + u="${u%.conf}" + environ_set "$u" + eval home="\$HOME_$u" + printf "%s dovecot configuration:\\n%s\\n" "$u" "$below" + env -i "${ENVIRON[@]}" doveconf -c "$home/.config/dovecot/config" -n + printf "%s\\n\\n" "$above" + done + + printf "(local) interimap configuration:\\n%s\\n" "$below" + cat <"$HOME_local/.config/interimap/config" + printf "%s\\n\\n" "$above" + + printf "standard output was:\\n%s\\n" "$below" + cat <"$STDOUT" + printf "%s\\n\\n" "$above" + + printf "standard error was:\\n%s\\n" "$below" + cat <"$STDERR" + printf "%s\\n\\n" "$above" +} + +# Check mailbox consistency between the local/remote server and interimap's database +check_mailbox_status() { + local mailbox="$1" lns="inbox" lsep lprefix rns="inbox" rsep rprefix + lsep="$(doveconf -c "$HOME_local/.config/dovecot/config" -h "namespace/$lns/separator")" + lprefix="$(doveconf -c "$HOME_local/.config/dovecot/config" -h "namespace/$lns/prefix")" + rsep="$(doveconf -c "$HOME_remote/.config/dovecot/config" -h "namespace/$lns/separator")" + rprefix="$(doveconf -c "$HOME_remote/.config/dovecot/config" -h "namespace/$lns/prefix")" + + local blob="x'$(printf "%s" "$mailbox" | tr "$lsep" "\\0" | xxd -c256 -ps)'" + local rmailbox="$(printf "%s" "$mailbox" | tr "$lsep" "$rsep")" + check_mailbox_status2 "$blob" "$lprefix$mailbox" "remote" "$rprefix$rmailbox" +} +check_mailbox_status2() { + local blob="$1" lmailbox="$2" u="$3" rmailbox="$4" + local lUIDVALIDITY lUIDNEXT lHIGHESTMODSEQ rUIDVALIDITY rUIDNEXT rHIGHESTMODSEQ + read lUIDVALIDITY lUIDNEXT lHIGHESTMODSEQ rUIDVALIDITY rUIDNEXT rHIGHESTMODSEQ < <( + sqlite3 "$XDG_DATA_HOME/interimap/$u.db" <<-EOF + .mode csv + .separator " " "\\n" + SELECT l.UIDVALIDITY, l.UIDNEXT, l.HIGHESTMODSEQ, r.UIDVALIDITY, r.UIDNEXT, r.HIGHESTMODSEQ + FROM mailboxes m JOIN local l ON m.idx = l.idx JOIN remote r ON m.idx = r.idx + WHERE mailbox = $blob + EOF + ) + lHIGHESTMODSEQ="$(printf "%llu" "$lHIGHESTMODSEQ")" + rHIGHESTMODSEQ="$(printf "%llu" "$rHIGHESTMODSEQ")" + local MESSAGES + read MESSAGES < <( sqlite3 "$XDG_DATA_HOME/interimap/$u.db" <<-EOF + .mode csv + .separator " " "\\n" + SELECT COUNT(*) + FROM mailboxes a JOIN mapping b ON a.idx = b.idx + WHERE mailbox = $blob + EOF + ) + check_mailbox_status_values "local" "$lmailbox" $lUIDVALIDITY $lUIDNEXT $lHIGHESTMODSEQ $MESSAGES + check_mailbox_status_values "$u" "$rmailbox" $rUIDVALIDITY $rUIDNEXT $rHIGHESTMODSEQ $MESSAGES + + local a b + a="$(doveadm -u "local" -f "flow" mailbox status "messages unseen vsize" -- "$lmailbox" | \ + sed -nr '/.*\s+(\w+=[0-9]+\s+\w+=[0-9]+\s+\w+=[0-9]+)$/ {s//\1/p;q}')" + b="$(doveadm -u "$u" -f "flow" mailbox status "messages unseen vsize" -- "$rmailbox" | \ + sed -nr '/.*\s+(\w+=[0-9]+\s+\w+=[0-9]+\s+\w+=[0-9]+)$/ {s//\1/p;q}')" + if [ "$a" != "$b" ]; then + echo "Mailbox $lmailbox status differs: \"$a\" != \"$b\"" >&2 + exit 1 + fi +} +check_mailbox_status_values() { + local user="$1" mailbox="$2" UIDVALIDITY="$3" UIDNEXT="$4" HIGHESTMODSEQ="$5" MESSAGES="$6" x xs v k + xs="$(doveadm -u "$user" -f "flow" mailbox status "uidvalidity uidnext highestmodseq messages" -- "$mailbox" | \ + sed -nr '/.*\s+(\w+=[0-9]+\s+\w+=[0-9]+\s+\w+=[0-9]+\s+\w+=[0-9]+)$/ {s//\1/p;q}')" + [ -n "$xs" ] || exit 1 + for x in $xs; do + k="${x%%=*}" + case "${k^^[a-z]}" in + UIDVALIDITY) v="$UIDVALIDITY";; + UIDNEXT) v="$UIDNEXT";; + HIGHESTMODSEQ) v="$HIGHESTMODSEQ";; + MESSAGES) v="$MESSAGES";; + *) echo "Uh? $x" >&2; exit 1 + esac + if [ "${x#*=}" != "$v" ]; then + echo "$user($mailbox): ${k^^[a-z]} doesn't match! ${x#*=} != $v" >&2 + exit 1 + fi + done +} +check_mailboxes_status() { + local mailbox + for mailbox in "$@"; do + check_mailbox_status "$mailbox" + done +} + +# Check mailbox list constency between the local and remote servers +check_mailbox_list() { + local m i lns="inbox" lsep lprefix rns="inbox" rsep rprefix sub= + lsep="$(doveconf -c "$HOME_local/.config/dovecot/config" -h "namespace/$lns/separator")" + lprefix="$(doveconf -c "$HOME_local/.config/dovecot/config" -h "namespace/$lns/prefix")" + rsep="$(doveconf -c "$HOME_remote/.config/dovecot/config" -h "namespace/$lns/separator")" + rprefix="$(doveconf -c "$HOME_remote/.config/dovecot/config" -h "namespace/$lns/prefix")" + if [ $# -gt 0 ] && [ "$1" = "-s" ]; then + sub="-s" + shift + fi + + declare -a lmailboxes=() rmailboxes=() + if [ $# -eq 0 ]; then + lmailboxes=( "${lprefix}*" ) + rmailboxes=( "${rprefix}*" ) + else + for m in "$@"; do + lmailboxes+=( "$lprefix$m" ) + rmailboxes+=( "$rprefix${m//"$lsep"/"$rsep"}" ) + done + fi + + mapfile -t lmailboxes < <( doveadm -u "local" mailbox list $sub -- "${lmailboxes[@]}" ) + for ((i = 0; i < ${#lmailboxes[@]}; i++)); do + lmailboxes[i]="${lmailboxes[i]#"$lprefix"}" + done + + mapfile -t rmailboxes < <( doveadm -u "remote" mailbox list $sub -- "${rmailboxes[@]}" ) + for ((i = 0; i < ${#rmailboxes[@]}; i++)); do + rmailboxes[i]="${rmailboxes[i]#"$rprefix"}" + rmailboxes[i]="${rmailboxes[i]//"$rsep"/"$lsep"}" + done + + local IFS=$'\n' + diff -u --label="local/mailboxes" --label="remote/mailboxes" \ + <( printf "%s" "${lmailboxes[*]}" | sort ) <( printf "%s" "${rmailboxes[*]}" | sort ) +} + +# Wrappers for grep(1) and `grep -C` +xgrep() { + if ! grep -q "$@"; then + printf "\`grep %s\` failed on line %d\\n" "${*@Q}" ${BASH_LINENO[0]} >&2 + exit 1 + fi +} +xcgrep() { + local m="$1" n + shift + if ! n="$(grep -c "$@")" || [ $m -ne $n ]; then + printf "\`grep -c %s\` failed on line %d: %d != %d\\n" "${*@Q}" ${BASH_LINENO[0]} "$m" "$n" >&2 + exit 1 + fi +} + +# Run test in a sub-shell +declare -a ENVIRON=() +environ_set "local" +export TMPDIR TESTDIR STDOUT STDERR "${ENVIRON[@]}" +export -f environ_set doveadm interimap sample_message deliver +export -f check_mailbox_status check_mailbox_status_values check_mailbox_status2 +export -f check_mailboxes_status check_mailbox_list xgrep xcgrep +printf "%s..." "$TEST" +if ! bash -ue "$TESTDIR/run" >"$STDOUT" 2>"$STDERR"; then + echo " FAILED" + dump_test_result + exit 1 +else + echo " OK" + if grep -Paq "\\x00" -- "$STDOUT" "$STDERR"; then + printf "\\tWarn: binary output (outstanding \\0)!\\n" + fi + exit 0 +fi -- cgit v1.2.3