From: Guilhem Moulin <guilhem@fripost.org>
Date: Sat, 5 Mar 2016 17:36:07 +0000 (+0100)
Subject: pullimap: add support for IMAP IDLE (RFC 2177).
X-Git-Url: https://git.g-eek.se/?a=commitdiff_plain;h=e51c8899d67e5d86a868e1adced55a6c72113daa;p=interimap.git

pullimap: add support for IMAP IDLE (RFC 2177).
---

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;
+}