First attempt.

1 files changed, 1495 insertions, 0 deletions

diff --git a/lib/Net/IMAP/Sync.pm b/lib/Net/IMAP/Sync.pm
new file mode 100644
index 0000000..b952546
--- /dev/null
+++ b/lib/Net/IMAP/Sync.pm
@@ -0,0 +1,1495 @@
+#----------------------------------------------------------------------
+# A minimal IMAP4 client for QRESYNC-capable servers
+# Copyright © 2015 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
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+#----------------------------------------------------------------------
+
+package Net::IMAP::Sync v0.0.1;
+use warnings;
+use strict;
+
+use Config::Tiny ();
+use List::Util 'first';
+use Socket 'SO_KEEPALIVE';
+use POSIX 'strftime';
+
+use Exporter 'import';
+BEGIN {
+    our @EXPORT_OK = qw/read_config compact_set $IMAP_text $IMAP_cond/;
+}
+
+
+# Regexes for RFC 3501's 'ATOM-CHAR', 'ASTRING-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_TEXT_CHAR    = qr/[\x01-\x09\x0B\x0C\x0E-\x7F]/;
+
+# Map each option to a regexp validating its values.
+my %OPTIONS = (
+    host => qr/\A([0-9a-zA-Z:.-]+)\z/,
+    port => qr/\A([0-9]+)\z/,
+    type => qr/\A(imaps?|preauth)\z/,
+    STARTTLS => qr/\A(true|false)\z/i,
+    username => qr/\A([\x01-\x7F]+)\z/,
+    password => qr/\A([\x01-\x7F]+)\z/,
+    auth => qr/\A($RE_ATOM_CHAR+(?: $RE_ATOM_CHAR+)*)\z/,
+    command => qr/\A(\P{Control}+)\z/,
+    'read-only' => qr/\A(TRUE|FALSE)\z/i,
+    SSL_ca_path => qr/\A(\P{Control}+)\z/,
+    SSL_cipher_list => qr/\A(\P{Control}+)\z/,
+    SSL_fingerprint => qr/\A([A-Za-z0-9]+\$\p{AHex}+)\z/,
+);
+
+
+#############################################################################
+# Utilities
+
+# read_config($conffile, $section, %opts)
+#   Read $conffile's default section, then $section (which takes
+#   precedence).  %opts extends %OPTIONS and maps each option to a
+#   regexp validating its values.
+sub read_config($$%) {
+    my $conffile = shift;
+    my $section = shift;
+    my %opts = (%OPTIONS, @_);
+
+    die "No such config file $conffile\n"
+        unless defined $conffile and -f $conffile and -r $conffile;
+
+    my $h = Config::Tiny::->read($conffile);
+    die "No such section $section\n" unless defined $h->{$section};
+
+    my $conf = $h->{_}; # default section
+    $conf->{$_} = $h->{$section}->{$_} foreach keys %{$h->{$section}};
+
+    # default values
+    $conf->{type} //= 'imaps';
+    $conf->{host} //= 'localhost';
+    $conf->{port} //= $conf->{type} eq 'imaps' ? 993 : $conf->{type} eq 'imap' ? 143 : undef;
+    $conf->{auth} //= 'PLAIN LOGIN';
+    $conf->{STARTTLS} //= 'TRUE';
+
+    # untaint and validate the config
+    foreach my $k (keys %$conf) {
+        die "Invalid option $k\n" unless defined $opts{$k};
+        next unless defined $conf->{$k};
+        die "Invalid option $k = $conf->{$k}\n" unless $conf->{$k} =~ $opts{$k};
+        $conf->{$k} = $1;
+    }
+    return %$conf;
+}
+
+
+# compact_set(@set).
+#   Compact the UID or sequence number set @set, which must be
+#   non-empty and may not contain '*'.  (Duplicates are allowed, but
+#   are removed).
+sub compact_set(@) {
+    my @set = sort {$a <=> $b} @_;
+    my $min = my $max = shift @set // die 'Empty range';
+    my $set;
+
+    while (@set) {
+        my $k = shift @set;
+        if ($k < $max) {
+            die "Non-sorted range: $k < $max"; # sanity check
+        }
+        elsif ($k == $max) { # skip duplicates
+        }
+        elsif ($k == $max + 1) {
+            $max++;
+        }
+        else {
+            $set .= ',' if defined $set;
+            $set .= $min == $max ? $min : "$min:$max";
+            $min = $max = $k;
+        }
+    }
+
+    $set .= ',' if defined $set;
+    $set .= $min == $max ? $min : "$min:$max";
+    return $set;
+}
+
+
+# in_set($x, $set)
+#   Return true if the UID or sequence number $x belongs to the set $set.
+#   /!\  The highest number in the mailbox, "*" should not appear by
+#   itself (other than in a range).
+sub in_set($$) {
+    my ($x, $set) = @_;
+    foreach my $r (split /,/, $set) {
+        if ($r =~ /\A([0-9]+)\z/) {
+            return 1 if $x == $1;
+        }
+        elsif ($r eq '*' or $r eq '*:*') {
+            warn "Assuming $x belongs to set $set!  (Dunno what \"*\" means.)";
+            return 1;
+        }
+        elsif ($r =~ /\A([0-9]+):\*\z/ or $r =~ /\A\*:([0-9]+)\z/) {
+            return 1 if $1 <= $x;
+        }
+        elsif ($r =~ /\A([0-9]+):([0-9]+)\z/) {
+            my ($min,$max) = $1 < $2 ? ($1,$2) : ($2,$1);
+            return 1 if $min <= $x and $x <= $max;
+        }
+    }
+    return 0;
+}
+
+
+# quote($str)
+#   Quote the given string if needed, or make it a (synchronizing)
+#   literal.  The literals will later be made non-synchronizing if the
+#   server is LITERAL+-capable (RFC 2088).
+sub quote($) {
+    my $str = shift;
+    if ($str =~ qr/\A$RE_ASTRING_CHAR+\z/) {
+        return $str;
+    }
+    elsif ($str =~ qr/\A$RE_TEXT_CHAR+\z/) {
+        $str =~ s/([\x22\x5C])/\\$1/g;
+        return "\"$str\"";
+    }
+    else {
+        return "{".length($str)."}\r\n".$str;
+    }
+}
+
+
+
+#############################################################################
+# Public interface
+# /!\ While this module can be used with non QRESYNC-capable (or non
+# QRESYNC-enabled) servers, there is no internal cache mapping sequence
+# numbers to UIDs, so EXPUNGE responses are ignored.
+
+# The IMAP authentication ('OK'/'PREAUTH'), bye ('BYE') or status
+# ('OK'/'NO'/'BAD') condition for the last command issued.
+our $IMAP_cond;
+
+# The response text for the last command issued (prefixed with the status
+# condition but without the tag).
+our $IMAP_text;
+
+
+# Create a new Net::IMAP::Sync object.  Connect to the server,
+# upgrade to a secure connection (STARTTLS), LOGIN/AUTHENTICATE if needed, and
+# update the CAPABILITY list.
+# In addition to the %OPTIONS above, valid parameters include:
+#
+#   - 'debug': Enable debug messages.
+#
+#   - 'enable': An extension or array reference of extensions to ENABLE
+#     (RFC 5161) after entering AUTH state.  Croak if the server did not
+#     advertize "ENABLE" in its CAPABILITY list or does not reply with
+#     an untagged ENABLED response with all the given extensions.
+#
+#   - 'STDERR': Where to log debug and informational messages (default:
+#     STDERR)
+#
+#   - 'name': An optional instance name to include in log messages.
+#
+#   - 'read-only': Use only commands that don't modify the server state.
+#      In particular, use EXAMINE in place of SELECT for mailbox
+#      selection.
+#
+#   - 'extra-attrs': An attribute or list of extra attributes to FETCH
+#     when getting new mails, in addition to (MODSEQ FLAGS INTERNALDATE
+#     BODY.PEEK[]).
+#
+sub new($%) {
+    my $class = shift;
+    my $self = { @_ };
+    bless $self, $class;
+
+    if ($self->{type} eq 'preauth') {
+        require 'IPC/Open2.pm';
+        my $command = $self->{command} // $self->fail("Missing preauth command");
+        my $pid = IPC::Open2::open2(@$self{qw/STDOUT STDIN/}, split(/ /, $command))
+            or $self->panic("Can't fork: $!");
+    }
+    else {
+        my %args = (Proto => 'tcp', Blocking => 1);
+        $args{PeerHost} = $self->{host} // $self->fail("Missing option host");
+        $args{PeerPort} = $self->{port} // $self->fail("Missing option port");
+
+        my $socket;
+        if ($self->{type} eq 'imap') {
+            require 'IO/Socket/INET.pm';
+            $socket = IO::Socket::INET->new(%args) or $self->fail("Cannot bind: $@");
+        }
+        else {
+            my $fpr = delete $self->{SSL_fingerprint};
+            $args{$_} = $self->{$_} foreach grep /^SSL_/, keys %$self;
+            require 'IO/Socket/SSL.pm';
+            $socket = IO::Socket::SSL->new(%args)
+                or $self->fail("Failed connect or SSL handshake: $!\n$IO::Socket::SSL::SSL_ERROR");
+
+            # ensure we're talking to the right server
+            $self->_fingerprint_match($socket, $fpr) if defined $fpr;
+        }
+
+        $socket->sockopt(SO_KEEPALIVE, 1);
+        $self->{$_} = $socket for qw/STDOUT STDIN/;
+    }
+    $self->{STDIN}->autoflush(0) // $self->panic("Can't turn off autoflush: $!");
+
+    # command counter
+    $self->{_TAG} = 0;
+
+    # internal cache, constantly updated to reflect the current server
+    # state for each mailbox
+    $self->{_CACHE} = {};
+
+    # persistent cache, describing the last clean (synced) state
+    $self->{_PCACHE} = {};
+
+    # list of UIDs for which the server a VANISHED or VANISHED (EARLIER)
+    # response.  /!\ requires a QRESYNC-capable server!
+    # Only notifications with UID < $self->{_PCACHE}->{$mailbox}->{UIDNEXT}
+    # are considered.
+    $self->{_VANISHED} = [];
+
+    # hash UID => [ MODSEQ, FLAGS ] for which the server a FETCH
+    # response with the FLAGS attribute.  The \Recent flag is always
+    # omitted from the FLAG list.  MODSEQ is always present, and the
+    # value [ MODSEQ, FLAGS ] is updated if another FETCH response with
+    # a higher MODSEQ is received.  If FLAGS is undefined, then the FLAG
+    # list of the message is considered unknown and should be retrieved
+    # manually.
+    # Only notifications with UID < $self->{_PCACHE}->{$mailbox}->{UIDNEXT}
+    # and with MODSEQ => $self->{_PCACHE}->{$mailbox}->{HIGHESTMODSEQ}
+    # are considered.
+    $self->{_MODIFIED} = {};
+
+    # whether we're allowed to to use read-write command
+    $self->{'read-only'} = uc ($self->{'read-only'} // 'FALSE') ne 'TRUE' ? 0 : 1;
+
+    # where to log
+    $self->{STDERR} //= \*STDERR;
+
+    # the IMAP state: one of 'UNAUTH', 'AUTH', 'SELECTED' or 'LOGOUT'
+    # (cf RFC 3501 section 3)
+    $self->{_STATE} = '';
+
+    # wait for the greeting
+    my $x = $self->_getline();
+    $x =~ s/\A\* (OK|PREAUTH) // or $self->panic($x);
+    $IMAP_cond = $1;
+    $IMAP_text = $1.' '.$x;
+
+    # try to update the cache (eg, capabilities)
+    $self->_resp_text($x);
+
+    if ($IMAP_cond eq 'OK') {
+        # login required
+        $self->{_STATE} = 'UNAUTH';
+        my @caps = $self->capabilities();
+
+        if ($self->{type} eq 'imap' and uc $self->{STARTTLS} ne 'FALSE') { # RFC 2595 section 5.1
+            $self->fail("Server did not advertize STARTTLS capability.")
+                unless grep {$_ eq 'STARTTLS'} @caps;
+
+            require 'IO/Socket/SSL.pm';
+            $self->_send('STARTTLS');
+
+            my $fpr = delete $self->{SSL_fingerprint};
+            my %sslargs = %$self{ grep /^SSL_/, keys %$self };
+            IO::Socket::SSL->start_SSL($self->{STDIN}, %sslargs)
+                or $self->fail("Failed SSL handshake: $!\n$IO::Socket::SSL::SSL_ERROR");
+
+            # ensure we're talking to the right server
+            $self->_fingerprint_match($self->{STDIN}, $fpr) if defined $fpr;
+
+            # refresh the previous CAPABILITY list since the previous one could have been spoofed
+            delete $self->{_CAPABILITIES};
+            @caps = $self->capabilities();
+        }
+
+        $self->fail("Logins are disabled.") if grep {$_ eq 'LOGINDISABLED'} @caps;
+        my @mechs = grep defined, map { /^AUTH=(.+)/ ? $1 : undef } @caps;
+        my $mech = (grep defined, map {my $m = $_; grep {$m eq $_} @mechs ? $m : undef}
+                                      split(/ /, $self->{auth}))[0];
+        $self->fail("Failed to choose an authentication mechanism") unless defined $mech;
+
+        my ($command, $callback);
+        my ($username, $password) = @$self{qw/username password/};
+
+        if ($mech eq 'LOGIN') {
+            $self->fail("Missing option $_") foreach grep {!defined $self->{$_}} qw/username password/;
+            $command = join ' ', 'LOGIN', quote($username), quote($password);
+        }
+        elsif ($mech eq 'PLAIN') {
+            require 'MIME/Base64.pm';
+            $self->fail("Missing option $_") foreach grep {!defined $self->{$_}} qw/username password/;
+            $command = "AUTHENTICATE $mech";
+            my $credentials = MIME::Base64::encode_base64("\x00".$username."\x00".$password, '');
+            $callback = sub($) {return $credentials};
+        }
+        else {
+            $self->fail("Unsupported authentication mechanism: $mech");
+        }
+
+        delete $self->{password}; # no need to remember passwords
+        $self->_send($command, $callback);
+        unless ($IMAP_text =~ /\A\Q$IMAP_cond\E \[CAPABILITY /) {
+            # refresh the CAPABILITY list since the previous one had only pre-login capabilities
+            delete $self->{_CAPABILITIES};
+            $self->capabilities();
+        }
+    }
+
+    $self->{_STATE} = 'AUTH';
+    my @extensions = !defined $self->{enable} ? ()
+                   : ref $self->{enable} eq 'ARRAY' ? @{$self->{enable}}
+                   : ($self->{enable});
+    if (@extensions) {
+        $self->fail("Server did not advertize ENABLE (RFC 5161) capability.") unless $self->_capable('ENABLE');
+        $self->_send('ENABLE '.join(' ',@extensions));
+        my @enabled = @{$self->{_ENABLED} // []};
+        $self->fail("Could not ENABLE $_") foreach
+            grep {my $e = $_; !grep {uc $e eq uc $_} @enabled} @extensions;
+    }
+
+    return $self;
+}
+
+
+# Close handles when the Net::IMAP::Sync object is destroyed.
+sub DESTROY($) {
+    my $self = shift;
+    foreach (qw/STDIN STDOUT/) {
+        $self->{$_}->close() if defined $self->{$_} and $self->{$_}->opened();
+    }
+    $self->{STDERR}->close() if defined $self->{STDERR} and $self->{STDERR}->opened()
+                                and $self->{STDERR} ne \*STDERR;
+}
+
+
+# $self->log($message, [...])
+#   Log a $message.
+sub log($@) {
+    my $self = shift;
+    return unless @_;
+    my $prefix = strftime "%b %e %H:%M:%S", localtime;
+    $prefix .= " $self->{name}" if defined $self->{name};
+    $prefix .= "($self->{_SELECTED})" if $self->{_STATE} eq 'SELECTED';
+    $prefix .= ': ';
+    my $stderr = $self->{STDERR};
+    print $stderr $prefix, @_, "\n";
+}
+
+
+# $self->warn($warning, [...])
+#   Log a $warning.
+sub warn($$@) {
+    my $self = shift;
+    $self->log('WARNING: ', @_);
+}
+
+
+# $self->fail($error, [...])
+#   Log an $error and exit with return value 1.
+sub fail($$@) {
+    my $self = shift;
+    $self->log('ERROR: ', @_);
+    exit 1;
+}
+
+
+# $self->panic($error, [...])
+#   Log a fatal $error including the position of the caller, and exit
+#   with return value 255.
+sub panic($@) {
+    my $self = shift;
+    my @loc = caller;
+    my $msg = "PANIC at line $loc[2] in $loc[1]";
+    $msg .= ': ' if @_;
+    $self->log($msg, @_);
+    exit 255;
+}
+
+
+# $self->capabilities()
+#   Return the capability list of the IMAP4 server.  The list is cached,
+#   and a CAPABILITY command is only issued if the cache is empty.
+sub capabilities($) {
+    my $self = shift;
+    $self->_send('CAPABILITY') unless defined $self->{_CAPABILITIES} and @{$self->{_CAPABILITIES}};
+    $self->fail("Missing IMAP4rev1 CAPABILITY.  Not an IMAP4 server?") unless $self->_capable('IMAP4rev1');
+    return @{$self->{_CAPABILITIES}};
+}
+
+
+# $self->incapable(@capabilities)
+#   In list context, return the list capabilties from @capabilities
+#   which were NOT advertized by the server.  In scalar context, return
+#   the length of said list.
+sub incapable($@) {
+    my ($self, @caps) = @_;
+    my @mycaps = $self->capabilities();
+    grep {my $cap = uc $_; !grep {$cap eq uc $_} @mycaps} @caps;
+}
+
+
+# $self->search($criterion)
+#   Issue an UID SEARCH command with the given $criterion.  Return the
+#   list of matching UIDs.
+sub search($$) {
+    my ($self, $crit) = @_;
+    my @res;
+    $self->_send('UID SEARCH '.$crit, sub(@) {push @res, @_});
+    return @res
+}
+
+
+# $self->select($mailbox)
+# $self->examine($mailbox)
+#   Issue a SELECT or EXAMINE command for the $mailbox. (Always use
+#   EXAMINE if the 'read-only' flag is set.)  Upon success, change the
+#   state to SELECTED, otherwise go back to AUTH.
+sub select($$) {
+    my $self = shift;
+    my $mailbox = shift;
+    my $cmd = $self->{'read-only'} ? 'EXAMINE' : 'SELECT';
+    $self->_select_or_examine($cmd, $mailbox);
+}
+sub examine($$) {
+    my $self = shift;
+    my $mailbox = shift;
+    $self->_select_or_examine('EXAMINE', $mailbox);
+}
+
+
+# $self->logout()
+#   Issue a LOGOUT command.  Change the state to LOGOUT.
+sub logout($) {
+    my $self = shift;
+    $self->_send('LOGOUT');
+    $self->{_STATE} = 'LOGOUT';
+    undef $self;
+}
+
+
+# $self->noop()
+#   Issue a NOOP command.
+sub noop($) {
+    shift->_send('NOOP');
+}
+
+
+# $self->create($mailbox)
+# $self->delete($mailbox)
+#   CREATE or DELETE $mailbox.  Requires the 'read-only' flag to be unset.
+sub create($$) {
+    my ($self, $mailbox) = @_;
+    $self->fail("Server is read-only.") if $self->{'read-only'};
+    $self->_send("CREATE ".quote($mailbox));
+}
+sub delete($$) {
+    my ($self, $mailbox) = @_;
+    $self->fail("Server is read-only.") if $self->{'read-only'};
+    #$self->_send("DELETE ".quote($mailbox));
+    delete $self->{_CACHE}->{$mailbox};
+    delete $self->{_PCACHE}->{$mailbox};
+}
+
+
+# $self->rename($oldname, $newname)
+#   RENAME the mailbox $oldname to $newname.  Requires the 'read-only'
+#   flag to be unset.
+sub rename($$$) {
+    my ($self, $from, $to) = @_;
+    $self->fail("Server is read-only.") if $self->{'read-only'};
+    $self->_send("RENAME ".quote($from).' '.quote($to));
+    $self->{_CACHE}->{$to}  = delete $self->{_CACHE}->{$from}  if exists $self->{_CACHE}->{$from};
+    $self->{_PCACHE}->{$to} = delete $self->{_PCACHE}->{$from} if exists $self->{_PCACHE}->{$from};
+}
+
+
+# $self->subscribe($mailbox)
+# $self->unsubscribe($mailbox)
+#   SUBSCRIBE or UNSUBSCRIBE $mailbox.  Requires the 'read-only' flag to
+#   be unset.
+sub subscribe($$) {
+    my ($self, $mailbox) = @_;
+    $self->fail("Server is read-only.") if $self->{'read-only'};
+    $self->_send("SUBSCRIBE ".quote($mailbox));
+}
+sub unsubscribe($$) {
+    my ($self, $mailbox) = @_;
+    $self->fail("Server is read-only.") if $self->{'read-only'};
+    $self->_send("UNSUBSCRIBE ".quote($mailbox));
+}
+
+
+# $self->list($criterion, @parameters)
+#   Issue a LIST command with the given $criterion and @parameters.
+#   Return a pair where the first component is a hash reference of
+#   matching mailboxes and their flags, and the second component is a
+#   hash reference of matching mailboxes and their hierarchy delimiter
+#   (or undef for flat mailboxes).
+sub list($$@) {
+    my $self = shift;
+    my $crit = shift;
+    my %mailboxes;
+    my %delims;
+    $self->_send( "LIST ".$crit.(@_ ? (' RETURN ('.join(' ', @_).')') : ''),
+                  sub($$@) {my $name = shift; $delims{$name} = shift; $mailboxes{$name} = \@_;} );
+    return (\%mailboxes, \%delims);
+}
+
+
+# $self->remove($uid, [...])
+#   Remove the given $uid list.  Croak if the server did not advertize
+#   "UIDPLUS" (RFC 4315) in its CAPABILITY list.
+#   Successfully EXPUNGEd UIDs are removed from the pending VANISHED and
+#   MODIFIED lists.
+#   Return the list of UIDs that could not be EXPUNGEd.
+sub remove($@) {
+    my $self = shift;
+    my @set = @_;
+    $self->fail("Server did not advertize UIDPLUS (RFC 4315) capability.")
+        if $self->incapable('UIDPLUS');
+
+    my $set = compact_set(@set);
+    $self->_send("UID STORE $set +FLAGS.SILENT (\\Deleted)");
+    $self->_send("UID EXPUNGE $set"); # RFC 4315 UIDPLUS
+
+    my %vanished = map {$_ => 1} @{$self->{_VANISHED}};
+
+    my @failed;
+    foreach my $uid (@set) {
+        if (exists $vanished{$uid}) {
+            # ignore succesfully EXPUNGEd messages
+            delete $vanished{$uid};
+            delete $self->{_MODIFIED}->{$uid};
+        } else {
+            push @failed, $uid;
+        }
+    }
+    $self->{_VANISHED} = [ keys %vanished ];
+
+    $self->warn("Could not EXPUNGE UID(s) ".compact_set(@failed)) if @failed;
+    return @failed;
+}
+
+
+# $self->append($mailbox, RFC822, [FLAGS, [INTERNALDATE, ...]])
+#   Issue an APPEND command with the given mails.  Croak if the server
+#   did not advertize "UIDPLUS" (RFC 4315) in its CAPABILITY list.
+#   Providing multiple mails is only allowed for servers advertizing
+#   "MULTIAPPEND" (RFC 3502) in their CAPABILITY list.
+#   Return the list of UIDs allocated for the new messages.
+sub append($$$@) {
+    my $self = shift;
+    my $mailbox = shift;
+    $self->fail("Server is read-only.") if $self->{'read-only'};
+    $self->fail("Server did not advertize UIDPLUS (RFC 4315) capability.")
+        if $self->incapable('UIDPLUS');
+
+    my @appends;
+    while (@_) {
+        my $rfc822 = shift;
+        my $flags = shift;
+        my $internaldate = shift;
+        my $append = '';
+        $append .= '('.join(' ',@$flags).') ' if defined $flags;
+        $append .= '"'.$internaldate.'" ' if defined $internaldate;
+        $append .= "{".length($rfc822)."}\r\n".$rfc822;
+        push @appends, $append;
+    }
+    $self->fail("Server did not advertize MULTIAPPEND (RFC 3502) capability.")
+        if $#appends > 0 and $self->incapable('MULTIAPPEND');
+
+    # dump the cache before issuing the command if we're appending to the current mailbox
+    my ($UIDNEXT, $EXISTS, $cache, %vanished);
+    if (defined $self->{_SELECTED} and $mailbox eq $self->{_SELECTED}) {
+        $cache = $self->{_CACHE}->{$mailbox};
+        $UIDNEXT = $cache->{UIDNEXT} // $self->panic();
+        $EXISTS  = $cache->{EXISTS}  // $self->panic();
+        %vanished = map {$_ => 1} @{$self->{_VANISHED}};
+    }
+
+    $self->_send('APPEND '.quote($mailbox).' '.join(' ',@appends));
+    $IMAP_text =~ /\A\Q$IMAP_cond\E \[APPENDUID ([0-9]+) ([0-9:,]+)\] / or $self->panic($IMAP_text);
+    my ($uidvalidity, $uidset) = ($1, $2);
+    $self->_update_cache_for($mailbox, UIDVALIDITY => $uidvalidity);
+
+    my @uids;
+    foreach (split /,/, $uidset) {
+        if (/\A([0-9]+)\z/) {
+            $UIDNEXT = $1 + 1 if $UIDNEXT < $1;
+            push @uids, $1;
+        } elsif (/\A([0-9]+):([0-9]+)\z/) {
+            my ($min, $max) = $1 <= $2 ? ($1,$2) : ($2,$1);
+            push @uids, ($min .. $max);
+            $UIDNEXT = $max + 1 if $UIDNEXT < $max;
+        } else {
+            $self->panic($_);
+        }
+    }
+    $self->fail("$uidset contains ".scalar(@uids)." elements while "
+                 .scalar(@appends)." messages were appended.")
+        unless $#uids == $#appends;
+
+    # if $mailbox is the current mailbox we need to update the cache
+    if (defined $self->{_SELECTED} and $mailbox eq $self->{_SELECTED}) {
+        # EXISTS responses SHOULD be sent by the server (per RFC3501), but it's not required
+        my %vanished2 = map {$_ => 1} @{$self->{_VANISHED}};
+        delete $vanished2{$_} foreach keys %vanished;
+        my $VANISHED = scalar(keys %vanished2); # number of messages VANISHED meanwhile
+        $cache->{EXISTS} += $#appends+1 if defined $cache->{EXISTS} and $cache->{EXISTS} + $VANISHED == $EXISTS;
+        $cache->{UIDNEXT} = $UIDNEXT    if ($cache->{UIDNEXT} // 0) < $UIDNEXT;
+    }
+
+    return @uids;
+}
+
+
+# $self->notify(@specifications)
+#   Issue a NOTIFY command with the given mailbox @specifications (cf RFC
+#   5465 section 6) to be monitored.  Croak if the server did not
+#   advertize "NOTIFY" (RFC 5465) in its CAPABILITY list.
+sub notify($@) {
+    my $self = shift;
+    $self->fail("Server did not advertize NOTIFY (RFC 5465) capability.")
+        if $self->incapable('NOTIFY');
+    my $events = join ' ', qw/MessageNew MessageExpunge FlagChange MailboxName SubscriptionChange/;
+    # Be notified of new messages with EXISTS/RECENT responses, but
+    # don't receive unsolicited FETCH responses with a RFC822/BODY[].
+    # It costs us an extra roundtrip, but we need to sync FLAG updates
+    # and VANISHED responses in batch mode, update the HIGHESTMODSEQ,
+    # and *then* issue an explicit UID FETCH command to get new message,
+    # and process each FETCH response with a RFC822/BODY[] attribute as
+    # they arrive.
+    my $command = 'NOTIFY ';
+    $command .= @_ ? ('SET '. join(' ', map {"($_ ($events))"} @_)) : 'NONE';
+    $self->_send($command);
+}
+
+
+# $self->slurp()
+#   Turn on non-blocking IO, try to as many lines as possible, then turn
+#   non-blocking IO back off and return the number of lines read.
+#   This is mostly useful when waiting for notifications while no
+#   command is progress, cf. RFC 5465 (NOTIFY).
+sub slurp($) {
+    my $self = shift;
+    my $read = 0;
+    $self->{STDOUT}->blocking(0) // $self->panic("Can't turn on non-blocking IO: $!");
+    while (defined (my $x = $self->_getline())) {
+        $self->_resp($x);
+        $read++
+    }
+    $self->{STDOUT}->blocking(1) // $self->panic("Can't turn off non-blocking IO: $!");
+    return $read;
+}
+
+
+# $self->set_cache( $mailbox, STATE )
+#   Initialize or update the persistent cache, that is, associate a
+#   known $mailbox with the last known (synced) state:
+#     * UIDVALIDITY
+#     * UIDNEXT: Any message the UID of which is at least UIDNEXT is
+#       considered new and must be downloaded.  (If 0 or missing, all
+#       messages in $mailbox are considered new.)  Note that while all
+#       UIDs in the map are <UIDNEXT, the message with UID UIDNEXT-1 may
+#       have been deleted hence may no longer be present in $mailbox.
+#     * HIGHESTMODSEQ: Any change with MODSEQ <= HIGHESTMODSEQ have been
+#       processed.  (Note however that new messages may have a lower
+#       MODSEQ.)  Always present when UIDNEXT is present.
+sub set_cache($$%) {
+    my $self = shift;
+    my $mailbox = shift // $self->panic();
+    my $cache = $self->{_PCACHE}->{$mailbox} //= {};
+
+    my %status = @_;
+    while (my ($k, $v) = each %status) {
+        if ($k eq 'UIDVALIDITY') {
+            # try to detect UIDVALIDITY changes early (before starting the sync)
+            $self->fail("UIDVALIDITY changed! ($cache->{UIDVALIDITY} != $v)  ",
+                         "Need to invalidate the UID cache.")
+                if defined $cache->{UIDVALIDITY} and $cache->{UIDVALIDITY} != $v;
+        }
+        $cache->{$k} = $v;
+    }
+
+    $self->log("Update last clean state for $mailbox: ".
+               '('.join(' ', map {"$_ $cache->{$_}"} keys %$cache).')')
+        if $self->{debug};
+}
+
+
+# $self->uidvalidity([$mailbox])
+#   Return the UIDVALIDITY for $mailbox, or hash mapping each mailbox to
+#   its UIDVALIDITY if $mailbox is omitted.
+sub uidvalidity($;$) {
+    my $self = shift;
+    my $mailbox = shift;
+    if (defined $mailbox) {
+        my $cache = $self->{_CACHE}->{$mailbox} // return;
+        return $cache->{UIDVALIDITY};
+    }
+    else {
+        my %uidvalidity;
+        while (my ($mbx,$cache) = each %{$self->{_CACHE}}) {
+            $uidvalidity{$mbx} = $cache->{UIDVALIDITY} if ($cache->{UIDVALIDITY} // 0) > 0;
+        }
+        return %uidvalidity;
+    }
+}
+
+
+# $self->set_cache(@attributes)
+#   Return the persistent cache for the mailbox currently selected.  If
+#   some @attributes are given, return the list of values corresponding
+#   to these attributes.
+#   /!\  Should only be called right after pull_updates!
+#   Croak if there are unprocessed VANISHED responses or FLAG updates.
+sub get_cache($@) {
+    my $self = shift;
+    $self->fail("Invalid method 'get_cache' in state $self->{_STATE}")
+        unless $self->{_STATE} eq 'SELECTED';
+    my $mailbox = $self->{_SELECTED} // $self->panic();
+
+    $self->fail("Pending VANISHED responses!") if @{$self->{_VANISHED}};
+    $self->fail("Pending FLAG updates!")       if %{$self->{_MODIFIED}};
+
+    my $cache = $self->{_PCACHE}->{$mailbox};
+    return @_ ? @$cache{@_} : %$cache;
+}
+
+
+# $self->is_dirty($mailbox)
+#   Return true if there are pending updates for $mailbox, i.e., its
+#   internal cache is newer than its persistent cache.
+sub is_dirty($$) {
+    my ($self, $mailbox) = @_;
+    my $cache = $self->{_CACHE}->{$mailbox}   // return 1;
+    my $pcache = $self->{_PCACHE}->{$mailbox} // return 1;
+
+    if (defined $pcache->{HIGHESTMODSEQ} and defined $cache->{HIGHESTMODSEQ}
+            and $pcache->{HIGHESTMODSEQ} == $cache->{HIGHESTMODSEQ} and
+        defined $pcache->{UIDNEXT} and defined $cache->{UIDNEXT}
+            and $pcache->{UIDNEXT} == $cache->{UIDNEXT}) {
+        return 0
+    } else {
+        return 1
+    }
+}
+
+
+# $self->next_dirty_mailbox(@mailboxes)
+#   Return the name of a dirty mailbox, or undef if all mailboxes are
+#   clean.  If @mailbox is non-empty, only consider mailboxes in that
+#   list.
+sub next_dirty_mailbox($@) {
+    my $self = shift;
+    my %mailboxes = map {$_ => 1} @_;
+    my @dirty = grep { (!%mailboxes or $mailboxes{$_}) and $self->is_dirty($_) }
+                     keys %{$self->{_CACHE}};
+    if ($self->{debug}) {
+        @dirty ? $self->log("Dirty mailboxes: ".join(', ', @dirty))
+               : $self->log("Clean state!");
+    }
+    return $dirty[0];
+}
+
+
+# $self->pull_updates()
+#   Get pending updates (unprocessed VANISHED responses and FLAG
+#   updates), and empty these lists from the cache.
+#   Finally, update the HIGHESTMODSEQ from the persistent cache to the
+#   value found in the internal cache.
+sub pull_updates($) {
+    my $self = shift;
+    my $mailbox = $self->{_SELECTED} // $self->panic();
+    my $pcache = $self->{_PCACHE}->{$mailbox};
+
+    my (@vanished, %modified);
+    unless (defined $pcache->{UIDNEXT} and defined $pcache->{HIGHESTMODSEQ}) {
+            $self->{_MODIFIED} = {};
+            $self->{_VANISHED} = [];
+    }
+    else {
+        my @missing;
+        while (%{$self->{_MODIFIED}}) {
+            while (my ($uid,$v) = each %{$self->{_MODIFIED}}) {
+                # don't filter on the fly (during FETCH responses) because
+                # FLAG updates can arrive while processing pull_new_messages
+                # for instance
+                if (defined $v->[1] and $v->[0] > 0) { # setting the MODSEQ to 0 forces a FETCH
+                    next unless $uid    < $pcache->{UIDNEXT}        # out of bounds
+                            and $v->[0] > $pcache->{HIGHESTMODSEQ}; # already seen
+                    $modified{$uid} = $v->[1];
+                } else {
+                    push @missing, $uid;
+                }
+            }
+            $self->{_MODIFIED} = {};
+            $self->_send("UID FETCH ".compact_set(@missing)." (MODSEQ FLAGS)") if @missing;
+            @missing = ();
+        }
+    
+        # do that afterwards since the UID FETCH command above can produce VANISHED responses
+        my %vanished = map {$_ => 1} @{$self->{_VANISHED}};
+        my @vanished = keys %vanished;
+        $self->{_VANISHED} = [];
+    
+        # ignore FLAG updates on VANISHED messages
+        delete @modified{@vanished};
+    }
+
+    # update the persistent cache for HIGHESTMODSEQ (not for UIDNEXT
+    # since there might be new messages)
+    $self->set_cache($mailbox, %{$self->{_CACHE}->{$mailbox}}{HIGHESTMODSEQ});
+
+    return (\@vanished, \%modified);
+}
+
+
+# $self->pull_new_messages($callback, @ignore)
+#   FETCH new messages since the UIDNEXT found in the persistent cache
+#   (or 1 in no such UIDNEXT is found), and process each response on the
+#   fly with the callback.
+#   If an @ignore list is supplied, then these messages are ignored from
+#   the UID FETCH range.
+#   Finally, update the UIDNEXT from the persistent cache to the value
+#   found in the internal cache.
+#   /!\ Use pull_updates afterwards to udpate the HIGHESTMODSEQ!
+sub pull_new_messages($$@) {
+    my $self = shift;
+    my $callback = shift;
+    my @ignore = sort { $a <=> $b } @_;
+    my @attrs = !defined $self->{'extra-attrs'} ? ()
+                   : ref $self->{'extra-attrs'} eq 'ARRAY' ? @{$self->{'extra-attrs'}}
+                   : ($self->{'extra-attrs'});
+    my $attrs = join ' ', qw/MODSEQ FLAGS INTERNALDATE/, @attrs, 'BODY.PEEK[]';
+
+    my $mailbox = $self->{_SELECTED} // $self->panic();
+    my $since = $self->{_PCACHE}->{$mailbox}->{UIDNEXT} // 1;
+
+    my $range = '';
+    my $first;
+    foreach my $uid (@ignore) {
+        if ($since < $uid) {
+            $first //= $since;
+            $range .= ',' if $range ne '';
+            $range .= $since;
+            $range .= ':'.($uid-1) if $since < $uid-1;
+            $since = $uid+1;
+        }
+        elsif ($since == $uid) {
+            $since++;
+        }
+    }
+
+    $first //= $since;
+    $range .= ',' if $range ne '';
+    # 2^32-1: don't use '*' since the highest UID can be known already
+    $range .= "$since:4294967295";
+
+    my $UIDNEXT = $self->{_CACHE}->{$mailbox}->{UIDNEXT};
+    $self->panic() unless defined $UIDNEXT and $UIDNEXT > 0; # sanity check
+
+    $self->_send("UID FETCH $range ($attrs)", $callback) if $first < $UIDNEXT;;
+
+    # update the persistent cache for UIDNEXT (not for HIGHESTMODSEQ
+    # since there might be pending updates)
+    $self->set_cache($mailbox, %{$self->{_CACHE}->{$mailbox}}{UIDNEXT});
+}
+
+
+# $self->push_flag_updates($flags, @set)
+#   Change the flags to each UID in @set to $flags.
+#   A flag update fails for mails being updated after the HIGHESTMODSEQ
+#   found in the persistent cache; push such messages to the MODIFIED
+#   list.
+sub push_flag_updates($$@) {
+    my $self = shift;
+    my $flags = shift;
+    my @set = @_;
+
+    my $mailbox = $self->{_SELECTED} // $self->panic();
+    my $modseq = $self->{_PCACHE}->{$mailbox}->{HIGHESTMODSEQ} // $self->panic();
+    my $command = "UID STORE ".compact_set(@set)." FLAGS.SILENT ($flags) (UNCHANGEDSINCE $modseq)";
+
+    my %listed;
+    $self->_send($command, sub(%) { my %mail = @_; $listed{$mail{UID}}++; });
+
+    my %failed;
+    if ($IMAP_text =~ /\A\Q$IMAP_cond\E \[MODIFIED ([0-9,:]+)\] $RE_TEXT_CHAR+\z/) {
+        foreach (split /,/, $1) {
+            if (/\A([0-9]+)\z/) {
+                $failed{$1} = 1;
+            }
+            elsif (/\A([0-9]+):([0-9]+)\z/) {
+                my ($min, $max) = $1 < $2 ? ($1,$2) : ($2,$1);
+                $failed{$_} = 1 foreach ($min .. $max);
+            }
+            else {
+                $self->panic($_);
+            }
+        }
+    }
+
+    foreach my $uid (@set) {
+        if ($failed{$uid}) {
+            # $uid was listed in the MODIFIED response code
+            $self->{_MODIFIED}->{$uid} //= [ 0, undef ]; # will be downloaded again in pull_updates
+            delete $self->{_MODIFIED}->{$uid} if
+                # got a FLAG update for $uid; ignore it if it's $flags
+                defined $self->{_MODIFIED}->{$uid}->[1] and
+                $self->{_MODIFIED}->{$uid}->[1] eq $flags;
+        }
+        else {
+            # $uid wasn't listed in the MODIFIED response code
+            next unless defined $self->{_MODIFIED}->{$uid}; # already stored
+            $self->panic() unless defined $listed{$uid} and $listed{$uid} > 0; # sanity check
+            if ($listed{$uid} == 1) {
+                # ignore succesful update
+                delete $self->{_MODIFIED}->{$uid};
+            }
+            elsif ($self->{_MODIFIED}->{$uid}->[1] and $self->{_MODIFIED}->{$uid}->[1] eq $flags) {
+                # got multiple FETCH responses for $uid, the last one with $flags
+                delete $self->{_MODIFIED}->{$uid};
+            }
+        }
+    }
+    return keys %failed;
+}
+
+
+#############################################################################
+# Private methods
+
+
+# $self->_fingerprint_match($socket, $fingerprint)
+#   Croak unless the fingerprint of the peer certificate of the
+#   IO::Socket::SSL object doesn't match the given $fingerprint.
+sub _fingerprint_match($$$) {
+    my ($self, $socket, $fpr) = @_;
+
+    my $algo = $fpr =~ /^([^\$]+)\$/ ? $1 : 'sha256';
+    my $fpr2 = $socket->get_fingerprint($algo);
+    $fpr =~ s/.*\$//;
+    $fpr2 =~ s/.*\$//;
+    $self->fail("Fingerprint don't match!  MiTM in action?") unless uc $fpr eq uc $fpr2;
+}
+
+
+# $self->_getline([$msg])
+#   Read a line from the handle and strip the trailing CRLF.
+sub _getline($;$) {
+    my $self = shift;
+    my $msg = shift // '';
+
+    my $x = $self->{STDOUT}->getline() // return; # non-blocking IO
+    $x =~ s/\r\n\z// or $self->panic($x);
+    $self->log("S: $msg", $x) if $self->{debug};
+    return $x;
+}
+
+
+# $self->_update_cache( ATTRIBUTE => VALUE, [...] )
+#   Update the internal cache for the currently selected mailbox with
+#   the given attributes and values.
+sub _update_cache($%) {
+    my $self = shift;
+    $self->_update_cache_for($self->{_SELECTED}, @_);
+}
+
+
+# $self->_update_cache_for( $mailbox, ATTRIBUTE => VALUE, [...] )
+#   Update the internal cache for $mailbox with the given attributes and
+#   values.
+sub _update_cache_for($$%) {
+    my $self = shift;
+    my $mailbox = shift // $self->panic();
+    my $cache = $self->{_CACHE}->{$mailbox} //= {};
+
+    my %status = @_;
+    while (my ($k, $v) = each %status) {
+        if ($k eq 'UIDVALIDITY') {
+            # try to detect UIDVALIDITY changes early (before starting the sync)
+            $self->fail("UIDVALIDITY changed! ($cache->{UIDVALIDITY} != $v)  ",
+                         "Need to invalidate the UID cache.")
+                if defined $cache->{UIDVALIDITY} and $cache->{UIDVALIDITY} != $v;
+            $self->{_PCACHE}->{$mailbox}->{UIDVALIDITY} //= $v;
+        }
+        $cache->{$k} = $v;
+    }
+}
+
+
+# $self->_send($command, [$callback])
+#   Send the given $command to the server, then wait for the response.
+#   (The status condition and response text are respectively placed in
+#   $IMAP_cond and $IMAP_text.)  Each untagged response received in the
+#   meantime is read, parsed and processed.  The optional $callback, if
+#   given, is executed with all untagged responses associated with the
+#   command.
+#   In void context, croak unless the server answers with a tagged 'OK'
+#   response.  Otherwise, return the condition status ('OK'/'NO'/'BAD').
+sub _send($$;&) {
+    my ($self, $command, $callback) = @_;
+    my $cmd = $command =~ /\AUID ($RE_ATOM_CHAR+) / ? $1 : $command =~ /\A($RE_ATOM_CHAR+) / ? $1 : $command;
+    my $set = $command =~ /\AUID (?:FETCH|STORE) ([0-9:,*]+)/ ? $1 : undef;
+
+    # send the command; for servers supporting non-synchronizing
+    # literals, mark literals as such and then the whole command in one
+    # go, otherwise send literals one at a time
+    my $tag = sprintf '%06d', $self->{_TAG}++;
+    my $prefix = $tag.' ';
+    while ($command =~ s/\A(.*?)\{([0-9]+)\}\r\n//) {
+        my ($str, $len) = ($1, $2);
+        my $lit = substr $command, 0, $len, ''; # consume the literal
+
+        if ($self->_capable('LITERAL+')) { # RFC 2088 LITERAL+
+            $self->log('C: ', ($prefix ne '' ? $prefix : '[...]'), $str, "{$len+}") if $self->{debug};
+            $self->{STDIN}->print($prefix, $str, "{$len+}\r\n");
+        }
+        else {
+            $self->log('C: ', ($prefix ne '' ? $prefix : '[...]'), $str, "{$len}") if $self->{debug};
+            $self->{STDIN}->print($prefix, $str, "{$len}\r\n");
+            $self->{STDIN}->flush();
+            my $x = $self->_getline();
+            $x =~ /\A\+ / or $self->panic($x);
+        }
+        $self->{STDIN}->print($lit);
+        $prefix = '';
+    }
+    $self->log('C: ', ($prefix ne '' ? $prefix : '[...]'), $command) if $self->{debug};
+    $self->{STDIN}->print($prefix, $command, "\r\n");
+    $self->{STDIN}->flush();
+
+    my $r;
+    # wait for the answer
+    while (defined($_ = $self->_getline())) {
+        if (s/\A\Q$tag\E (OK|NO|BAD) //) {
+            $IMAP_cond = $1;
+            $IMAP_text = $1.' '.$_;
+            $self->_resp_text($_);
+            $self->fail($IMAP_text, "\n") unless defined wantarray or $IMAP_cond eq 'OK';
+            $r = $1;
+            last;
+        }
+        else {
+            $self->_resp($_, $cmd, $set, $callback);
+        }
+    }
+
+    if (defined $self->{_SELECTED}) {
+        my $mailbox = $self->{_SELECTED};
+        my $cache = $self->{_CACHE}->{$mailbox};
+        # can't keep track of the modification sequences
+        $self->fail("Mailbox $mailbox doesn't support MODSEQ.")
+            if $cache->{NOMODSEQ} and $self->_enabled('QRESYNC');
+        $self->fail("Mailbox $mailbox does not support persistent UIDs.")
+            if defined $cache->{UIDNOTSTICKY};
+    }
+
+    return $r;
+}
+
+
+# $self->_capable($capability, [...])
+#   Return true if each $capability is listed in the server's CAPABILITY
+#   list.
+sub _capable($@) {
+    my $self = shift;
+    return 0 unless defined $self->{_CAPABILITIES};
+    foreach my $cap (@_) {
+        return 0 unless grep {uc $cap eq uc $_} @{$self->{_CAPABILITIES}};
+    }
+    return 1;
+}
+
+
+# $self->_capable($extension)
+#   Return true if $extension has been enabled by the server, i.e., the
+#   server sent an untagged ENABLED response including it.
+sub _enabled($$) {
+    my $self = shift;
+    my $ext = uc shift;
+    grep {$ext eq uc $_} @{$self->{_ENABLED} // []};
+}
+
+
+# $self->_open_mailbox($mailbox)
+#   Initialize the internal and persistent caches for $mailbox, and mark
+#   it as selected.
+sub _open_mailbox($$) {
+    my $self = shift;
+    my $mailbox = shift;
+
+    # it is safe to wipe cached VANISHED responses or FLAG updates,
+    # because interesting stuff must have made the mailbox dirty so
+    # we'll get back to it
+    $self->{_VANISHED} = [];
+    $self->{_MODIFIED} = {};
+
+    $self->{_SELECTED} = $mailbox;
+    $self->{_CACHE}->{$mailbox} //= {};
+
+    # always reset EXISTS to keep track of new mails
+    delete $self->{_CACHE}->{$mailbox}->{EXISTS};
+}
+
+
+# $self->_select_or_examine($command, $mailbox)
+#   Issue a SELECT or EXAMINE command for the $mailbox. (Always use
+#   EXAMINE if the 'read-only' flag is set.)  Upon success, change the
+#   state to SELECTED, otherwise go back to AUTH.
+sub _select_or_examine($$$) {
+    my $self = shift;
+    my $command = shift;
+    my $mailbox = shift;
+
+    my $pcache = $self->{_PCACHE}->{$mailbox} //= {};
+    my $cache = $self->{_CACHE}->{$mailbox} //= {};
+    $cache->{UIDVALIDITY} = $pcache->{UIDVALIDITY} if defined $pcache->{UIDVALIDITY};
+
+    $mailbox = uc $mailbox eq 'INBOX' ? 'INBOX' : $mailbox; # INBOX is case-insensitive
+    $command .= ' '.quote($mailbox);
+    $command .= " (QRESYNC ($pcache->{UIDVALIDITY} $pcache->{HIGHESTMODSEQ} "
+                           ."1:".($pcache->{UIDNEXT}-1)."))"
+        if $self->_enabled('QRESYNC') and
+           ($pcache->{HIGHESTMODSEQ} // 0) > 0 and ($pcache->{UIDNEXT} // 0) > 0;
+
+    if ($self->{_STATE} eq 'SELECTED' and ($self->_capable('CONDSTORE') or $self->_capable('QRESYNC'))) {
+        # A mailbox is currently selected and the server advertizes
+        # 'CONDSTORE' or 'QRESYNC' (RFC 7162).  Delay the mailbox
+        # selection until the [CLOSED] response code has been received:
+        # all responses before the [CLOSED] response code refer to the
+        # previous mailbox ($self->{_SELECTED}), while all subsequent
+        # responses refer to the new mailbox $self->{_SELECTED_DELAYED}.
+        $self->{_SELECTED_DELAYED} = $mailbox;
+    }
+    else {
+        $self->_open_mailbox($mailbox);
+    }
+
+    $self->{_STATE} = 'AUTH';
+    if ($self->_send($command) eq 'OK') {
+        $self->{_STATE} = 'SELECTED';
+    } else {
+        delete $self->{_SELECTED};
+    }
+}
+
+
+
+#############################################################################
+# Parsing methods
+#
+
+# Parse an RFC 3501 (+extensions) resp-text, and update the cache when needed.
+sub _resp_text($$) {
+    my $self = shift;
+    local $_ = shift;
+
+    if (/\A\[ALERT\] $RE_TEXT_CHAR+\z/) {
+        print STDERR $_, "\n";
+    }
+    elsif (/\A\[BADCHARSET .*\] $RE_TEXT_CHAR+\z/) {
+        $self->fail($_);
+    }
+    elsif (/\A\[CAPABILITY((?: $RE_ATOM_CHAR+)+)\] $RE_TEXT_CHAR+\z/) {
+        $self->{_CAPABILITIES} = [ split / /, ($1 =~ s/^ //r) ];
+    }
+    elsif (/\A\[PERMANENTFLAGS \(((?:(?:\\?$RE_ATOM_CHAR+|\\\*)(?: (?:\\?$RE_ATOM_CHAR+|\\\*))*))\)\] $RE_TEXT_CHAR+\z/) {
+        $self->_update_cache( PERMANENTFLAGS => [ split / /, $1 ] );
+    }
+    elsif (/\A\[(READ-ONLY|READ-WRITE)\] $RE_TEXT_CHAR+\z/) {
+        $self->_update_cache($1 => 1);
+    }
+    elsif (/\A\[(UIDNEXT|UIDVALIDITY|UNSEEN) ([0-9]+)\] $RE_TEXT_CHAR+\z/) {
+        $self->_update_cache($1 => $2);
+    }
+    elsif (/\A\[HIGHESTMODSEQ ([0-9]+)\] $RE_TEXT_CHAR+\z/) {
+        # RFC 4551/7162 CONDSTORE/QRESYNC
+        $self->_update_cache(HIGHESTMODSEQ => $1);
+    }
+    elsif (/\A\[NOMODSEQ\] $RE_TEXT_CHAR+\z/) {
+        # RFC 4551/7162 CONDSTORE/QRESYNC
+        $self->_update_cache(NOMODSEQ => 1);
+    }
+    elsif (/\A\[CLOSED\] $RE_TEXT_CHAR+\z/) {
+        # RFC 7162 CONDSTORE/QRESYNC
+        # Update the selected mailbox: previous responses refer to the
+        # previous mailbox ($self->{_SELECTED}), while all subsequent
+        # responses refer to the new mailbox $self->{_SELECTED_DELAYED}.
+        my $mailbox = delete $self->{_SELECTED_DELAYED} // $self->panic();
+        $self->_open_mailbox($mailbox);
+    }
+    elsif (/\A\[(?:NOTIFICATIONOVERFLOW|BADEVENT .*)\] $RE_TEXT_CHAR+\z/) {
+        # RFC 5465 NOTIFY
+        $self->fail($_);
+    }
+    elsif (/\A\[UIDNOTSTICKY\] $RE_TEXT_CHAR+\z/) {
+        # RFC 4315 UIDPLUS
+        $self->_update_cache(UIDNOTSTICKY => 1);
+    }
+}
+
+# Parse and consume an RFC 3501 nstring (string / "NIL").
+sub _nstring($$) {
+    my ($self, $stream) = @_;
+    return $$stream =~ s/\ANIL// ? undef : $self->_string($stream);
+}
+
+# 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);
+}
+
+# Parse and consume an RFC 3501 string (quoted / literal).
+sub _string($$) {
+    my ($self, $stream) = @_;
+    if ($$stream =~ s/\A"((?:\\[\x22\x5C]|[\x01-\x09\x0B\x0C\x0E-\x21\x23-\x5B\x5D-\x7F])*)"//) {
+        # quoted
+        my $str = $1;
+        $str =~ s/\\([\x22\x5C])/$1/g;
+        return $str;
+    }
+    elsif ($$stream =~ s/\A\{([0-9]+)\}\z//) {
+        # literal
+        my $count = $1;
+        my @acc;
+        my $buf;
+        while ($count > 0) {
+            my $n = $self->{STDOUT}->read($buf, $count);
+            push @acc, $buf;
+            $count -= $n;
+        }
+        $$stream = $self->_getline('[...]');
+        return join ('', @acc);
+    }
+    else {
+        $self->panic($$stream);
+    }
+}
+
+# Parse and consume an RFC 3501 "(" 1*address ")" / "NIL".
+sub _addresses($$) {
+    my ($self, $stream) = @_;
+    return undef if $$stream =~ s/\ANIL//;
+
+    my @addresses;
+    $$stream =~ s/\A\(// or $self->panic($$stream);
+    while ($$stream =~ s/\A ?\(//) {
+        my @addr;
+        push @addr, $self->_nstring($stream); # addr-name
+        $$stream =~ s/\A // or $self->panic($$stream);
+        push @addr, $self->_nstring($stream); # addr-adl
+        $$stream =~ s/\A // or $self->panic($$stream);
+        push @addr, $self->_nstring($stream); # addr-mailbox
+        $$stream =~ s/\A // or $self->panic($$stream);
+        push @addr, $self->_nstring($stream); # addr-host
+        $$stream =~ s/\A\)// or $self->panic($$stream);
+        push @addresses, \@addr;
+    }
+    $$stream =~ s/\A\)// or $self->panic($$stream);
+    return \@addresses;
+}
+
+# Parse and consume an RFC 3501 envelope
+sub _envelope($$) {
+    my ($self, $stream) = @_;
+    $$stream =~ s/\A\(// or $self->panic($$stream);
+
+    my @envelope;
+    push @envelope, $self->_nstring($stream);   # env-date
+    $$stream =~ s/\A // or $self->panic($$stream);
+    push @envelope, $self->_nstring($stream);   # env-subject
+    $$stream =~ s/\A // or $self->panic($$stream);
+    push @envelope, $self->_addresses($stream); # env-from
+    $$stream =~ s/\A // or $self->panic($$stream);
+    push @envelope, $self->_addresses($stream); # env-sender
+    $$stream =~ s/\A // or $self->panic($$stream);
+    push @envelope, $self->_addresses($stream); # env-reply-to
+    $$stream =~ s/\A // or $self->panic($$stream);
+    push @envelope, $self->_addresses($stream); # env-to
+    $$stream =~ s/\A // or $self->panic($$stream);
+    push @envelope, $self->_addresses($stream); # env-cc
+    $$stream =~ s/\A // or $self->panic($$stream);
+    push @envelope, $self->_addresses($stream); # env-bcc
+    $$stream =~ s/\A // or $self->panic($$stream);
+    push @envelope, $self->_nstring($stream);   # env-in-reply-to
+    $$stream =~ s/\A // or $self->panic($$stream);
+    push @envelope, $self->_nstring($stream);   # env-message-id
+
+    $$stream =~ s/\A\)// or $self->panic($$stream);
+    return \@envelope;
+}
+
+# $self->_resp($buf, [$cmd, $callback] )
+#   Parse an untagged response line or a continuation request line.
+#   (The trailing CRLF must be removed.)  The internal cache is
+#   automatically updated when needed.
+#   If a command and callback are given, the callback is be executed
+#   for each (parsed) responses associated with the command.
+sub _resp($$;$$$) {
+    my $self = shift;
+    local $_ = shift;
+    my $cmd = shift;
+    my $set = shift;
+    my $callback = shift;
+    my $cache = $self->{_CACHE}->{$self->{_SELECTED}} if defined $self->{_SELECTED};
+
+    if (s/\A\* //) {
+        if (s/\ABYE //) {
+            exit 0;
+        }
+        elsif (s/\A(?:OK|NO|BAD) //) {
+            $self->_resp_text($_);
+        }
+        elsif (/\ACAPABILITY((?: $RE_ATOM_CHAR+)+)\z/) {
+            $self->{_CAPABILITIES} = [ split / /, ($1 =~ s/^ //r) ];
+        }
+        elsif (/\AFLAGS \((\\?$RE_ATOM_CHAR+(?: \\?$RE_ATOM_CHAR+)*)?\)\z/) {
+            $cache->{FLAGS} = [ split / /, $1 ];
+        }
+        elsif (/\A([0-9]+) RECENT\z/) {
+            $cache->{RECENT} = $1;
+        }
+        elsif (/\A([0-9]+) EXISTS\z/) {
+            # /!\ $cache->{EXISTS} MUST NOT be defined on SELECT
+            if (defined $cache->{EXISTS}) {
+                $self->panic("Unexpected EXISTS shrink $1 < $cache->{EXISTS}!") if $1 < $cache->{EXISTS};
+                # the actual UIDNEXT is *at least* that
+                $cache->{UIDNEXT} += $1 - $cache->{EXISTS} if defined $cache->{UIDNEXT};
+            }
+            $cache->{EXISTS} = $1;
+        }
+        elsif (/\A([0-9]+) EXPUNGE\z/) {
+            # /!\ No bookkeeping since there is no internal cache mapping sequence numbers to UIDs
+            $self->panic("$1 <= $cache->{EXISTS}") if $1 <= $cache->{EXISTS}; # sanity check
+            $self->fail("RFC 7162 violation!  Got an EXPUNGE response with QRESYNC enabled.") if $self->_enabled('QRESYNC');
+            $cache->{EXISTS}--; # explicit EXISTS responses are optional
+        }
+        elsif (/\ASEARCH((?: [0-9]+)*)\z/) {
+            $callback->(split(/ /, ($1 =~ s/^ //r))) if defined $callback and $cmd eq 'SEARCH';
+        }
+        elsif (s/\ALIST \((\\?$RE_ATOM_CHAR+(?: \\?$RE_ATOM_CHAR+)*)?\) ("(?:\\[\x22\x5C]|[\x01-\x09\x0B\x0C\x0E-\x21\x23-\x5B\x5D-\x7F])"|NIL) //) {
+            my ($delim, $flags) = ($2, $1);
+            my @flags = defined $flags ? split(/ /, $flags) : ();
+            my $mailbox = $self->_astring(\$_);
+            $self->panic($_) unless $_ eq '';
+            $mailbox = 'INBOX' if uc $mailbox eq 'INBOX'; # INBOX is case-insensitive
+            undef $delim if uc $delim eq 'NIL';
+            $delim =~ s/\A"(.*)"\Z/$1/ if defined $delim;
+            $callback->($mailbox, $delim, @flags) if defined $callback and $cmd eq 'LIST';
+        }
+        elsif (s/\ASTATUS //) {
+            my $mailbox = $self->_astring(\$_);
+            /\A \((\\?$RE_ATOM_CHAR+ [0-9]+(?: \\?$RE_ATOM_CHAR+ [0-9]+)*)?\)\z/ or $self->panic($_);
+            my %status = split / /, $1;
+            $mailbox = 'INBOX' if uc $mailbox eq 'INBOX'; # INBOX is case-insensitive
+            $self->_update_cache_for($mailbox, %status);
+            $callback->($mailbox, %status) if defined $callback and $cmd eq 'STATUS';
+        }
+        elsif (s/\A([0-9]+) FETCH \(//) {
+            $self->panic("$1 <= $cache->{EXISTS}") unless $1 <= $cache->{EXISTS}; # sanity check
+            my ($seq, $first) = ($1, 1);
+            my %mail;
+            while ($_ ne ')') {
+                unless (defined $first) {
+                    s/\A // or $self->panic($_);
+                }
+                if (s/\AUID ([0-9]+)//) {
+                    # always present, cf RFC 3501 section 6.4.8
+                    $mail{UID} = $1;
+                    # the actual UIDNEXT is *at least* that
+                    $cache->{UIDNEXT} = $1+1 if !defined $cache->{UIDNEXT} or $cache->{UIDNEXT} < $1;
+                }
+                if (s/\AMODSEQ \(([0-9]+)\)//) { # RFC 4551/7162 CONDSTORE/QRESYNC
+                    # always present in unsolicited FETCH responses if QRESYNC has been enabled
+                    $mail{MODSEQ} = $1;
+                    $cache->{HIGHESTMODSEQ} = $1 if !defined $cache->{HIGHESTMODSEQ} or $cache->{HIGHESTMODSEQ} < $1;
+                }
+                elsif (s/\AENVELOPE //) {
+                    $mail{ENVELOPE} = $self->_envelope(\$_);
+                }
+                elsif (s/\AINTERNALDATE "([^"]+)"//) {
+                    $mail{INTERNALDATE} = $1;
+                }
+                elsif (s/\A(?:RFC822|BODY\[\]) //) {
+                    $mail{RFC822} = $self->_nstring(\$_);
+                }
+                elsif (s/\AFLAGS \((\\?$RE_ATOM_CHAR+(?: \\?$RE_ATOM_CHAR+)*)?\)//) {
+                    $mail{FLAGS} = defined $1 ? [ split / /, $1 ] : [];
+                }
+                undef $first;
+            }
+
+            my $uid = $mail{UID} // $self->panic(); # sanity check
+            $self->panic() unless defined $mail{MODSEQ} or !$self->_enabled('QRESYNC'); # sanity check
+
+            if (!exists $mail{RFC822} and !exists $mail{ENVELOPE} and # ignore new mails
+                (!exists $self->{_MODIFIED}->{$uid} or $self->{_MODIFIED}->{$uid}->[0] < $mail{MODSEQ} or
+                    ($self->{_MODIFIED}->{$uid}->[0] == $mail{MODSEQ} and !defined $self->{_MODIFIED}->{$uid}->[1]))) {
+                my $flags = join ' ', sort(grep {lc $_ ne '\recent'} @{$mail{FLAGS}}) if defined $mail{FLAGS};
+                $self->{_MODIFIED}->{$uid} = [ $mail{MODSEQ}, $flags ];
+            }
+            $callback->(%mail) if defined $callback and ($cmd eq 'FETCH' or $cmd eq 'STORE') and in_set($uid, $set);
+        }
+        elsif (/\AENABLED((?: $RE_ATOM_CHAR+)+)\z/) { # RFC 5161 ENABLE
+            $self->{_ENABLED} //= [];
+            push @{$self->{_ENABLED}}, split(/ /, ($1 =~ s/^ //r));
+        }
+        elsif (/\AVANISHED( \(EARLIER\))? ([0-9,:]+)\z/) { # RFC 7162 QRESYNC
+            my $earlier = defined $1 ? 1 : 0;
+            my $set = $2;
+            my $mailbox = $self->{_SELECTED} // $self->panic();
+            my $pcache = $self->{_PCACHE}->{$mailbox};
+            foreach (split /,/, $set) {
+                if (/\A([0-9]+)\z/) {
+                    $cache->{EXISTS}-- unless $earlier; # explicit EXISTS responses are optional
+                    $cache->{UIDNEXT} = $1+1 if $cache->{UIDNEXT} <= $1; # the actual UIDNEXT is *at least* that
+                    push @{$self->{_VANISHED}}, $1
+                        if defined $pcache->{UIDNEXT} and $1 < $pcache->{UIDNEXT};
+                }
+                elsif (/\A([0-9]+):([0-9]+)\z/) {
+                    my ($min, $max) = $1 < $2 ? ($1,$2) : ($2,$1);
+                    $cache->{EXISTS} -= $max-$min+1 unless $earlier; # explicit EXISTS responses are optional
+                    $cache->{UIDNEXT} = $max+1 if $cache->{UIDNEXT} <= $max; # the actual UIDNEXT is *at least* that
+                    push @{$self->{_VANISHED}}, grep {$_ < $pcache->{UIDNEXT}} ($min .. $max)
+                        if defined $pcache->{UIDNEXT};
+                }
+            }
+        }
+    }
+    elsif (s/\A\+ //) {
+        if (defined $callback and $cmd eq 'AUTHENTICATE') {
+            my $x = $callback->($_);
+            print STDERR "C: ", $x, "\n" if $self->{debug};
+            $self->{STDIN}->print($x, "\r\n");
+            $self->{STDIN}->flush();
+        }
+    }
+    else {
+        $self->panic("Unexpected response: ", $_);
+    }
+}
+
+
+#############################################################################
+
+return 1;