diff options
| -rw-r--r-- | Changelog | 7 | ||||
| -rwxr-xr-x | interimap | 103 |
2 files changed, 81 insertions, 29 deletions
@@ -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 @@ -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); |