From e51c8899d67e5d86a868e1adced55a6c72113daa Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Sat, 5 Mar 2016 18:36:07 +0100 Subject: [PATCH] pullimap: add support for IMAP IDLE (RFC 2177). --- lib/Net/IMAP/InterIMAP.pm | 30 +++++++++++++++ pullimap | 81 +++++++++++++++++++++++---------------- 2 files changed, 78 insertions(+), 33 deletions(-) diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index 15682b3..2898905 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -968,6 +968,35 @@ sub slurp($;$$) { } +# $self->idle([$timeout, $stopwhen]) +# Enter IDLE (RFC 2177) for $timout seconds (by default 29 mins), or +# when the callback $stopwhen returns true. +# Return false if the timeout was reached, and true if IDLE was +# stopped due the callback. +sub idle($$$) { + my ($self, $timeout, $stopwhen) = @_; + $timeout //= 1740; # 29 mins + + $self->fail("Server did not advertise IDLE (RFC 2177) capability.") + unless $self->_capable('IDLE'); + + my $tag = $self->_cmd_init('IDLE'); + $self->_cmd_flush(); + + for (; $timeout > 0; $timeout--) { + $self->slurp('IDLE', sub() {$timeout = -1 if $stopwhen->()}); + sleep 1 if $timeout > 0; + } + + # done idling + $self->_cmd_extend('DONE'); + $self->_cmd_flush(); + $self->_recv($tag); + + return $timeout < 0 ? 1 : 0; +} + + # $self->set_cache( $mailbox, STATE ) # Initialize or update the persistent cache, that is, associate a # known $mailbox with the last known (synced) state: @@ -2294,6 +2323,7 @@ sub _resp($$;$$$) { else { $self->panic("Unexpected response: ", $_); } + $callback->() if defined $callback and $cmd eq 'IDLE'; } diff --git a/pullimap b/pullimap index f9b9d0d..2c9b45d 100755 --- a/pullimap +++ b/pullimap @@ -47,7 +47,7 @@ sub usage(;$) { exit $rv; } -usage(1) unless GetOptions(\%CONFIG, qw/config=s quiet|q debug help|h/); +usage(1) unless GetOptions(\%CONFIG, qw/config=s quiet|q debug help|h idle:i/); usage(0) if $CONFIG{help}; usage(1) unless $#ARGV == 0 and $ARGV[0] ne '_'; @@ -225,10 +225,47 @@ sub smtp_send(@) { # the remote mailbox # my $IMAP = Net::IMAP::InterIMAP::->new( %$CONF, %CONFIG{qw/quiet debug/}, 'logger-fd' => $LOGGER_FD ); + +# use BODY.PEEK[] so if something gets wrong, unpulled messages +# won't be marked as \Seen in the mailbox +my $ATTRS = join ' ', qw/ENVELOPE INTERNALDATE BODY.PEEK[]/; + +# Pull new messages from IMAP and deliver them to SMTP, then update the +# statefile +sub pull(;$) { + my $ignore = shift // []; + my @uid; + + # invariant: we're at pos 8 + 4*(1+$#ignore + 1+$#uids) in the statefile + $IMAP->pull_new_messages($ATTRS, sub($) { + my $mail = shift; + return unless exists $mail->{RFC822}; # not for us + + my $uid = $mail->{UID}; + my $from = first { defined $_ and @$_ } @{$mail->{ENVELOPE}}[2,3,4]; + $from = (defined $from and @$from) ? $from->[0]->[2].'@'.$from->[0]->[3] : ''; + print STDERR "($MAILBOX): UID $uid from <$from> ($mail->{INTERNALDATE})\n" unless $CONFIG{quiet}; + + sendmail($from, $mail->{RFC822}); + + push @uid, $uid; + writeUID($uid); + }, @$ignore); + + # now that everything has been deliverd, mark @ignore and @uid as \Seen + $IMAP->silent_store(compact_set(@$ignore, @uid), '+', '\Seen') if @$ignore or @uid; + + # update the statefile + sysseek($STATE, 4, SEEK_SET) // die "Can't seek: $!"; + my ($uidnext) = $IMAP->get_cache('UIDNEXT'); + writeUID($uidnext); + truncate($STATE, 8) // die "Can't truncate"; +} + do { my $uidvalidity = readUID(); my $uidnext = readUID(); - my @ignore; + my $ignore = []; $IMAP->set_cache($MAILBOX, UIDVALIDITY => $uidvalidity, UIDNEXT => $uidnext); $IMAP->select($MAILBOX); @@ -249,37 +286,15 @@ do { # have already been delivered, but the process exited before the # statefile was updated while (defined (my $uid = readUID())) { - push @ignore, $uid; + push @$ignore, $uid; } } - - # use BODY.PEEK[] so if something gets wrong, unpulled messages - # won't be marked as \Seen in the mailbox - my $attrs = join ' ', qw/ENVELOPE INTERNALDATE BODY.PEEK[]/; - my @uid; - - # invariant: we're at pos 8 + 4*(1+$#ignore + 1+$#uids) - $IMAP->pull_new_messages($attrs, sub($) { - my $mail = shift; - return unless exists $mail->{RFC822}; # not for us - - my $uid = $mail->{UID}; - my $from = first { defined $_ and @$_ } @{$mail->{ENVELOPE}}[2,3,4]; - $from = (defined $from and @$from) ? $from->[0]->[2].'@'.$from->[0]->[3] : ''; - print STDERR "($MAILBOX): UID $uid from <$from> ($mail->{INTERNALDATE})\n" unless $CONFIG{quiet}; - - sendmail($from, $mail->{RFC822}); - - push @uid, $uid; - writeUID($uid); - }, @ignore); - - # now that everything has been deliverd, mark @ignore and @uid as \Seen - $IMAP->silent_store(compact_set(@ignore, @uid), '+', '\Seen') if @ignore or @uid; - - # update the statefile - sysseek($STATE, 4, SEEK_SET) // die "Can't seek: $!"; - ($uidnext) = $IMAP->get_cache('UIDNEXT'); - writeUID($uidnext); - truncate($STATE, 8) // die "Can't truncate"; + pull($ignore); }; +exit 0 unless defined $CONFIG{idle}; + +$CONFIG{idle} = 1740 if defined $CONFIG{idle} and $CONFIG{idle} == 0; # 29 mins +while(1) { + my $r = $IMAP->idle($CONFIG{idle}, sub() { $IMAP->has_new_mails($MAILBOX) }); + pull() if $r; +} -- 2.39.2