From 464862335d1bc09437d4238214d30a1db7b829bd Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Sun, 26 Jul 2015 15:53:13 +0200 Subject: bugfix: Fetching new messages from local and adding them to remote modifies its UIDNEXT. So we need to check again the first $source (remote) whenever the last one (local) added new messages to it. --- lib/Net/IMAP/Sync.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lib/Net') diff --git a/lib/Net/IMAP/Sync.pm b/lib/Net/IMAP/Sync.pm index 26303a6..bf56519 100644 --- a/lib/Net/IMAP/Sync.pm +++ b/lib/Net/IMAP/Sync.pm @@ -657,12 +657,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($_); } -- cgit v1.2.3 From 9784997b21a30a2c5a8db3742a42faebad9e169d Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Sun, 26 Jul 2015 19:42:35 +0200 Subject: typo --- lib/Net/IMAP/Sync.pm | 1 - 1 file changed, 1 deletion(-) (limited to 'lib/Net') diff --git a/lib/Net/IMAP/Sync.pm b/lib/Net/IMAP/Sync.pm index bf56519..3216483 100644 --- a/lib/Net/IMAP/Sync.pm +++ b/lib/Net/IMAP/Sync.pm @@ -736,7 +736,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; } -- cgit v1.2.3 From 66b0682010cf24a4d2e92465dd57bcd795d21970 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Mon, 27 Jul 2015 22:02:17 +0200 Subject: No longer try to guess whether a mailbox was deleted or renamed. This was too error-prone. Instead, abort if a naming conflict occurs, and provide explicit commands --delete and --rename to delete or rename a mailbox. --- lib/Net/IMAP/Sync.pm | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) (limited to 'lib/Net') diff --git a/lib/Net/IMAP/Sync.pm b/lib/Net/IMAP/Sync.pm index 3216483..c1bccbf 100644 --- a/lib/Net/IMAP/Sync.pm +++ b/lib/Net/IMAP/Sync.pm @@ -520,11 +520,13 @@ 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}; } @@ -533,12 +535,24 @@ sub delete($$) { # $self->rename($oldname, $newname) # RENAME the mailbox $oldname to $newname. Requires the 'read-only' # flag to be unset. +# /!\ Requires a LIST command to be issued to determine the hierarchy +# delimiter for the original name. sub rename($$$) { my ($self, $from, $to) = @_; + my $delim = $self->{_CACHE}->{$from}->{DELIMITER} if defined $self->{_CACHE}->{$from}; $self->fail("Server is read-only.") if $self->{'read-only'}; $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}; + } + } } @@ -550,11 +564,13 @@ 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}; } @@ -1456,6 +1472,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 //) { -- cgit v1.2.3 From 2a3287ab0b04341adcb8187b75cf35ac3f07d24f Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Mon, 27 Jul 2015 22:49:07 +0200 Subject: bugfix: Don't exist with the children's exist status upon error. --- lib/Net/IMAP/Sync.pm | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) (limited to 'lib/Net') diff --git a/lib/Net/IMAP/Sync.pm b/lib/Net/IMAP/Sync.pm index c1bccbf..677f991 100644 --- a/lib/Net/IMAP/Sync.pm +++ b/lib/Net/IMAP/Sync.pm @@ -386,9 +386,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(); } } -- cgit v1.2.3 From 67b2781d691d107f92409ac6fd9aeef97593ffa1 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Mon, 27 Jul 2015 22:52:21 +0200 Subject: Drop the 'read-only' option. It didn't really work since STORE commands are answered with a tagged OK response for instance. --- lib/Net/IMAP/Sync.pm | 35 ++++++++--------------------------- 1 file changed, 8 insertions(+), 27 deletions(-) (limited to 'lib/Net') diff --git a/lib/Net/IMAP/Sync.pm b/lib/Net/IMAP/Sync.pm index 677f991..3faab63 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, @@ -210,10 +209,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 +220,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} = ''; @@ -479,14 +471,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; @@ -514,16 +504,14 @@ 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->log("Deleted mailbox ".$mailbox) unless $self->{quiet}; delete $self->{_CACHE}->{$mailbox}; @@ -532,14 +520,12 @@ sub delete($$) { # $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) = @_; my $delim = $self->{_CACHE}->{$from}->{DELIMITER} if defined $self->{_CACHE}->{$from}; - $self->fail("Server is read-only.") if $self->{'read-only'}; $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}; @@ -557,17 +543,14 @@ sub rename($$$) { # $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}; } @@ -639,7 +622,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'); @@ -1234,9 +1216,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; -- cgit v1.2.3 From 36b7d017145bac2f883cca12289e66b6b369a5e3 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Mon, 27 Jul 2015 23:45:09 +0200 Subject: Enable fine-grained control on the mailboxes to consider. Add 3 options: - list-mailbox - list-select-opts - ignore-mailbox The first two control the initial LIST command, while the last one is a regular expression to filter out mailboxes to exclude from the LIST response. --- lib/Net/IMAP/Sync.pm | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'lib/Net') diff --git a/lib/Net/IMAP/Sync.pm b/lib/Net/IMAP/Sync.pm index 3faab63..48f61c1 100644 --- a/lib/Net/IMAP/Sync.pm +++ b/lib/Net/IMAP/Sync.pm @@ -78,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'; -- cgit v1.2.3