[PATCH 2/3] cyradm: request and print value.shared and value.priv attribures
Norbert Warmuth
now at arcor.de
Sun Mar 29 13:33:09 EDT 2015
In draft-daboo-imap-annotatemore-08 (the last draft which defined the
GETANNOTATION command) all attribute names have a ".priv" and a
".shared" suffix.
Extend Cyrus::IMAP::Admin::getinfo and Cyrus::IMAP::Shell::info to
request and print "value.priv" in addition to "value.shared"
attributes (should be identical to requesting "value").
additionally:
- GETANNOTATION responses changed slightly with 2.5: mailbox and value
may be QTEXT instead of qstring. For the time being only accept
the QTEXT value NIL.
- Add GETANNOTATION response examples to Cyrus::IMAP::Admin::getinfo
to make it a bit easier to dissect the non-trivial regular expressions
used to process the imap server responses.
- In the else-clause the wrong backreference was used to extract
the length of the value.
- Do not quote '"' inside regular expressions because that's not required.
- "next" does not work in callbacks and confuses imclient and/or perl
without visible feedback in cyradm.
---
perl/imap/IMAP/Admin.pm | 69 +++++++++++++++++++++++++++++++++++++------------
perl/imap/IMAP/Shell.pm | 35 +++++++++++++++----------
2 files changed, 74 insertions(+), 30 deletions(-)
diff --git a/perl/imap/IMAP/Admin.pm b/perl/imap/IMAP/Admin.pm
index 1a6c1eb..42cd660 100644
--- a/perl/imap/IMAP/Admin.pm
+++ b/perl/imap/IMAP/Admin.pm
@@ -721,37 +721,74 @@ sub getinfo {
# but since we send only the latest form command,
# this is the only possible response.
+ # Regex 1 (Shared-Folder, user folder looks similar):
+ # cyrus imapd 2.5.0
+ # folder "/vendor/cmu/cyrus-imapd/expire" ("value.shared" "90")
+ # 1 2 3 4
+ # folder "/vendor/cmu/cyrus-imapd/pop3showafter" ("value.shared" NIL)
+ # 1 2 3 4
+ # folder "/specialuse" ("value.priv" NIL "value.shared" NIL)
+ # 1 2 3 4 5 6
+
+ # cyrus imapd 2.4.17
+ # "folder" "/vendor/cmu/cyrus-imapd/partition" ("value.shared" "default")
+ # 1 2 3 4
+
+ # cyrus imapd 2.2.13
+ # "folder" "/vendor/cmu/cyrus-imapd/expire" ("value.shared" "90")
+ # 1 2 3 4
+
+ # Regex 1: server info
+ # cyrus imapd 2.5.0
+ # "" "/comment" ("value.shared" "test")
+ # 1 2 3 4
+ # "" "/motd" ("value.shared" NIL)
+ # 1 2 3 4
+ # "" "/vendor/cmu/cyrus-imapd/expire" ("value.priv" NIL "value.shared" NIL)
+ # 1 2 3 4 5 6
+
+ # cyrus imapd 2.4.17
+ # "" "/vendor/cmu/cyrus-imapd/freespace" ("value.shared" "3122744")
+ # 1 2 3 4
+
+ # Regex 2
+ # cyrus imapd 2.5.0 (user folder, authorized as user)
+ # Note: two lines
+ # INBOX.Sent "/specialuse" ("value.priv" {5}\r\n
+ # \Sent)>
+ # 1 2 3 4\r\n
+ # 5
+
if ($text =~
- /^\s*\"([^\"]*)\"\s+\"([^\"]*)\"\s+\(\"([^\"]*)\"\s+\"([^\"]*)\"\)/) {
- # note that we require mailbox and entry to be qstrings
- # Single annotation, not literal,
- # but possibly multiple values
- # however, we are only asking for one value, so...
+ /^\s*(?|"([^"]*)"|([^\s]+))\s+"([^"]*)"\s+\("([^"]*)"\s+(?|"([^"]*)"|(NIL))(?:\s+"([^"]*)"\s+(?|"([^"]*)"|(NIL)))*\)/) {
my $key;
if($1 ne "") {
$key = "/mailbox/{$1}$2";
} else {
$key = "/server$2";
}
- $d{-rock}{$key} = $4;
+ $d{-rock}{$3}->{$key} = $4;
+ $d{-rock}{$5}->{$key} = $6 if (defined ($5) && defined ($6));
} elsif ($text =~
- /^\s*\"([^\"]*)\"\s+\"([^\"]*)\"\s+\(\"([^\"]*)\"\s+\{(.*)\}\r\n/) {
- my $len = $3;
- $text =~ s/^\s*\"([^\"]*)\"\s+\"([^\"]*)\"\s+\(\"([^\"]*)\"\s+\{(.*)\}\r\n//s;
+ /^\s*"([^"]*)"\s+"([^"]*)"\s+\("([^"]*)"\s+\{(.*)\}\r\n/ ||
+ $text =~
+ /^\s*([^\s]+)\s+"([^"]*)"\s+\("([^"]*)"\s+\{(.*)\}\r\n/) {
+ my $len = $4;
+ $text =~ s/^\s*"*([^"\s]*)"*\s+"([^"]*)"\s+\("([^"]*)"\s+\{(.*)\}\r\n//s;
$text = substr($text, 0, $len);
- # note that we require mailbox and entry to be qstrings
# Single annotation (literal style),
- # possibly multiple values
- # however, we are only asking for one value, so...
+ # possibly multiple values -- multiple
+ # values not tested.
+
my $key;
if($1 ne "") {
$key = "/mailbox/{$1}$2";
} else {
$key = "/server$2";
}
- $d{-rock}{$1} = $text;
+ $d{-rock}{$3}->{$key} = $text;
} else {
- next;
+ ; # XXX: unrecognized line, how to notify caller?
}
},
-rock => \%info});
@@ -760,12 +797,12 @@ sub getinfo {
my($rc, $msg);
if(scalar(@entries)) {
foreach my $annot (@entries) {
- ($rc, $msg) = $self->send('', '', "GETANNOTATION %s %q \"value.shared\"",
+ ($rc, $msg) = $self->send('', '', 'GETANNOTATION %s %q ("value.priv" "value.shared")',
$box, $annot);
last if($rc ne 'OK');
}
} else {
- ($rc, $msg) = $self->send('', '', "GETANNOTATION %s \"*\" \"value.shared\"",
+ ($rc, $msg) = $self->send('', '', 'GETANNOTATION %s "*" ("value.priv" "value.shared")',
$box);
}
$self->addcallback({-trigger => 'ANNOTATION'});
diff --git a/perl/imap/IMAP/Shell.pm b/perl/imap/IMAP/Shell.pm
index 0240d41..05a12d4 100644
--- a/perl/imap/IMAP/Shell.pm
+++ b/perl/imap/IMAP/Shell.pm
@@ -1386,23 +1386,30 @@ sub _sc_info {
# keep track of what mailboxes we've printed a header for already
my %section = ();
- foreach my $attrib (sort keys %info) {
- # server metadata does not contain '{}'
- my $sect = undef;
- $sect = $1 if $attrib =~ /(\{.*\})/;
- if(!defined($sect)) {
- $sect = "Server Wide";
- }
+ my %attribname = ();
+ foreach my $attribname (sort keys %info) {
+ foreach my $attrib (sort keys %{$info{$attribname}}) {
+ # server metadata does not contain '{}'
+ my $sect = undef;
+ $sect = $1 if $attrib =~ /(\{.*\})/;
+ if(!defined($sect)) {
+ $sect = "Server Wide";
+ }
- if(!exists $section{$sect}) {
- $section{$sect} = 'x';
- print "$sect:\n";
- }
+ if(!exists $section{$sect}) {
+ $section{$sect} = 'x';
+ print "$sect:\n";
+ }
- $attrib =~ /([^\/]*)$/;
- my $attrname = $1;
+ if(!exists $attribname{$attribname}) {
+ $attribname{$attribname} = 'x';
+ print " $attribname:\n";
+ }
+ $attrib =~ /([^\/]*)$/;
+ my $attrname = $1;
- $lfh->[1]->print(" ", $attrname, ": ", $info{$attrib}, "\n");
+ $lfh->[1]->print(" ", $attrname, ": ", $info{$attribname}->{$attrib}, "\n");
+ }
}
0;
}
--
2.1.4
More information about the Cyrus-devel
mailing list