Merge branch 'master' into debian

1 files changed, 110 insertions, 66 deletions

diff --git a/lib/Net/IMAP/Sync.pm b/lib/Net/IMAP/Sync.pm
index 3216483..47c6258 100644
--- a/lib/Net/IMAP/Sync.pm
+++ b/lib/Net/IMAP/Sync.pm
@@ -47,7 +47,6 @@ my %OPTIONS = (
     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(YES|NO)\z/i,
     SSL_fingerprint => qr/\A([A-Za-z0-9]+\$\p{AHex}+)\z/,
     SSL_cipher_list => qr/\A(\P{Control}+)\z/,
     SSL_verify_trusted_peer => qr/\A(YES|NO)\z/i,
@@ -79,10 +78,11 @@ sub read_config($$%) {
     foreach my $section (@$sections) {
         my $conf = defined $h->{_} ? { %{$h->{_}} } : {}; # default section
         $configs{$section} = $conf;
-        next unless defined $section and $section ne '_';
 
-        die "No such section $section\n" unless defined $h->{$section};
-        $conf->{$_} = $h->{$section}->{$_} foreach keys %{$h->{$section}};
+        if ($section ne '_') {
+            die "No such section $section\n" unless defined $h->{$section};
+            $conf->{$_} = $h->{$section}->{$_} foreach keys %{$h->{$section}};
+        }
 
         # default values
         $conf->{type} //= 'imaps';
@@ -210,10 +210,6 @@ our $IMAP_text;
 #
 #   - '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[]).
@@ -225,9 +221,6 @@ sub new($%) {
     my $self = { @_ };
     bless $self, $class;
 
-    # whether we're allowed to to use read-write command
-    $self->{'read-only'} = uc ($self->{'read-only'} // 'NO') ne 'YES' ? 0 : 1;
-
     # the IMAP state: one of 'UNAUTH', 'AUTH', 'SELECTED' or 'LOGOUT'
     # (cf RFC 3501 section 3)
     $self->{_STATE} = '';
@@ -386,9 +379,8 @@ sub new($%) {
 # Log out when the Net::IMAP::Sync object is destroyed.
 sub DESTROY($) {
     my $self = shift;
-    if (defined $self->{STDIN}  and $self->{STDIN}->opened() and
-        defined $self->{STDOUT} and $self->{STDOUT}->opened()) {
-        $self->logout();
+    foreach (qw/STDIN STDOUT/) {
+        $self->{$_}->close() if defined $self->{$_} and $self->{$_}->opened();
     }
 }
 
@@ -480,14 +472,12 @@ sub search($$) {
 
 # $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.
+#   Issue a SELECT or EXAMINE command for the $mailbox. 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);
+    $self->_select_or_examine('SELECT', $mailbox);
 }
 sub examine($$) {
     my $self = shift;
@@ -500,7 +490,8 @@ sub examine($$) {
 #   Issue a LOGOUT command.  Change the state to LOGOUT.
 sub logout($) {
     my $self = shift;
-    $self->_send('LOGOUT');
+    # don't bother if the connection is already closed
+    $self->_send('LOGOUT') if $self->{STDIN}->opened();
     $self->{_STATE} = 'LOGOUT';
     undef $self;
 }
@@ -513,48 +504,99 @@ sub 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));
+# $self->create($mailbox, [$try])
+# $self->delete($mailbox, [$try])
+#   CREATE or DELETE $mailbox.
+#   If try is set, print a warning but don't crash if the command fails.
+sub create($$;$) {
+    my ($self, $mailbox, $try) = @_;
+    my $r = $self->_send("CREATE ".quote($mailbox));
+    if ($IMAP_cond eq 'OK') {
+        $self->log("Created mailbox ".$mailbox) unless $self->{quiet};
+    }
+    else {
+        my $msg = "Couldn't create mailbox ".$mailbox.': '.$IMAP_text;
+        $try ? $self->warn($msg) : $self->fail($msg);
+    }
+    return $r;
 }
-sub delete($$) {
-    my ($self, $mailbox) = @_;
-    $self->fail("Server is read-only.") if $self->{'read-only'};
-    #$self->_send("DELETE ".quote($mailbox));
+sub delete($$;$) {
+    my ($self, $mailbox, $try) = @_;
+    my $r = $self->_send("DELETE ".quote($mailbox));
     delete $self->{_CACHE}->{$mailbox};
     delete $self->{_PCACHE}->{$mailbox};
+    if ($IMAP_cond eq 'OK') {
+        $self->log("Deleted mailbox ".$mailbox) unless $self->{quiet};
+    }
+    else {
+        my $msg = "Couldn't delete mailbox ".$mailbox.': '.$IMAP_text;
+        $try ? $self->warn($msg) : $self->fail($msg);
+    }
+    return $r;
 }
 
 
-# $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->rename($oldname, $newname, [$try])
+#   RENAME the mailbox $oldname to $newname.
+#   If $try is set, print a warning but don't crash if the command fails.
+#   /!\ Requires a LIST command to be issued to determine the hierarchy
+#       delimiter and the mailbox attributes for the original name.
+sub rename($$$;$) {
+    my ($self, $from, $to, $try) = @_;
+    my ($delim, @attrs);
+    if ($self->{_CACHE}->{$from}) {
+        $delim = $self->{_CACHE}->{$from}->{DELIMITER};
+        @attrs = @{$self->{_CACHE}->{$from}->{LIST_ATTRIBUTES} // []};
+    }
+    my $r = $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};
+    if (defined $delim and !grep {lc $_ eq lc '\NoInferiors' or lc $_ eq lc '\HasNoChildren'} @attrs) {
+        # on non-flat mailboxes, move children as well (cf 3501)
+        foreach my $c1 (grep /\A\Q$from$delim\E/, keys %{$self->{_CACHE}}) {
+            my $c2 = $c1 =~ s/\A\Q$from$delim\E/$to$delim/r;
+            $self->{_CACHE}->{$c2}  = delete $self->{_CACHE}->{$c1}  if exists $self->{_CACHE}->{$c1};
+            $self->{_PCACHE}->{$c2} = delete $self->{_PCACHE}->{$c1} if exists $self->{_PCACHE}->{$c1};
+        }
+    }
+    if ($IMAP_cond eq 'OK') {
+        $self->log("Renamed mailbox ".$from.' to '.$to) unless $self->{quiet};
+    }
+    else {
+        my $msg = "Couldn't rename mailbox ".$from.': '.$IMAP_text;
+        $try ? $self->warn($msg) : $self->fail($msg);
+    }
+    return $r;
 }
 
 
-# $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));
+# $self->subscribe($mailbox, [$try])
+# $self->unsubscribe($mailbox, [$try])
+#   SUBSCRIBE or UNSUBSCRIBE $mailbox.
+#   If $try is set, print a warning but don't crash if the command fails.
+sub subscribe($$;$) {
+    my ($self, $mailbox, $try) = @_;
+    my $r = $self->_send("SUBSCRIBE ".quote($mailbox));
+    if ($IMAP_cond eq 'OK') {
+        $self->log("Subscribe to ".$mailbox) unless $self->{quiet};
+    }
+    else {
+        my $msg = "Couldn't subscribe to ".$mailbox.': '.$IMAP_text;
+        $try ? $self->warn($msg) : $self->fail($msg);
+    }
+    return $r;
 }
-sub unsubscribe($$) {
-    my ($self, $mailbox) = @_;
-    $self->fail("Server is read-only.") if $self->{'read-only'};
-    $self->_send("UNSUBSCRIBE ".quote($mailbox));
+sub unsubscribe($$;$) {
+    my ($self, $mailbox, $try) = @_;
+    my $r = $self->_send("UNSUBSCRIBE ".quote($mailbox));
+    if ($IMAP_cond eq 'OK') {
+        $self->log("Unsubscribe to ".$mailbox) unless $self->{quiet};
+    }
+    else {
+        my $msg = "Couldn't unsubscribe to ".$mailbox.': '.$IMAP_text;
+        $try ? $self->warn($msg) : $self->fail($msg);
+    }
+    return $r;
 }
 
 
@@ -624,7 +666,6 @@ sub append($$@) {
     my $self = shift;
     my $mailbox = shift;
     return unless @_;
-    $self->fail("Server is read-only.") if $self->{'read-only'};
     $self->fail("Server did not advertise UIDPLUS (RFC 4315) capability.")
         if $self->incapable('UIDPLUS');
 
@@ -1060,10 +1101,15 @@ sub _getline($;$) {
     my $self = shift;
     my $msg = shift // '';
 
-    my $x = $self->{STDOUT}->getline() // $self->panic("Can't read: $!");
-    $x =~ s/\r\n\z// or $self->panic($x);
-    $self->logger("S: $msg", $x) if $self->{debug};
-    return $x;
+    if ($self->{STDOUT}->opened()) {
+        my $x = $self->{STDOUT}->getline() // $self->panic("Can't read: $!");
+        $x =~ s/\r\n\z// or $self->panic($x);
+        $self->logger("S: $msg", $x) if $self->{debug};
+        return $x;
+    }
+    else {
+        undef $self;
+    }
 }
 
 
@@ -1151,7 +1197,7 @@ sub _send($$;&) {
             $IMAP_cond = $1;
             $IMAP_text = $1.' '.$x;
             $self->_resp_text($x);
-            $self->fail($IMAP_text, "\n") unless defined wantarray or $IMAP_cond eq 'OK';
+            $self->fail($IMAP_text) unless defined wantarray or $IMAP_cond eq 'OK';
             $r = $1;
             last;
         }
@@ -1219,9 +1265,8 @@ sub _open_mailbox($$) {
 
 
 # $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.
+#   Issue a SELECT or EXAMINE command for the $mailbox.  Upon success,
+#   change the state to SELECTED, otherwise go back to AUTH.
 sub _select_or_examine($$$) {
     my $self = shift;
     my $command = shift;
@@ -1413,10 +1458,7 @@ sub _resp($$;$$$) {
 
     if (s/\A\* //) {
         if (s/\ABYE //) {
-            foreach (qw/STDIN STDOUT/) {
-                $self->{$_}->close() if defined $self->{$_} and $self->{$_}->opened();
-            }
-            exit 0;
+            undef $self;
         }
         elsif (s/\A(?:OK|NO|BAD) //) {
             $self->_resp_text($_);
@@ -1449,14 +1491,16 @@ sub _resp($$;$$$) {
             $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 ($delim, $attrs) = ($2, $1);
+            my @attrs = defined $attrs ? split(/ /, $attrs) : ();
             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';
+            $self->_update_cache_for($mailbox, DELIMITER => $delim);
+            $self->_update_cache_for($mailbox, LIST_ATTRIBUTES => \@attrs);
+            $callback->($mailbox, $delim, @attrs) if defined $callback and $cmd eq 'LIST';
         }
         elsif (s/\ASTATUS //) {
             my $mailbox = $self->_astring(\$_);