From 849d5668da8d10c9fd0d05aeeb6519c01ce1d8af Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Sat, 29 Jul 2017 13:38:46 +0200 Subject: Add missing changelog entry. --- Changelog | 1 + 1 file changed, 1 insertion(+) diff --git a/Changelog b/Changelog index 36cbb23..4d88835 100644 --- a/Changelog +++ b/Changelog @@ -4,6 +4,7 @@ interimap (0.4) UNRELEASED (received by the IMAP FETCH ENVELOPE command) by the null sender address <>. - Ensure the lower bound of UID ranges is at least 1. + - Fix manpage generation with pandoc >=1.18. -- Guilhem Moulin Tue, 06 Dec 2016 17:37:01 +0100 -- cgit v1.2.3 From a32fd7afe3bff2bcea198ef62653fcde2b31534d Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Thu, 26 Apr 2018 16:51:23 +0200 Subject: Fix manpage generation with pandoc >=2.1 --- Changelog | 2 +- Makefile | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/Changelog b/Changelog index 4d88835..b901114 100644 --- a/Changelog +++ b/Changelog @@ -4,7 +4,7 @@ interimap (0.4) UNRELEASED (received by the IMAP FETCH ENVELOPE command) by the null sender address <>. - Ensure the lower bound of UID ranges is at least 1. - - Fix manpage generation with pandoc >=1.18. + - Fix manpage generation with pandoc >=2.1. -- Guilhem Moulin Tue, 06 Dec 2016 17:37:01 +0100 diff --git a/Makefile b/Makefile index a8474d6..d7b7133 100644 --- a/Makefile +++ b/Makefile @@ -2,7 +2,7 @@ all: pullimap.1 interimap.1 # upper case the headers and remove the links %.1: %.md - @pandoc -S -f markdown -t json "$<" | \ + @pandoc -f markdown -t json "$<" | \ jq " \ def fixheaders: \ if .t == \"Header\" then \ @@ -27,7 +27,7 @@ all: pullimap.1 interimap.1 , meta \ , blocks: .blocks | map(fixheaders) | map(fixlinks) \ }" | \ - pandoc -sS -f json -t man -o "$@" + pandoc -s -f json -t man+smart -o "$@" install: -- cgit v1.2.3 From a95890cc5c18a2c4a16d6929b2725c6ba3fc3e5e Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Wed, 9 May 2018 01:03:28 +0200 Subject: Library: new API idle_start() and idle_stop(). --- Changelog | 1 + lib/Net/IMAP/InterIMAP.pm | 32 ++++++++++++++++++++++++++------ 2 files changed, 27 insertions(+), 6 deletions(-) diff --git a/Changelog b/Changelog index b901114..74b36fb 100644 --- a/Changelog +++ b/Changelog @@ -3,6 +3,7 @@ interimap (0.4) UNRELEASED * pullimap: replace non RFC 5321-compliant envelope sender addresses (received by the IMAP FETCH ENVELOPE command) by the null sender address <>. + + Library: new API idle_start() and idle_stop(). - Ensure the lower bound of UID ranges is at least 1. - Fix manpage generation with pandoc >=2.1. diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index 6f148b7..9719de2 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -959,14 +959,15 @@ sub slurp($$$) { foreach my $imap (@ready) { my $x = $imap->_getline(); - $imap->_resp($x, sub($) { - if ($stopwhen->($imap, shift)) { + $imap->_resp($x, sub($;$$) { + if ($stopwhen->(@_)) { $aborted = 1; $timeout = 0; # keep reading the handles while there is pending data } }, 'slurp'); } } + return $aborted; } @@ -977,20 +978,39 @@ sub slurp($$$) { # after the $timeout) and false otherwise. sub idle($$$) { my ($self, $timeout, $stopwhen) = @_; + my $tag = $self->idle_start($timeout); + my $r = slurp([$self], $timeout // 1740, $stopwhen); # 29 mins + $r += $self->idle_stop($tag, $stopwhen); + return $r; +} +# $self->idle_start() +# Enter IDLE (RFC 2177). +# Return the command tag. +sub idle_start($) { + my $self = shift; $self->fail("Server did not advertise IDLE (RFC 2177) capability.") unless $self->_capable('IDLE'); my $tag = $self->_cmd_init('IDLE'); $self->_cmd_flush(); - my $r = slurp([$self], $timeout // 1740, $stopwhen); # 29 mins + return $tag; +} + +# $self->idle_stop($tag, $callback) +# Stop a running IDLE (RFC 2177) command $tag. +# Returns the number of untagged responses received between the DONE +# the tagged response that are satisfying $callback. +sub idle_stop($$$) { + my ($self, $tag, $callback) = @_; + my $r = 0; # done idling $self->_cmd_extend('DONE'); $self->_cmd_flush(); # run the callback again to update the return value if we received # untagged responses between the DONE and the tagged response - $self->_recv($tag, sub($) { $r = 1 if $stopwhen->($self, shift) }, 'slurp'); + $self->_recv($tag, sub($;$$) { $r++ if $callback->($self, @_) }, 'slurp'); return $r; } @@ -2247,7 +2267,7 @@ sub _resp($$;&$$) { $self->{_NEW} += $1 - $cache->{EXISTS} if $1 > $cache->{EXISTS}; # new mails } $cache->{EXISTS} = $1; - $callback->($self->{_SELECTED} // $self->panic()) if defined $callback and $cmd eq 'slurp'; + $callback->($self->{_SELECTED} // $self->panic(), EXISTS => $1) if defined $callback and $cmd eq 'slurp'; } elsif (/\A([0-9]+) EXPUNGE\z/) { $self->panic() unless defined $cache->{EXISTS}; # sanity check @@ -2340,7 +2360,7 @@ sub _resp($$;&$$) { if ($cmd eq 'FETCH' or $cmd eq 'STORE') { $callback->(\%mail) if defined $uid and in_set($uid, $set); } elsif ($cmd eq 'slurp') { - $callback->($self->{_SELECTED} // $self->panic()) + $callback->($self->{_SELECTED} // $self->panic(), FETCH => $seq) } } } -- cgit v1.2.3 From c41c280d3a1243ae445311e1ededd1dedc1484c3 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Wed, 9 May 2018 01:11:55 +0200 Subject: Add support for untagged ESEARCH responses from RFC 4731. --- Changelog | 1 + lib/Net/IMAP/InterIMAP.pm | 24 ++++++++++++++++++++---- 2 files changed, 21 insertions(+), 4 deletions(-) diff --git a/Changelog b/Changelog index 74b36fb..f2fee83 100644 --- a/Changelog +++ b/Changelog @@ -4,6 +4,7 @@ interimap (0.4) UNRELEASED (received by the IMAP FETCH ENVELOPE command) by the null sender address <>. + Library: new API idle_start() and idle_stop(). + + Add support for untagged ESEARCH responses from RFC 4731. - Ensure the lower bound of UID ranges is at least 1. - Fix manpage generation with pandoc >=2.1. diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index 9719de2..4a9ffd9 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -594,12 +594,15 @@ sub incapable($@) { # $self->search($criterion) -# Issue an UID SEARCH command with the given $criterion. Return the -# list of matching UIDs. +# Issue an UID SEARCH command with the given $criterion. For the "normal" +# UID SEARCH command from RFC 3501, return the list of matching UIDs; +# for the extended UID SEARCH command from RFC 4731 (ensuring ESEARCH +# capability is the caller's responsibility), return an "UID" +# indicator followed by a hash containing search data pairs. sub search($$) { my ($self, $crit) = @_; my @res; - $self->_send('UID SEARCH '.$crit, sub(@) {push @res, @_}); + $self->_send('UID SEARCH '.$crit, sub(@) {@res = @_}); return @res } @@ -1942,7 +1945,9 @@ sub _send($$;&) { $self->_recv($tag, undef, $cmd); } else { - my $set = $$command =~ /\AUID (?:FETCH|STORE) ([0-9:,*]+)/ ? $1 : undef; + my $set = $$command =~ /\AUID (?:FETCH|STORE) ([0-9:,*]+)/ ? $1 + : $$command =~ /\AUID SEARCH / ? "\"$tag\"" # RFC 4466's tag-string + : undef; $self->_recv($tag, $callback, $cmd, $set); } } @@ -2283,6 +2288,17 @@ sub _resp($$;&$$) { elsif (/\ASEARCH((?: [0-9]+)*)\z/) { $callback->(split(/ /, ($1 =~ s/^ //r))) if defined $callback and $cmd eq 'SEARCH'; } + elsif (s/\AESEARCH \(TAG \Q$set\E\)( UID)?//) { + my $uid = $1; + my %ret; # RFC 4731 + while ($_ ne '') { + $self->fail("RFC 4731 violation in ESEARCH response") + # XXX RFC 4466's tagged-ext-comp unsupported + unless s/\A ($RE_ATOM_CHAR+) ([0-9,:]+)//; + $ret{uc $1} = $2; + } + $callback->($uid, %ret) 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, $attrs) = ($2, $1); my @attrs = defined $attrs ? split(/ /, $attrs) : (); -- cgit v1.2.3