libinterimap: use socketpair(2) in tunnel mode.

Rather than two pipe(2).  Also, use SOCK_CLOEXEC to save a fcntl() call
when setting the close-on-exec flag on the socket (even though Perl will
likely call fcntl() anyway).

3 files changed, 28 insertions, 41 deletions

diff --git a/Changelog b/Changelog
index 251d5dc..cd03304 100644
--- a/Changelog
+++ b/Changelog
@@ -8,6 +8,10 @@ interimap (0.5) upstream;
    happen if mailboxes from different namespaces are being listed.  The
    workaround here is to run a new interimap instance for each
    namespace.
+ * libinterimap: in tunnel mode, use a socketpair rather than two pipes
+   for IPC between the interimap and the IMAP server.  Also, use
+   SOCK_CLOEXEC to save a fcntl() call when setting the close-on-exec
+   flag on the socket.
  + interimap: write which --target to use in --delete command
    suggestions.
  + interimap: avoid caching hierarchy delimiters forever in the
diff --git a/interimap.md b/interimap.md
index a230c09..2f064e1 100644
--- a/interimap.md
+++ b/interimap.md
@@ -265,8 +265,9 @@ Valid options are:
 :   One of `imap`, `imaps` or `tunnel`.
     `type=imap` and `type=imaps` are respectively used for IMAP and IMAP
     over SSL/TLS connections over a INET socket.
-    `type=tunnel` causes `interimap` to open a pipe to a *command*
-    instead of a raw socket.
+    `type=tunnel` causes `interimap` to create an unnamed pair of
+    connected sockets for interprocess communication with a *command*
+    instead of a opening a network socket.
     Note that specifying `type=tunnel` in the `[remote]` section makes
     the default *database* to be `localhost.db`.
     (Default: `imaps`.)
diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index 86f08a9..1dd54b7 100644
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -23,11 +23,10 @@ use strict;
 use Compress::Raw::Zlib qw/Z_OK Z_FULL_FLUSH Z_SYNC_FLUSH MAX_WBITS/;
 use Config::Tiny ();
 use Errno qw/EEXIST EINTR/;
-use Fcntl qw/F_GETFD F_SETFD FD_CLOEXEC/;
 use Net::SSLeay 1.73 ();
 use List::Util qw/all first/;
 use POSIX ':signal_h';
-use Socket qw/SOCK_STREAM IPPROTO_TCP AF_INET AF_INET6 SOCK_RAW :addrinfo/;
+use Socket qw/SOCK_STREAM SOCK_RAW IPPROTO_TCP AF_UNIX AF_INET AF_INET6 PF_UNSPEC SOCK_CLOEXEC :addrinfo/;
 
 use Exporter 'import';
 BEGIN {
@@ -304,18 +303,13 @@ sub new($%) {
 
     if ($self->{type} eq 'tunnel') {
         my $command = $self->{command} // $self->fail("Missing tunnel command");
-
-        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: $!");
+        socketpair($self->{S}, my $s, AF_UNIX, SOCK_STREAM|SOCK_CLOEXEC, PF_UNSPEC) or $self->panic("socketpair: $!");
+        my $pid = fork // $self->panic("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: $!");
+            close($self->{S}) or $self->panic("Can't close: $!");
+            open STDIN,  '<&', $s or $self->panic("Can't dup: $!");
+            open STDOUT, '>&', $s or $self->panic("Can't dup: $!");
 
             my $stderr2;
             if ($self->{'null-stderr'} // 0) {
@@ -338,30 +332,24 @@ sub new($%) {
         }
 
         # parent
-        foreach ($rd, $wd) {
-            close $_ or $self->panic("Can't close: $!");
-        }
-        foreach (qw/STDIN STDOUT/) {
-            binmode($self->{$_}) // $self->panic("binmode: $!")
-        }
+        close($s) or $self->panic("Can't close: $!");
     }
     else {
         foreach (qw/host port/) {
             $self->fail("Missing option $_") unless defined $self->{$_};
         }
-        my $socket = defined $self->{proxy} ? $self->_proxify(@$self{qw/proxy host port/})
+        $self->{S} = defined $self->{proxy} ? $self->_proxify(@$self{qw/proxy host port/})
                                             : $self->_tcp_connect(@$self{qw/host port/});
         if (defined $self->{keepalive}) {
-            setsockopt($socket, Socket::SOL_SOCKET, Socket::SO_KEEPALIVE, 1)
+            setsockopt($self->{S}, Socket::SOL_SOCKET, Socket::SO_KEEPALIVE, 1)
                 or $self->fail("Can't setsockopt SO_KEEPALIVE: $!");
-            setsockopt($socket, Socket::IPPROTO_TCP, Socket::TCP_KEEPIDLE, 60)
+            setsockopt($self->{S}, Socket::IPPROTO_TCP, Socket::TCP_KEEPIDLE, 60)
                 or $self->fail("Can't setsockopt TCP_KEEPIDLE: $!");
         }
 
-        binmode($socket) // $self->panic("binmode: $!");
-        $self->_start_ssl($socket) if $self->{type} eq 'imaps';
-        $self->{$_} = $socket for qw/STDOUT STDIN/;
     }
+    binmode($self->{S}) // $self->panic("binmode: $!");
+    $self->_start_ssl($self->{S}) if $self->{type} eq 'imaps';
 
     # command counter
     $self->{_TAG} = 0;
@@ -413,7 +401,7 @@ sub new($%) {
         if ($self->{type} eq 'imap' and $self->{STARTTLS}) { # RFC 2595 section 5.1
             $self->fail("Server did not advertise STARTTLS capability.")
                 unless grep {$_ eq 'STARTTLS'} @caps;
-            $self->_start_ssl($self->{STDIN}) if $self->{type} eq 'imaps';
+            $self->_start_ssl($self->{S}) if $self->{type} eq 'imaps';
 
             # refresh the previous CAPABILITY list since the previous one could have been spoofed
             delete $self->{_CAPABILITIES};
@@ -526,11 +514,8 @@ sub DESTROY($) {
     Net::SSLeay::free($self->{_SSL}) if defined $self->{_SSL};
     Net::SSLeay::CTX_free($self->{_SSL_CTX}) if defined $self->{_SSL_CTX};
 
-    shutdown($self->{STDIN}, 2) if $self->{type} ne 'tunnel' and defined $self->{STDIN};
-    foreach (qw/STDIN STDOUT/) {
-        $self->{$_}->close() if defined $self->{$_} and $self->{$_}->opened();
-    }
-
+    shutdown($self->{S}, 2) if $self->{type} ne 'tunnel' and defined $self->{S};
+    $self->{S}->close() if defined $self->{S} and $self->{S}->opened();
     $self->stats() unless $self->{quiet};
 }
 
@@ -677,7 +662,7 @@ sub unselect($) {
 sub logout($) {
     my $self = shift;
     # don't bother if the connection is already closed
-    $self->_send('LOGOUT') if $self->{STDIN}->opened();
+    $self->_send('LOGOUT') if $self->{S}->opened();
     $self->{_STATE} = 'LOGOUT';
     undef $self;
 }
@@ -968,7 +953,7 @@ sub slurp($$$) {
     my $aborted = 0;
 
     my $rin = '';
-    vec($rin, fileno($_->{STDOUT}), 1) = 1 foreach @$selfs;
+    vec($rin, fileno($_->{S}), 1) = 1 foreach @$selfs;
 
     while (1) {
         # first, consider only unprocessed data without our own output
@@ -983,7 +968,7 @@ sub slurp($$$) {
             next if $r == -1 and $! == EINTR; # select(2) was interrupted
             die "select: $!" if $r == -1;
             return $aborted if $r == 0; # nothing more to read (timeout reached)
-            @ready = grep {vec($rout, fileno($_->{STDOUT}), 1)} @$selfs;
+            @ready = grep {vec($rout, fileno($_->{S}), 1)} @$selfs;
             $timeout = $timeleft if $timeout > 0;
         }
 
@@ -1421,7 +1406,7 @@ sub _tcp_connect($$$) {
 
     SOCKETS:
     foreach my $ai (@res) {
-        socket (my $s, $ai->{family}, $ai->{socktype}, $ai->{protocol}) or $self->panic("connect: $!");
+        socket (my $s, $ai->{family}, $ai->{socktype}|SOCK_CLOEXEC, $ai->{protocol}) or $self->panic("socket: $!");
 
         # timeout connect/read/write/... after 30s
         # XXX we need to pack the struct timeval manually: not portable!
@@ -1436,9 +1421,6 @@ sub _tcp_connect($$$) {
             next if $! == EINTR; # try again if connect(2) was interrupted by a signal
             next SOCKETS;
         }
-
-        my $flags = fcntl($s, F_GETFD, 0)       or $self->panic("fcntl F_GETFD: $!");
-        fcntl($s, F_SETFD, $flags | FD_CLOEXEC) or $self->panic("fcntl F_SETFD: $!");
         return $s;
     }
     $self->fail("Can't connect to $host:$port");
@@ -1704,7 +1686,7 @@ sub _getline($;$) {
     my $self = shift;
     my $len = shift // 0;
 
-    my ($stdout, $ssl) = @$self{qw/STDOUT _SSL/};
+    my ($stdout, $ssl) = @$self{qw/S _SSL/};
     $self->fail("Lost connection") unless $stdout->opened();
 
     my (@lit, @line);
@@ -1903,7 +1885,7 @@ sub _cmd_flush($;$$) {
     my $self = shift;
     $self->_cmd_extend_( $_[0] // \$CRLF );
     my $z_flush = $_[1] // Z_SYNC_FLUSH; # the flush point type to use
-    my ($stdin, $ssl) = @$self{qw/STDIN _SSL/};
+    my ($stdin, $ssl) = @$self{qw/S _SSL/};
 
     if ($self->{debug}) {
         # remove $CRLF and literals