aboutsummaryrefslogtreecommitdiffstats
path: root/interimap
diff options
context:
space:
mode:
authorGuilhem Moulin <guilhem@fripost.org>2019-05-16 01:13:31 +0200
committerGuilhem Moulin <guilhem@fripost.org>2019-05-27 00:07:30 +0200
commit646300f60aaae976d49cf524b66feba2dda2d2ee (patch)
tree29602e3d5a946fb6ce87e487f959e3f4b8b1890c /interimap
parent7d50d83ab52148285c642158bd57bdd18a1ee6d4 (diff)
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.
Diffstat (limited to 'interimap')
-rwxr-xr-xinterimap103
1 files changed, 74 insertions, 29 deletions
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);