Net::IMAP::InterIMAP, interimap: Add support for IMAP NOTIFY [RFC 5465].

Unsollicited LIST responses are currently ignored, hence interimap won't
detect mailbox creation/deletion/subcription/unsubscription.

1 files changed, 77 insertions, 57 deletions

diff --git a/interimap b/interimap
index dc1be99..59ff0cf 100755
--- a/interimap
+++ b/interimap
@@ -54,7 +54,7 @@ sub usage(;$) {
 }
 
 my @COMMANDS = qw/repair delete rename/;
-usage(1) unless GetOptions(\%CONFIG, qw/config=s quiet|q target=s@ debug help|h watch:i/, @COMMANDS);
+usage(1) unless GetOptions(\%CONFIG, qw/config=s quiet|q target=s@ debug help|h watch:i notify/, @COMMANDS);
 usage(0) if $CONFIG{help};
 my $COMMAND = do {
     my @command = grep {exists $CONFIG{$_}} @COMMANDS;
@@ -62,9 +62,9 @@ my $COMMAND = do {
     $command[0]
 };
 usage(1) if defined $COMMAND and (($COMMAND eq 'delete' and !@ARGV) or ($COMMAND eq 'rename' and $#ARGV != 1));
-usage(1) if defined $COMMAND and defined $CONFIG{watch};
+usage(1) if defined $COMMAND and (defined $CONFIG{watch} or defined $CONFIG{notify});
 usage(1) if $CONFIG{target} and !(defined $COMMAND and ($COMMAND eq 'delete'or $COMMAND eq 'rename'));
-$CONFIG{watch} = 60 if defined $CONFIG{watch} and $CONFIG{watch} == 0;
+$CONFIG{watch} = $CONFIG{notify} ? 900 : 60 unless $CONFIG{watch};
 @ARGV = map {uc $_ eq 'INBOX' ? 'INBOX' : $_ } @ARGV; # INBOX is case-insensitive
 die "Invalid mailbox name $_" foreach grep !/\A([\x01-\x7F]+)\z/, @ARGV;
 
@@ -237,10 +237,13 @@ logger(undef, ">>> $NAME $VERSION");
 
 my $LIST = '"" ';
 my @LIST_PARAMS;
+my %LIST_PARAMS_STATUS = (STATUS => [qw/UIDVALIDITY UIDNEXT HIGHESTMODSEQ/]);
 if (!defined $COMMAND or $COMMAND eq 'repair') {
     $LIST  = '('.uc($CONF->{_}->{'list-select-opts'}).') '.$LIST if defined $CONF->{_}->{'list-select-opts'};
     $LIST .= (defined $CONF->{_}->{'list-mailbox'} ? '('.$CONF->{_}->{'list-mailbox'}.')' : '*') unless @ARGV;
-    @LIST_PARAMS = ('SUBSCRIBED', 'STATUS (UIDVALIDITY UIDNEXT HIGHESTMODSEQ)');
+    @LIST_PARAMS = ('SUBSCRIBED');
+    push @LIST_PARAMS, map { "$_ (".join(' ', @{$LIST_PARAMS_STATUS{$_}}).")" } keys %LIST_PARAMS_STATUS
+        unless $CONFIG{notify};
 }
 $LIST .= $#ARGV == 0 ? Net::IMAP::InterIMAP::quote($ARGV[0])
        : ('('.join(' ',map {Net::IMAP::InterIMAP::quote($_)} @ARGV).')') if @ARGV;
@@ -258,20 +261,8 @@ foreach my $name (qw/local remote/) {
     $IMAP->{$name} = { client => Net::IMAP::InterIMAP::->new(%config) };
     my $client = $IMAP->{$name}->{client};
 
-    die "Non $_-capable IMAP server.\n" foreach $client->incapable(qw/LIST-EXTENDED LIST-STATUS UIDPLUS/);
-    # XXX We should start by listing all mailboxes matching the user's LIST
-    #     criterion, then issue "SET NOTIFY (mailboxes ... (...))".  But this
-    #     crashes the IMAP client:
-    #     http://dovecot.org/pipermail/dovecot/2015-July/101473.html
-    #my $mailboxes = $client->list((uc $config{'subscribed-only'} eq 'TRUE' ? '(SUBSCRIBED)' : '' )
-    #                             .$config{mailboxes}, 'SUBSCRIBED');
-    # $client->notify('SELECTED', 'MAILBOXES ('.join(' ', keys %$mailboxes).')');
-    # XXX NOTIFY doesn't work as expected for INBOX
-    #     http://dovecot.org/pipermail/dovecot/2015-July/101514.html
-    #$client->notify(qw/SELECTED SUBSCRIBED/) if $CONFIG{watch};
-    # XXX We shouldn't need to ask for STATUS responses here, and use
-    #     NOTIFY's STATUS indicator instead.  However Dovecot violates RFC
-    #     5464: http://dovecot.org/pipermail/dovecot/2015-July/101474.html
+    die "Non $_-capable IMAP server.\n" foreach $client->incapable(qw/LIST-EXTENDED UIDPLUS/);
+    die "Non LIST-STATUS-capable IMAP server.\n" if !$CONFIG{notify} and $client->incapable('LIST-STATUS');
 }
 
 @{$IMAP->{$_}}{qw/mailboxes delims/} = $IMAP->{$_}->{client}->list($LIST, @LIST_PARAMS) for qw/local remote/;
@@ -1067,26 +1058,6 @@ sub sync_messages($$;$$) {
 }
 
 
-# Wait up to $timout seconds for notifications on either IMAP server.
-# Then issue a NOOP so the connection doesn't terminate for inactivity.
-sub wait_notifications(;$) {
-    my $timeout = shift // 300;
-
-    while ($timeout > 0) {
-        my $r1 = $lIMAP->slurp();
-        my $r2 = $rIMAP->slurp();
-        last if $r1 or $r2; # got update!
-
-        sleep 1;
-        if (--$timeout == 0) {
-            $lIMAP->noop();
-            $rIMAP->noop();
-            # might have got updates so exit the loop
-        }
-    }
-}
-
-
 #############################################################################
 # Resume interrupted mailbox syncs (before initializing the cache).
 #
@@ -1167,7 +1138,27 @@ if (defined $COMMAND and $COMMAND eq 'repair') {
 }
 
 
-while(1) {
+if ($CONFIG{notify}) {
+	# Be notified of new messages with EXISTS/RECENT responses, but don't
+	# receive unsolicited FETCH responses with a RFC822/BODY[].  It costs us an
+	# extra roundtrip, but we need to sync FLAG updates and VANISHED responses
+	# in batch mode, update the HIGHESTMODSEQ, and *then* issue an explicit UID
+	# FETCH command to get new message, and process each FETCH response with a
+	# RFC822/BODY[] attribute as they arrive.
+    my $mailboxes = join(' ', map {Net::IMAP::InterIMAP::quote($_)} @MAILBOXES);
+    my %mailboxes = map { $_ => [qw/MessageNew MessageExpunge FlagChange/] }
+                        ( "MAILBOXES ($mailboxes)", 'SELECTED' );
+    my %personal = ( personal => [qw/MailboxName SubscriptionChange/] );
+
+    foreach ($lIMAP, $rIMAP) {
+        # require STATUS responses for our @MAILBOXES only
+        $_->notify('SET STATUS', %mailboxes);
+        $_->notify('SET', %mailboxes, %personal);
+    }
+}
+
+
+sub loop() {
     while(@MAILBOXES) {
         if (defined $MAILBOX and ($lIMAP->is_dirty($MAILBOX) or $rIMAP->is_dirty($MAILBOX))) {
             # $MAILBOX is dirty on either the local or remote mailbox
@@ -1203,26 +1194,55 @@ while(1) {
             sync_messages($IDX, $MAILBOX);
         }
     }
-    # clean state!
-    exit 0 unless $CONFIG{watch};
-
-    # we need to issue a NOOP command or go back to AUTH state since the
-    # LIST command may not report the correct HIGHESTMODSEQ value for
-    # the mailbox currently selected.
-    if (defined $MAILBOX) {
-        # Prefer UNSELECT over NOOP commands as it requires a single command per cycle
-        if ($lIMAP->incapable('UNSELECT') or $rIMAP->incapable('UNSELECT')) {
-            $_->noop() foreach ($lIMAP, $rIMAP);
-        } else {
-            $_->unselect() foreach ($lIMAP, $rIMAP);
-            undef $MAILBOX;
-        }
+}
+sub notify(@) {
+    # TODO: interpret LIST responses to detect mailbox
+    # creation/deletion/subcription/unsubscription
+    # mailbox creation
+    #   * LIST () "/" test
+    # mailbox subscribtion
+    #   * LIST (\Subscribed) "/" test
+    # mailbox unsubscribtion
+    #   * LIST () "/" test
+    # mailbox renaming
+    #   * LIST () "/" test2 ("OLDNAME" (test))
+    # mailbox deletion
+    #   * LIST (\NonExistent) "/" test2
+    unless (Net::IMAP::InterIMAP::slurp(\@_, $CONFIG{watch}, \&Net::IMAP::InterIMAP::is_dirty)) {
+        $_->noop() foreach @_;
     }
+}
+
+unless (defined $CONFIG{watch}) {
+    loop();
+    exit 0;
+}
+
+while (1) {
+    loop();
+
+    if ($CONFIG{notify}) {
+        notify($lIMAP, $rIMAP);
+    }
+    else {
+        # we need to issue a NOOP command or go back to AUTH state since the
+        # LIST command may not report the correct HIGHESTMODSEQ value for
+        # the mailbox currently selected
+        if (defined $MAILBOX) {
+            # Prefer UNSELECT over NOOP commands as it requires a single command per cycle
+            if ($lIMAP->incapable('UNSELECT') or $rIMAP->incapable('UNSELECT')) {
+                $_->noop() foreach ($lIMAP, $rIMAP);
+            } else {
+                $_->unselect() foreach ($lIMAP, $rIMAP);
+                undef $MAILBOX;
+            }
+        }
 
-    sleep $CONFIG{watch};
-    # Refresh the mailbox list and status
-    @{$IMAP->{$_}}{qw/mailboxes delims/} = $IMAP->{$_}->{client}->list($LIST, @LIST_PARAMS) for qw/local remote/;
-    @MAILBOXES = sync_mailbox_list();
+        sleep $CONFIG{watch};
+        # refresh the mailbox list and status
+        @{$IMAP->{$_}}{qw/mailboxes delims/} = $IMAP->{$_}->{client}->list($LIST, @LIST_PARAMS) for qw/local remote/;
+        @MAILBOXES = sync_mailbox_list();
+    }
 }
 
 END { cleanup(); }