One last and small patchset to cyradm from cyrus imapd 2.5.0. Both
patches have been only tested against cyrus imapd 2.5.0.
* 0001-cyradm-add-LIST-EXTENDED-and-SPECIAL-USE-support.patch
(with a server that supports MAILBOX-REFERRALS, LIST-EXTENDED,
SPECIAL-USE):
cyradm> lm
# REMOTE selection option instead of RLIST
# LIST (REMOTE) "" "*" RETURN (SUBSCRIBED SPECIAL-USE)
cyradm> lm --subscribed
# same as without patch:
# RLSUB "*" "*"
cyradm> lm --subscribed --specialuse
# LIST (REMOTE SUBSCRIBED SPECIAL-USE) "" "*" RETURN (SUBSCRIBED
SPECIAL-USE)
cyradm> lm --specialuse
# LIST (REMOTE SPECIAL-USE) "" "*" RETURN (SUBSCRIBED SPECIAL-USE)
cyradm> lm --subscribed --recursivematch
# LIST (REMOTE RECURSIVEMATCH SUBSCRIBED) "" "*" RETURN (SUBSCRIBED
SPECIAL-USE)
* 0002-cyradm-add-CREATE-SPECIAL-USE-support.patch
cyradm> cm --specialuse \\Drafts INBOX.Drafts
# CREATE INBOX.Drafts (USE (\Drafts))
Notes:
The first patch adds but does not document --recursivematch because
I don't know how to describe it in simple words and without copying
several paragraphs from the RFC.
I've used "specialuse" although the newer RFCs always talk about
"special-use" to be consistent with existing usage in cyradm
(e.g. setmetadata uses "specialuse" in the user interface.
Regards,
Norbert
>From 4077f7dd8da8c779a08636e593b13a9388e0658a Mon Sep 17 00:00:00 2001
From: Norbert Warmuth <[email protected]>
Date: Mon, 6 Apr 2015 14:32:42 +0200
Subject: [PATCH 1/2] cyradm: add LIST-EXTENDED and SPECIAL-USE support to
listmailbox command
If the server supports LIST-EXTENDED (RFC 5258 IMAPv4 - LIST Command
Extensions):
- use LIST and REMOTE selection option instead of RLIST command
- always request to return subscription state (SUBSCRIBED return option)
- extract and output optional mbox-list-extended, i.e. the CHILDINFO
extented data item in
<1428759112<6 LIST (REMOTE) "" "*" RETURN (SUBSCRIBED SPECIAL-USE)
>1428759112>* LIST (\HasChildren) "." INBOX (CHILDINFO ("SUBSCRIBED"))
is output as:
INBOX (\HasChildren) (CHILDINFO ("SUBSCRIBED"))
If additionally SPECIAL-USE is supported (RFC 6154 - IMAP LIST Extension
or Special-Use Mailboxes):
- always request return of special-use attributes
- optionally only request mailboxes with special use attributes set
(SPECIAL-USE select option)
Example: lm --specialuse
- if both --subscribed and --specialuse is requestet: use LIST instead
of LSUB command
---
perl/imap/IMAP/Admin.pm | 103 ++++++++++++++++++++++++++++++++++++++++++------
perl/imap/IMAP/Shell.pm | 43 ++++++++++++++------
perl/imap/cyradm.sh | 12 +++---
3 files changed, 130 insertions(+), 28 deletions(-)
diff --git a/perl/imap/IMAP/Admin.pm b/perl/imap/IMAP/Admin.pm
index 4582932..402441d 100644
--- a/perl/imap/IMAP/Admin.pm
+++ b/perl/imap/IMAP/Admin.pm
@@ -76,15 +76,25 @@ sub new {
if(defined($self)) {
$self->{support_referrals} = 0;
$self->{support_annotatatemore} = 0;
+ $self->{support_list_extended} = 0;
+ $self->{support_list_special_use} = 0;
$self->{authopts} = [];
$self->addcallback({-trigger => 'CAPABILITY',
-callback => sub {my %a = @_;
- map { $self->{support_referrals} = 1
+ map {
+ # RFC 2193 IMAP4 Mailbox Referrals
+ $self->{support_referrals} = 1
if /^MAILBOX-REFERRALS$/i;
$self->{support_annotatemore} = 1
if /^ANNOTATEMORE$/i;
$self->{support_metadata} = 1
if /^METADATA$/i;
+ # RFC 5258 IMAPv4 - LIST Command Extensions
+ $self->{support_list_extended} = 1
+ if /^LIST-EXTENDED$/i;
+ # RFC 6154 - IMAP LIST Extension for Special-Use Mailboxes
+ $self->{support_list_special_use} = 1
+ if /^SPECIAL-USE$/i;
}
split(/ /, $a{-text})}});
$self->send(undef, undef, 'CAPABILITY');
@@ -324,15 +334,65 @@ sub listaclmailbox {
*listacl = *listaclmailbox;
sub listmailbox {
- my ($self, $pat, $ref) = @_;
+ my ($self, $pat, $ref, $opts) = @_;
$ref ||= "";
my @info = ();
my $list_cmd;
+ my @list_sel;
+ my @list_ret;
if($self->{support_referrals}) {
- $list_cmd = 'RLIST';
- } else {
- $list_cmd = 'LIST';
+ if ($self->{support_list_extended}) {
+ $list_cmd = 'LIST';
+ push @list_sel, "REMOTE";
+ } else {
+ $list_cmd = 'RLIST';
+ }
+ }
+
+ if(defined ($$opts{'-sel-special-use'}) && !$self->{support_list_special_use}) {
+ $self->{error} = "Remote does not support SPECIAL-USE.";
+ return undef;
+ }
+
+ if((defined ($$opts{'-sel-special-use'}) ||
+ defined ($$opts{'-sel-recursivematch'}) ||
+ defined ($$opts{'-sel-subscribed'}))
+ && !$self->{support_list_extended}) {
+ $self->{error} = "Remote does not support LIST-EXTENDED.";
+ return undef;
}
+
+ if ($self->{support_list_extended}) {
+ push @list_ret, "SUBSCRIBED";
+ # "The RECURSIVEMATCH option MUST NOT occur as the only selection
+ # option (or only with REMOTE), as it only makes sense when other
+ # selection options are also used."
+ push @list_sel, "RECURSIVEMATCH"
+ if defined ($$opts{'-sel-recursivematch'});
+
+ push @list_sel, "SUBSCRIBED"
+ if defined ($$opts{'-sel-subscribed'});
+
+ if($self->{support_list_special_use}) {
+ # always return special-use flags
+ push @list_ret, "SPECIAL-USE";
+ push @list_sel, "SPECIAL-USE"
+ if defined ($$opts{'-sel-special-use'});
+ }
+ }
+
+ # RFC 5258:
+ # "By adding options to the LIST command, we are announcing the intent
+ # to phase out and eventually to deprecate the RLIST and RLSUB commands
+ # described in [MBRef])."
+ #
+ # This should never trigger: MAILBOX-REFERRALS and SPECIAL-USE but no
+ # LIST-EXTENDED.
+ if ($list_cmd eq "RLIST" && (scalar (@list_ret) > 0 || scalar (@list_sel) > 0)) {
+ $self->{error} = "Invalid capabilities: MAILBOX-REFERRALS and SPECIAL-USE but no LIST-EXTENDED.";
+ return undef;
+ }
+
$self->addcallback({-trigger => 'LIST',
-callback => sub {
my %d = @_;
@@ -340,6 +400,7 @@ sub listmailbox {
my $attrs = $1;
my $sep = '';
my $mbox;
+ my $extended;
# NIL or (attrs) "sep" "str"
if ($d{-text} =~ /^N/) {
return if $d{-text} !~ s/^NIL//;
@@ -351,16 +412,36 @@ sub listmailbox {
if ($d{-text} =~ /{\d+}(.*)/) {
# cope with literals (?)
(undef, $mbox) = split(/\n/, $d{-text});
- } elsif ($d{-text} =~ /\"(([^\\\"]*\\)*[^\\\"]*)\"/) {
+ } elsif ($d{-text} =~ /^\"(([^\\\"]*\\)*[^\\\"]*)\"/) {
($mbox = $1) =~ s/\\(.)/$1/g;
} else {
- $d{-text} =~ /^([]!\#-[^-~]+)/;
+ $d{-text} =~ s/^([]!\#-[^-~]+)//;
$mbox = $1;
}
- push @{$d{-rock}}, [$mbox, $attrs, $sep];
+ if ($d{-text} =~ s/^ \(("{0,1}[^" ]+"{0,1} \("[^"]*"\))\)//) {
+ # RFC 5258: mbox-list-extended = "(" [mbox-list-extended-item
+ # *(SP mbox-list-extended-item)] ")"
+ $extended = $1;
+ }
+ push @{$d{-rock}}, [$mbox, $attrs, $sep, $extended];
},
-rock => \@info});
- my ($rc, $msg) = $self->send('', '', "$list_cmd %s %s", $ref, $pat);
+
+ # list = "LIST" [SP list-select-opts] SP mailbox SP mbox-or-pat
+ # [SP list-return-opts]
+ my @args = ();
+ my $cmd = $list_cmd;
+ if (scalar (@list_sel) > 0) {
+ $cmd .= " (%a)";
+ push @args, join (" ", @list_sel);
+ }
+ $cmd .= " %s %s";
+ push @args, ($ref, $pat);
+ if (scalar (@list_ret) > 0) {
+ $cmd .= " RETURN (%a)";
+ push @args, join (" ", @list_ret);
+ }
+ my ($rc, $msg) = $self->send('', '', $cmd, @args);
$self->addcallback({-trigger => $list_cmd});
if ($rc eq 'OK') {
$self->{error} = undef;
@@ -1278,9 +1359,9 @@ Delete one or more ACL from a mailbox.
Returns a hash of mailbox ACLs, with each key being a Cyrus user and the
corresponding value being the ACL.
-=item listmailbox($pattern[, $reference])
+=item listmailbox($pattern[[, $reference], \%opts])
-=item list($pattern[, $reference])
+=item list($pattern[[, $reference], \%opts])
List mailboxes matching the specified pattern, starting from the specified
reference. The result is a list; each element is an array containing the
diff --git a/perl/imap/IMAP/Shell.pm b/perl/imap/IMAP/Shell.pm
index 9fb4a3a..c58e4df 100644
--- a/perl/imap/IMAP/Shell.pm
+++ b/perl/imap/IMAP/Shell.pm
@@ -80,7 +80,7 @@ my %builtins = (exit =>
listaclmailbox => 'listacl',
lm => 'listmailbox',
listmailbox =>
- [\&_sc_list, '[-subscribed] [pattern [base]]',
+ [\&_sc_list, '[-subscribed] [-specialuse] [pattern [base]]',
'list mailboxes'],
server =>
[\&_sc_server, '[-noauthenticate] [server]',
@@ -608,27 +608,45 @@ sub _sc_exit {
sub _sc_list {
my ($cyrref, $name, $fh, $lfh, @argv) = @_;
my $cmd = 'listmailbox';
- my (@nargv, $opt);
+ my (@nargv, $opt, %opts, $subscribed);
shift(@argv);
while (defined ($opt = shift(@argv))) {
# gack. bloody tcl.
last if $opt eq '--';
if ($opt ne '' && '-subscribed' =~ /^\Q$opt/ || $opt eq '--subscribed') {
- $cmd = 'listsubscribed';
+ $subscribed = 1;
+ } elsif ($opt ne '' && '-specialuse' =~ /^\Q$opt/ || $opt eq '--specialuse') {
+ $opts{'-sel-special-use'} = 1;
+ } elsif ($opt ne '' && '-recursivematch' =~ /^\Q$opt/ || $opt eq '--recursivematch') {
+ $opts{'-sel-recursivematch'} = 1;
}
elsif ($opt =~ /^-/) {
- die "usage: listmailbox [-subscribed] [pattern [base]]\n";
+ die "usage: listmailbox [-subscribed] [-specialuse] [pattern [base]]\n";
}
else {
push(@nargv, $opt);
last;
}
}
+
+ if ($subscribed) {
+ if (scalar (keys %opts) > 0 ) {
+ # LIST + LIST-EXTENED
+ $opts{'-sel-subscribed'} = 1;
+ } else {
+ # LSUB
+ $cmd = 'listsubscribed';
+ # undef %opts;
+ }
+ }
+
push(@nargv, @argv);
if (@nargv > 2) {
- die "usage: listmailbox [-subscribed] [pattern [base]]\n";
+ die "usage: listmailbox [-subscribed] [-specialuse] [pattern [base]]\n";
}
push(@nargv, '*') if !@nargv;
+ push(@nargv, undef) if scalar (@nargv) < 2; # no ref
+ push(@nargv, \%opts);
if (!$cyrref || !$$cyrref) {
die "listmailbox: no connection to server\n";
}
@@ -643,6 +661,9 @@ sub _sc_list {
if ($mbx->[1] ne '') {
$l .= ' (' . $mbx->[1] . ')';
}
+ if (defined ($mbx->[3])) {
+ $l .= ' (' . $mbx->[3] . ')';
+ }
if (length($l) + 1 > $w) {
$w = length($l) + 1;
}
@@ -1744,15 +1765,15 @@ Display the mailbox/server metadata.
List ACLs on the specified mailbox.
-=item C<listmailbox> [C<--subscribed>] [I<pattern> [I<reference>]]
+=item C<listmailbox> [C<--subscribed>] [C<--specialuse>] [I<pattern> [I<reference>]]
-=item C<list> [C<--subscribed>] [I<pattern> [I<reference>]]
+=item C<list> [C<--subscribed>] [C<--specialuse>] [I<pattern> [I<reference>]]
-=item C<lm> [C<--subscribed>] [I<pattern> [I<reference>]]
+=item C<lm> [C<--subscribed>] [C<--specialuse>] [I<pattern> [I<reference>]]
-List all, or all subscribed, mailboxes matching the specified pattern.
-The pattern may have embedded wildcards C<'*'> or C<'%'>, which match
-anything or anything except the separator character, respectively.
+List all, or all subscribed or special-use, mailboxes matching the specified
+pattern. The pattern may have embedded wildcards C<'*'> or C<'%'>, which
+match anything or anything except the separator character, respectively.
Mailboxes returned will be relative to the specified reference if one
is specified. This allows a mailbox list to be limited to a particular
diff --git a/perl/imap/cyradm.sh b/perl/imap/cyradm.sh
index 4a7caaa..5a6bc0f 100644
--- a/perl/imap/cyradm.sh
+++ b/perl/imap/cyradm.sh
@@ -162,15 +162,15 @@ Display the mailbox/server metadata.
List ACLs on the specified mailbox.
-=item C<listmailbox> [C<--subscribed>] [I<pattern> [I<reference>]]
+=item C<listmailbox> [C<--subscribed>] [C<--specialuse>] [I<pattern> [I<reference>]]
-=item C<list> [C<--subscribed>] [I<pattern> [I<reference>]]
+=item C<list> [C<--subscribed>] [C<--specialuse>] [I<pattern> [I<reference>]]
-=item C<lm> [C<--subscribed>] [I<pattern> [I<reference>]]
+=item C<lm> [C<--subscribed>] [C<--specialuse>] [I<pattern> [I<reference>]]
-List all, or all subscribed, mailboxes matching the specified pattern.
-The pattern may have embedded wildcards C<'*'> or C<'%'>, which match
-anything or anything except the separator character, respectively.
+List all, or all subscribed or special-use, mailboxes matching the specified
+pattern. The pattern may have embedded wildcards C<'*'> or C<'%'>, which
+match anything or anything except the separator character, respectively.
Mailboxes returned will be relative to the specified reference if one
is specified. This allows a mailbox list to be limited to a particular
--
2.1.4
>From 0a7e1d4e3d098a1486621606b9ae6bea1f1fc31c Mon Sep 17 00:00:00 2001
From: Norbert Warmuth <[email protected]>
Date: Mon, 6 Apr 2015 14:43:40 +0200
Subject: [PATCH 2/2] cyradm: add CREATE-SPECIAL-USE support
createmailbox: add option to assign special use attribute if remote server
supports CREATE-SPECIAL-USE (RFC 6154 - IMAP LIST Extension for Special-
Use Mailboxes).
Example: cm --specialuse \\Trash INBOX.Trash
---
perl/imap/IMAP/Admin.pm | 33 ++++++++++++++++++++++++++++-----
perl/imap/IMAP/Shell.pm | 37 +++++++++++++++++++++++--------------
perl/imap/cyradm.sh | 13 ++++++-------
3 files changed, 57 insertions(+), 26 deletions(-)
diff --git a/perl/imap/IMAP/Admin.pm b/perl/imap/IMAP/Admin.pm
index 402441d..a9289f6 100644
--- a/perl/imap/IMAP/Admin.pm
+++ b/perl/imap/IMAP/Admin.pm
@@ -78,6 +78,7 @@ sub new {
$self->{support_annotatatemore} = 0;
$self->{support_list_extended} = 0;
$self->{support_list_special_use} = 0;
+ $self->{support_create_special_use} = 0;
$self->{authopts} = [];
$self->addcallback({-trigger => 'CAPABILITY',
-callback => sub {my %a = @_;
@@ -95,6 +96,9 @@ sub new {
# RFC 6154 - IMAP LIST Extension for Special-Use Mailboxes
$self->{support_list_special_use} = 1
if /^SPECIAL-USE$/i;
+ # RFC 6154 - IMAP LIST Extension for Special-Use Mailboxes
+ $self->{support_create_special_use} = 1
+ if /^CREATE-SPECIAL-USE$/i;
}
split(/ /, $a{-text})}});
$self->send(undef, undef, 'CAPABILITY');
@@ -190,10 +194,29 @@ sub reconstruct {
}
sub createmailbox {
- my ($self, $mbx, $partition) = @_;
- $partition = '' if !defined($partition);
- my ($rc, $msg) = $self->send('', '', 'CREATE %s%a%a', $mbx,
- $partition? ' ': '', $partition);
+ my ($self, $mbx, $partition, $opts) = @_;
+ my $cmd = "CREATE %s";
+ my @args = ();
+ # RFC 3501 + cyrus: CREATE mailbox [partition]
+ # RFC 4466 + RFC 6154: CREATE mailbox ([PARTITION partition ]USE (special-use))
+ if (defined ($$opts{'-specialuse'})) {
+ if($self->{support_create_special_use}) {
+ if (defined ($partition)) {
+ $cmd .= " (PARTITION %a USE (%a))" ;
+ push @args, ($partition, $$opts{'-specialuse'});
+ } else {
+ $cmd .= " (USE (%a))" ;
+ push @args, $$opts{'-specialuse'};
+ }
+ } else {
+ $self->{error} = "Remote does not support CREATE-SPECIAL-USE.";
+ return undef;
+ }
+ } elsif (defined ($partition)) {
+ $cmd .= " %a";
+ push @args, $partition;
+ }
+ my ($rc, $msg) = $self->send('', '', $cmd, $mbx, @args);
if ($rc eq 'OK') {
$self->{error} = undef;
1;
@@ -1333,7 +1356,7 @@ Calling C<error> does not reset the error state, so it is legal to write:
@folders = $cyradm->list($spec);
print STDERR "Error: ", $cyradm->error if $cyradm->error;
-=item createmailbox($mailbox[, $partition])
+=item createmailbox($mailbox[[, $partition], \%opts])
=item create($mailbox[, $partition])
diff --git a/perl/imap/IMAP/Shell.pm b/perl/imap/IMAP/Shell.pm
index c58e4df..22da834 100644
--- a/perl/imap/IMAP/Shell.pm
+++ b/perl/imap/IMAP/Shell.pm
@@ -108,7 +108,7 @@ my %builtins = (exit =>
[\&_sc_chdir, 'directory', 'change current directory'],
cd => 'chdir',
createmailbox =>
- [\&_sc_create, '[--partition partition] mailbox [partition]',
+ [\&_sc_create, '[--partition partition] [--specialuse specialuse] mailbox [partition]',
'create mailbox'],
create => 'createmailbox',
cm => 'createmailbox',
@@ -993,21 +993,29 @@ sub _sc_chdir {
sub _sc_create {
my ($cyrref, $name, $fh, $lfh, @argv) = @_;
- my (@nargv, $opt, $part, $want);
+ my (@nargv, $opt, $part, $want, %opts);
shift(@argv);
while (defined ($opt = shift(@argv))) {
if ($want) {
- $part = $opt;
+ if ($want eq '-partition') {
+ $part = $opt;
+ } else {
+ $opts{$want} = $opt;
+ }
$want = undef;
next;
}
if ($opt ne '' && '-partition' =~ /^\Q$opt/ || $opt eq '--partition') {
- $want = 1;
+ $want = '-partition';
+ next;
+ }
+ if ($opt ne '' && '-specialuse' =~ /^\Q$opt/ || $opt eq '--specialuse') {
+ $want = '-specialuse';
next;
}
last if $opt eq '--';
if ($opt =~ /^-/) {
- die "usage: createmailbox [--partition partition] mailbox [partition]\n";
+ die "usage: createmailbox [--partition partition] [--specialuse specialuse] mailbox [partition]\n";
}
else {
push(@nargv, $opt);
@@ -1018,9 +1026,9 @@ sub _sc_create {
if (!@nargv || @nargv > 2) {
die "usage: createmailbox [--partition partition] mailbox [partition]\n";
}
- if (defined($part)) {
- push(@nargv, $part)
- }
+ push(@nargv, $part) if (defined ($part));
+ push(@nargv, undef) if (@nargv < 2);
+ push(@nargv, \%opts);
if (!$cyrref || !$$cyrref) {
die "createmailbox: no connection to server\n";
}
@@ -1695,20 +1703,21 @@ authenticated once.
Change directory. A C<pwd> builtin is not provided, but the default command
action will run C<pwd> from a shell if invoked.
-=item C<createmailbox> [C<--partition> I<partition>] I<mailbox>
+=item C<createmailbox> [C<--partition> I<partition>] [C<--specialuse> I<specialuse>] I<mailbox>
-=item C<createmailbox> I<mailbox> I<partition>
+=item C<createmailbox> [C<--specialuse> I<specialuse>] I<mailbox> I<partition>
-=item C<create> [C<--partition> I<partition>] I<mailbox>
+=item C<create> [C<--partition> I<partition>] [C<--specialuse> I<specialuse>] I<mailbox>
-=item C<create> I<mailbox> I<partition>
+=item C<create> [C<--specialuse> I<specialuse>] I<mailbox> I<partition>
-=item C<cm> [C<--partition> I<partition>] I<mailbox>
+=item C<cm> [C<--partition> I<partition>] [C<--specialuse> I<specialuse>] I<mailbox>
-=item C<cm> I<mailbox> I<partition>
+=item C<cm> [C<--specialuse> I<specialuse>] I<mailbox> I<partition>
Create a mailbox on the default or a specified partition. Both old-style
and getopt-style usages are accepted (combining them will produce an error).
+Optionally assign a special use to the mailbox.
=item C<deleteaclmailbox> I<mailbox> I<id> [...]
diff --git a/perl/imap/cyradm.sh b/perl/imap/cyradm.sh
index 5a6bc0f..e8e64c3 100644
--- a/perl/imap/cyradm.sh
+++ b/perl/imap/cyradm.sh
@@ -92,20 +92,19 @@ authenticated once.
Change directory. A C<pwd> builtin is not provided, but the default command
action will run C<pwd> from a shell if invoked.
-=item C<createmailbox> [C<--partition> I<partition>] I<mailbox>
+=item C<createmailbox> [C<--partition> I<partition>] [C<--specialuse> I<specialuse>] I<mailbox>
-=item C<createmailbox> I<mailbox> I<partition>
+=item C<create> [C<--partition> I<partition>] [C<--specialuse> I<specialuse>] I<mailbox>
-=item C<create> [C<--partition> I<partition>] I<mailbox>
+=item C<create> [C<--specialuse> I<specialuse>] I<mailbox> I<partition>
-=item C<create> I<mailbox> I<partition>
+=item C<cm> [C<--partition> I<partition>] [C<--specialuse> I<specialuse>] I<mailbox>
-=item C<cm> [C<--partition> I<partition>] I<mailbox>
-
-=item C<cm> I<mailbox> I<partition>
+=item C<cm> [C<--specialuse> I<specialuse>] I<mailbox> I<partition>
Create a mailbox on the default or a specified partition. Both old-style
and getopt-style usages are accepted (combining them will produce an error).
+Optionally assign a special use to the mailbox.
=item C<deleteaclmailbox> I<mailbox> I<id> [...]
--
2.1.4
