Merge tag 'upstream/0.1' into debian

Upstream version 0.1

5 files changed, 108 insertions, 34 deletions

diff --git a/INSTALL b/INSTALL
index e11e08a..7bc3eef 100644
--- a/INSTALL
+++ b/INSTALL
@@ -8,9 +8,8 @@ InterIMAP depends on the following Perl modules:
   - IO::Select (core module)
   - IO::Socket::INET (core module) for 'type=imap'
   - IO::Socket::SSL for 'type=imaps' (or 'type=imap' and 'STARTTLS=YES')
-  - IPC::Open2 (core module) for 'type=tunnel'
   - List::Util (core module)
-  - POSIX (core module) if 'logfile' is set
+  - POSIX (core module)
   - Socket (core module)
   - Time::HiRes (core module) if 'logfile' is set
 
diff --git a/interimap b/interimap
index 6442054..af8b7fd 100755
--- a/interimap
+++ b/interimap
@@ -51,14 +51,19 @@ sub usage(;$) {
     }
     exit $rv;
 }
-usage(1) unless GetOptions(\%CONFIG, qw/config=s quiet|q target=s@ debug help|h repair delete rename/);
+
+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(0) if $CONFIG{help};
 my $COMMAND = do {
-    my @command = grep {exists $CONFIG{$_}} qw/repair delete rename/;
+    my @command = grep {exists $CONFIG{$_}} @COMMANDS;
     usage(1) if $#command>0;
     $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 (($COMMAND eq 'delete' and !@ARGV) or ($COMMAND eq 'rename' and $#ARGV != 1));
+usage(1) if defined $COMMAND and defined $CONFIG{watch};
+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;
 @ARGV = map {uc $_ eq 'INBOX' ? 'INBOX' : $_ } @ARGV; # INBOX is case-insensitive
 
 
@@ -200,7 +205,8 @@ $DBH->do('PRAGMA foreign_keys = ON');
 sub msg($@) {
     my $name = shift;
     return unless @_;
-    logger($name, @_) if defined $LOGGER_FD and $LOGGER_FD->fileno != fileno STDERR;
+    logger($name, @_) if defined $LOGGER_FD and defined $LOGGER_FD->fileno
+        and $LOGGER_FD->fileno != fileno STDERR;
     my $prefix = defined $name ? "$name: " : '';
     print STDERR $prefix, @_, "\n";
 }
@@ -208,7 +214,8 @@ sub logger($@) {
     my $name = shift;
     return unless @_ and defined $LOGGER_FD;
     my $prefix = '';
-    if ($LOGGER_FD->fileno != fileno STDERR) {
+    if (defined $LOGGER_FD and defined $LOGGER_FD->fileno
+            and $LOGGER_FD->fileno != fileno STDERR) {
         my ($s, $us) = Time::HiRes::gettimeofday();
         $prefix = POSIX::strftime("%b %e %H:%M:%S", localtime($s)).".$us ";
     }
@@ -221,6 +228,17 @@ logger(undef, ">>> $NAME $VERSION");
 #############################################################################
 # Connect to the local and remote IMAP servers
 
+my $LIST = '"" ';
+my @LIST_PARAMS;
+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 .= $#ARGV == 0 ? Net::IMAP::InterIMAP::quote($ARGV[0])
+       : ('('.join(' ',map {Net::IMAP::InterIMAP::quote($_)} @ARGV).')') if @ARGV;
+
+
 my $IMAP;
 foreach my $name (qw/local remote/) {
     my %config = %{$CONF->{$name}};
@@ -246,19 +264,9 @@ foreach my $name (qw/local remote/) {
     # 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
-
-    my $list = '"" ';
-    my @params;
-    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;
-        @params = ('SUBSCRIBED', 'STATUS (UIDVALIDITY UIDNEXT HIGHESTMODSEQ)');
-    }
-    $list .= $#ARGV == 0 ? Net::IMAP::InterIMAP::quote($ARGV[0])
-           : ('('.join(' ',map {Net::IMAP::InterIMAP::quote($_)} @ARGV).')') if @ARGV;
-    @{$IMAP->{$name}}{qw/mailboxes delims/} = $client->list($list, @params);
 }
 
+@{$IMAP->{$_}}{qw/mailboxes delims/} = $IMAP->{$_}->{client}->list($LIST, @LIST_PARAMS) for qw/local remote/;
 
 ##############################################################################
 #
@@ -410,7 +418,7 @@ elsif (defined $COMMAND and $COMMAND eq 'rename') {
 # Synchronize mailbox and subscription lists
 
 my @MAILBOXES;
-{
+sub sync_mailbox_list() {
     my %mailboxes;
     $mailboxes{$_} = 1 foreach keys %{$IMAP->{local}->{mailboxes}};
     $mailboxes{$_} = 1 foreach keys %{$IMAP->{remote}->{mailboxes}};
@@ -497,8 +505,9 @@ my @MAILBOXES;
         }
     }
 }
+
+sync_mailbox_list();
 my ($lIMAP, $rIMAP) = map {$IMAP->{$_}->{client}} qw/local remote/;
-undef $IMAP;
 
 
 #############################################################################
@@ -1150,8 +1159,6 @@ if (defined $COMMAND and $COMMAND eq 'repair') {
 
 while(1) {
     while(@MAILBOXES) {
-        my $cache;
-        my $update = 0;
         if (defined $MAILBOX and ($lIMAP->is_dirty($MAILBOX) or $rIMAP->is_dirty($MAILBOX))) {
             # $MAILBOX is dirty on either the local or remote mailbox
             sync_messages($IDX, $MAILBOX);
@@ -1187,8 +1194,25 @@ while(1) {
         }
     }
     # clean state!
-    exit 0 unless defined $COMMAND and $COMMAND eq 'watch';
-    wait_notifications(900);
+    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;
+        }
+    }
+
+    sleep $CONFIG{watch};
+    # Refresh the mailbox list and status
+    @{$IMAP->{$_}}{qw/mailboxes delims/} = $IMAP->{$_}->{client}->list($LIST, @LIST_PARAMS) for qw/local remote/;
+    sync_mailbox_list();
 }
 
 END {
diff --git a/interimap.1 b/interimap.1
index 00b87e3..44235fc 100644
--- a/interimap.1
+++ b/interimap.1
@@ -145,6 +145,12 @@ to the given target.  Can be repeated to act on multiple targets.  By
 default all three targets are considered.
 
 .TP
+.B \fB\-\-watch\fR[\fB=\fR\fIseconds\fR]
+Don't exit after a successful synchronization, and keep synchronizing
+forevever instead.  Sleep for the given number of \fIseconds\fR (or
+\(lq60\(rq if omitted) between two synchronizations.
+
+.TP
 .B \-q\fR, \fB\-\-quiet\fR
 Try to be quiet.
 
diff --git a/interimap.service b/interimap.service
index 7f2d035..2dc1506 100644
--- a/interimap.service
+++ b/interimap.service
@@ -4,9 +4,9 @@ Wants=network-online.target
 After=network-online.target
 
 [Service]
-ExecStart=/usr/bin/interimap
-RestartSec=60s
-Restart=always
+ExecStart=/usr/bin/interimap --watch
+RestartSec=10min
+Restart=on-failure
 
 [Install]
 WantedBy=default.target
diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index 26cfbbd..97756f4 100644
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -24,6 +24,7 @@ use Config::Tiny ();
 use IO::Select ();
 use List::Util 'first';
 use Socket 'SO_KEEPALIVE';
+use POSIX ':signal_h';
 
 use Exporter 'import';
 BEGIN {
@@ -225,10 +226,33 @@ sub new($%) {
     $self->{_STATE} = '';
 
     if ($self->{type} eq 'tunnel') {
-        require 'IPC/Open2.pm';
         my $command = $self->{command} // $self->fail("Missing tunnel command");
-        my $pid = IPC::Open2::open2(@$self{qw/STDOUT STDIN/}, $command)
-            or $self->panic("Can't fork: $!");
+
+        pipe $self->{STDOUT}, my $wd or $self->panic("Can't pipe: $!");
+        pipe my $rd, $self->{STDIN}  or $self->panic("Can't pipe: $!");
+
+        my $pid = fork // $self->panic("Can't fork: $!");
+
+        unless ($pid) {
+            # children
+            foreach (\*STDIN, \*STDOUT, $self->{STDIN}, $self->{STDOUT}) {
+                close $_ or $self->panic("Can't close: $!");
+            }
+            open STDIN,  '<&', $rd or $self->panic("Can't dup: $!");
+            open STDOUT, '>&', $wd or $self->panic("Can't dup: $!");
+
+            my $sigset = POSIX::SigSet::->new(SIGINT);
+            my $oldsigset = POSIX::SigSet::->new();
+
+            sigprocmask(SIG_BLOCK, $sigset, $oldsigset) // $self->panic("Can't block SIGINT: $!");
+
+            exec $command or $self->panic("Can't exec: $!");
+        }
+
+        # parent
+        foreach ($rd, $wd) {
+            close $_ or $self->panic("Can't close: $!");
+        }
     }
     else {
         my %args = (Proto => 'tcp', Blocking => 1);
@@ -287,8 +311,8 @@ sub new($%) {
     # are considered.
     $self->{_MODIFIED} = {};
 
-    if (defined $self->{'logger-fd'} and $self->{'logger-fd'}->fileno != fileno STDERR) {
-        require 'POSIX.pm';
+    if (defined $self->{'logger-fd'} and defined $self->{'logger-fd'}->fileno
+            and $self->{'logger-fd'}->fileno != fileno STDERR) {
         require 'Time/HiRes.pm';
     }
 
@@ -400,7 +424,8 @@ sub DESTROY($) {
 sub log($@) {
     my $self = shift;
     return unless @_;
-    $self->logger(@_) if defined $self->{'logger-fd'} and $self->{'logger-fd'}->fileno != fileno STDERR;
+    $self->logger(@_) if defined $self->{'logger-fd'} and defined $self->{'logger-fd'}->fileno
+        and $self->{'logger-fd'}->fileno != fileno STDERR;
     my $prefix = defined $self->{name} ? $self->{name} : '';
     $prefix .= "($self->{_SELECTED})" if $self->{_STATE} eq 'SELECTED';
     print STDERR $prefix, ': ', @_, "\n";
@@ -409,7 +434,8 @@ sub logger($@) {
     my $self = shift;
     return unless @_ and defined $self->{'logger-fd'};
     my $prefix = '';
-    if ($self->{'logger-fd'}->fileno != fileno STDERR) {
+    if (defined $self->{'logger-fd'}->fileno and defined $self->{'logger-fd'}->fileno
+            and $self->{'logger-fd'}->fileno != fileno STDERR) {
         my ($s, $us) = Time::HiRes::gettimeofday();
         $prefix = POSIX::strftime("%b %e %H:%M:%S", localtime($s)).".$us ";
     }
@@ -500,6 +526,25 @@ sub examine($$;$$) {
 }
 
 
+# $self->unselect()
+#   Issue an UNSELECT command (cf. RFC 3691). Upon success, change the
+#   state to AUTH.
+sub unselect($) {
+    my $self = shift;
+
+    $self->_send('UNSELECT');
+
+    $self->{_STATE} = 'AUTH';
+    delete $self->{_SELECTED};
+
+    # it is safe to wipe cached VANISHED responses or FLAG updates,
+    # because interesting stuff must have made the mailbox dirty so
+    # we'll get back to it
+    $self->{_VANISHED} = [];
+    $self->{_MODIFIED} = {};
+}
+
+
 # $self->logout()
 #   Issue a LOGOUT command.  Change the state to LOGOUT.
 sub logout($) {