From 6a40ecf6aec13bf650645d65713c0327c6d8c5e6 Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem@fripost.org>
Date: Tue, 8 Sep 2015 00:17:24 +0200
Subject: [PATCH] Block SIGINT signals to the children for type=tunnel.

So we can clean after us (and for instance remove the lockfile).
---
 INSTALL                   |  3 +--
 interimap                 | 12 ++++++++----
 lib/Net/IMAP/InterIMAP.pm | 40 ++++++++++++++++++++++++++++++++-------
 3 files changed, 42 insertions(+), 13 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..a94110b 100755
--- a/interimap
+++ b/interimap
@@ -51,10 +51,12 @@ 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/, @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]
 };
@@ -200,7 +202,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 +211,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 ";
     }
diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index 26cfbbd..35d2075 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 ";
     }
-- 
2.39.2