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.

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 <guilhem@fripost.org>  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);