aboutsummaryrefslogtreecommitdiffstats
path: root/lib/Net/IMAP/InterIMAP.pm
diff options
context:
space:
mode:
authorGuilhem Moulin <guilhem@fripost.org>2019-05-24 23:52:37 +0200
committerGuilhem Moulin <guilhem@fripost.org>2019-05-27 00:07:29 +0200
commit735c861de4d662f5bfe4fddff9fbfa8bc5a503c1 (patch)
treeb35f90885cda219eb1c7970006dd03b181bd0ec4 /lib/Net/IMAP/InterIMAP.pm
parent1c5274b67308c10512e275d018ee18befcfb487f (diff)
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 = "]"
Diffstat (limited to 'lib/Net/IMAP/InterIMAP.pm')
-rw-r--r--lib/Net/IMAP/InterIMAP.pm13
1 files changed, 10 insertions, 3 deletions
diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index 26c3712..86f08a9 100644
--- 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';