From 85fd56f6f150dba0d74859a9d5e00f16d6b33955 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Sat, 12 Mar 2016 22:14:39 +0100 Subject: 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. --- interimap | 134 ++++++++++++++++++++++++++++++++++++-------------------------- 1 file changed, 77 insertions(+), 57 deletions(-) (limited to 'interimap') 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(); } -- cgit v1.2.3