interimap: accept C-style escape sequences in 'list-mailbox'.

This is useful for defining names containing control characters (incl.
\0 for unspecified hierarchy delimiter).

1 files changed, 44 insertions, 19 deletions

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 <guilhem@fripost.org>
+# Copyright © 2015-2019 Guilhem Moulin <guilhem@fripost.org>
 #
 # 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();
     }
 }