libinterimap: astring is 1*ASTRING-CHAR / string.

Not 1*ATOM-CHAR / string.  Also accept LIST responses mailbox names
containing '%', '*', or ']'.

From RFC 3501:

        astring         = 1*ASTRING-CHAR / string
        ASTRING-CHAR    = ATOM-CHAR / resp-specials
        list            = "LIST" SP mailbox SP list-mailbox
        list-mailbox    = 1*list-char / string
        list-char       = ATOM-CHAR / list-wildcards / resp-specials
        list-wildcards  = "%" / "*"
        resp-specials   = "]"

diff --git a/Changelog b/Changelog
index 9cce06249fb54e8d50d45219c2d1273ae86a1fe5..587dc9b5d4c0c525ca8853e6cbafc82c82d25fdb 100644 (file)
--- a/Changelog
+++ b/Changelog
@@ -3,6 +3,9 @@ interimap (0.5) upstream;
  - libinterimap: bugfix: hierarchy delimiters in LIST responses were
    returned as an escaped quoted special, like "\\", not as a single
    character (backslash in this case).
+ - libinterimap: the parser choked on responses with non-quoted/literal
+   astring containing ']' characters.  And LIST responses with
+   non-quoted/literal list-mailbox names '%', '*' or ']' characters.
  - libinterimap: quote() the empty string as "" instead of a 0-length
    literal.  (This saves 3 bytes + one round-trip on servers not
    supporting non-synchronizing literals, and 4 bytes otherwise.)

diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index 26c37128277855893a69db9f40ab2785380d7767..86f08a9b52fce6f4358b4c7944b130219e7ad17e 100644 (file)
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -40,9 +40,10 @@ BEGIN {
 }
 
 
-# Regexes for RFC 3501's 'ATOM-CHAR', 'ASTRING-CHAR' and 'TEXT-CHAR'.
+# Regexes for RFC 3501's 'ATOM-CHAR', 'ASTRING-CHAR', 'list-char' and 'TEXT-CHAR'.
 my $RE_ATOM_CHAR    = qr/[\x21\x23\x24\x26\x27\x2B-\x5B\x5E-\x7A\x7C-\x7E]/;
 my $RE_ASTRING_CHAR = qr/[\x21\x23\x24\x26\x27\x2B-\x5B\x5D-\x7A\x7C-\x7E]/;
+my $RE_LIST_CHAR    = qr/[\x21\x23-\x27\x2A\x2B-\x5B\x5D-\x7A\x7C-\x7E]/;
 my $RE_TEXT_CHAR    = qr/[\x01-\x09\x0B\x0C\x0E-\x7F]/;
 
 my $RE_SSL_PROTO = qr/(?:SSLv[23]|TLSv1|TLSv1\.[0-3])/;
@@ -2192,7 +2193,13 @@ sub _nstring($$) {
 # Parse and consume an RFC 3501 astring (1*ASTRING-CHAR / string).
 sub _astring($$) {
     my ($self, $stream) = @_;
-    return $$stream =~ s/\A($RE_ATOM_CHAR+)// ? $1 : $self->_string($stream);
+    return $$stream =~ s/\A$RE_ASTRING_CHAR+//p ? ${^MATCH} : $self->_string($stream);
+}
+
+# Parse and consume an RFC 3501 list-mailbox (1*list-char / string).
+sub _list_mailbox($$) {
+    my ($self, $stream) = @_;
+    return $$stream =~ s/\A$RE_LIST_CHAR+//p ? ${^MATCH} : $self->_string($stream);
 }
 
 # Parse and consume an RFC 3501 string (quoted / literal).
@@ -2364,7 +2371,7 @@ sub _resp($$;&$$) {
         elsif (s/\ALIST \((\\?$RE_ATOM_CHAR+(?: \\?$RE_ATOM_CHAR+)*)?\) ("(?:\\[\x22\x5C]|[\x01-\x09\x0B\x0C\x0E-\x21\x23-\x5B\x5D-\x7F])"|NIL) //) {
             my ($delim, $attrs) = ($2, $1);
             my @attrs = defined $attrs ? split(/ /, $attrs) : ();
-            my $mailbox = $self->_astring(\$_);
+            my $mailbox = $self->_list_mailbox(\$_);
             $self->panic($_) unless $_ eq '';
             $mailbox = 'INBOX' if uc $mailbox eq 'INBOX'; # INBOX is case-insensitive
             undef $delim if uc $delim eq 'NIL';