aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/Net/IMAP/Sync.pm71
1 files changed, 34 insertions, 37 deletions
diff --git a/lib/Net/IMAP/Sync.pm b/lib/Net/IMAP/Sync.pm
index 26303a6..48f61c1 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;
@@ -515,46 +505,55 @@ sub noop($) {
# $self->create($mailbox)
# $self->delete($mailbox)
-# CREATE or DELETE $mailbox. Requires the 'read-only' flag to be unset.
+# CREATE or DELETE $mailbox.
sub create($$) {
my ($self, $mailbox) = @_;
- $self->fail("Server is read-only.") if $self->{'read-only'};
$self->_send("CREATE ".quote($mailbox));
+ $self->log("Created mailbox ".$mailbox) unless $self->{quiet};
}
sub delete($$) {
my ($self, $mailbox) = @_;
- $self->fail("Server is read-only.") if $self->{'read-only'};
- #$self->_send("DELETE ".quote($mailbox));
+ $self->_send("DELETE ".quote($mailbox));
+ $self->log("Deleted mailbox ".$mailbox) unless $self->{quiet};
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.
+# RENAME the mailbox $oldname to $newname.
+# /!\ Requires a LIST command to be issued to determine the hierarchy
+# delimiter for the original name.
sub rename($$$) {
my ($self, $from, $to) = @_;
- $self->fail("Server is read-only.") if $self->{'read-only'};
+ my $delim = $self->{_CACHE}->{$from}->{DELIMITER} if defined $self->{_CACHE}->{$from};
$self->_send("RENAME ".quote($from).' '.quote($to));
+ $self->log("Renamed mailbox ".$from.' to '.$to) unless $self->{quiet};
$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) {
+ # 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};
+ }
+ }
}
# $self->subscribe($mailbox)
# $self->unsubscribe($mailbox)
-# SUBSCRIBE or UNSUBSCRIBE $mailbox. Requires the 'read-only' flag to
-# be unset.
+# SUBSCRIBE or UNSUBSCRIBE $mailbox.
sub subscribe($$) {
my ($self, $mailbox) = @_;
- $self->fail("Server is read-only.") if $self->{'read-only'};
$self->_send("SUBSCRIBE ".quote($mailbox));
+ $self->log("Subscribed to mailbox ".$mailbox) unless $self->{quiet};
}
sub unsubscribe($$) {
my ($self, $mailbox) = @_;
- $self->fail("Server is read-only.") if $self->{'read-only'};
$self->_send("UNSUBSCRIBE ".quote($mailbox));
+ $self->log("Unsubscribed to mailbox ".$mailbox) unless $self->{quiet};
}
@@ -624,7 +623,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');
@@ -657,12 +655,12 @@ sub append($$@) {
my @uids;
foreach (split /,/, $uidset) {
if (/\A([0-9]+)\z/) {
- $UIDNEXT = $1 + 1 if $UIDNEXT <= $1;
+ $UIDNEXT = $1 + 1 if defined $UIDNEXT and $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;
+ $UIDNEXT = $max + 1 if defined $UIDNEXT and $UIDNEXT <= $max;
} else {
$self->panic($_);
}
@@ -736,7 +734,6 @@ sub slurp($) {
# select(2) to block/timeout due to the raw socket not being
# ready.
unless (ref $stdout eq 'IO::Socket::SSL' and $stdout->pending() > 0) {
- my $sel = IO::Select::->new($stdout);
my ($ok) = $self->{_SEL_OUT}->can_read(0);
return $read unless defined $ok;
}
@@ -1220,9 +1217,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;
@@ -1457,6 +1453,7 @@ sub _resp($$;$$$) {
$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;
+ $self->_update_cache_for($mailbox, DELIMITER => $delim);
$callback->($mailbox, $delim, @flags) if defined $callback and $cmd eq 'LIST';
}
elsif (s/\ASTATUS //) {
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-03 23:07:59 +0000