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). --- interimap | 45 ++++++++++++++++++++++++++++----------------- 1 file changed, 28 insertions(+), 17 deletions(-) (limited to 'interimap') 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 -- cgit v1.2.3