From 76be3c7c47ace843ab3ebd216252c63411a1222e Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem@fripost.org>
Date: Sat, 5 Mar 2016 19:49:08 +0100
Subject: Ensure the FD_CLOEXEC bit is 1 on sockets, logger and state files.

---
 interimap                 | 3 +++
 lib/Net/IMAP/InterIMAP.pm | 9 ++++++++-
 pullimap                  | 9 +++++++--
 3 files changed, 18 insertions(+), 3 deletions(-)

diff --git a/interimap b/interimap
index b377d4e..76174ee 100755
--- a/interimap
+++ b/interimap
@@ -26,6 +26,7 @@ my $NAME = 'interimap';
 use Getopt::Long qw/:config posix_default no_ignore_case gnu_compat
                             bundling auto_version/;
 use DBI ();
+use Fcntl qw/F_GETFL F_SETFL FD_CLOEXEC/;
 use List::Util 'first';
 
 use lib 'lib';
@@ -101,6 +102,8 @@ my ($DBFILE, $LOCKFILE, $LOGGER_FD);
         open $LOGGER_FD, '>>', $CONF->{_}->{logfile}
             or die "Can't open $CONF->{_}->{logfile}: $!\n";
         $LOGGER_FD->autoflush(1);
+        my $flags = fcntl($LOGGER_FD, F_GETFL, 0)       or die "fcntl F_GETFL: $!";
+        fcntl($LOGGER_FD, F_SETFL, $flags | FD_CLOEXEC) or die "fcntl F_SETFL: $!";
     }
     elsif ($CONFIG{debug}) {
         $LOGGER_FD = \*STDERR;
diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index 2898905..40f4193 100644
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -23,6 +23,7 @@ use strict;
 use Compress::Raw::Zlib qw/Z_OK Z_FULL_FLUSH Z_SYNC_FLUSH MAX_WBITS/;
 use Config::Tiny ();
 use Errno 'EINTR';
+use Fcntl qw/F_GETFL F_SETFL FD_CLOEXEC/;
 use Net::SSLeay ();
 use List::Util qw/all first/;
 use POSIX ':signal_h';
@@ -1354,7 +1355,13 @@ sub _tcp_connect($$$) {
 
     foreach my $ai (@res) {
         socket my $s, $ai->{family}, $ai->{socktype}, $ai->{protocol};
-        return $s if defined $s and connect($s, $ai->{addr});
+        # TODO: add a connection timeout
+        # http://devpit.org/wiki/Connect%28%29_with_timeout_%28in_Perl%29
+        if (defined $s and connect($s, $ai->{addr})) {
+            my $flags = fcntl($s, F_GETFL, 0)       or $self->panic("fcntl F_GETFL: $!");
+            fcntl($s, F_SETFL, $flags | FD_CLOEXEC) or $self->panic("fcntl F_SETFL: $!");
+            return $s;
+        }
     }
     $self->fail("Can't connect to $host:$port");
 }
diff --git a/pullimap b/pullimap
index 40f7f6f..12b2568 100755
--- a/pullimap
+++ b/pullimap
@@ -25,7 +25,7 @@ our $VERSION = '0.3';
 my $NAME = 'pullimap';
 
 use Errno 'EINTR';
-use Fcntl qw/O_CREAT O_RDWR O_DSYNC LOCK_EX SEEK_SET/;
+use Fcntl qw/O_CREAT O_RDWR O_DSYNC LOCK_EX SEEK_SET F_GETFL F_SETFL FD_CLOEXEC/;
 use Getopt::Long qw/:config posix_default no_ignore_case gnu_getopt auto_version/;
 use List::Util 'first';
 use Socket qw/PF_INET PF_INET6 SOCK_STREAM/;
@@ -82,6 +82,9 @@ do {
     }
 
     sysopen($STATE, $statefile, O_CREAT|O_RDWR|O_DSYNC, 0600) or die "Can't open $statefile: $!";
+    my $flags = fcntl($STATE, F_GETFL, 0)       or die "fcntl F_GETFL: $!";
+    fcntl($STATE, F_SETFL, $flags | FD_CLOEXEC) or die "fcntl F_SETFL: $!";
+
     flock($STATE, LOCK_EX) or die "Can't flock $statefile: $!";
 
 
@@ -90,6 +93,8 @@ do {
         require 'Time/HiRes.pm';
         open $LOGGER_FD, '>>', $logfile or die "Can't open $logfile: $!\n";
         $LOGGER_FD->autoflush(1);
+        my $flags = fcntl($LOGGER_FD, F_GETFL, 0)       or die "fcntl F_GETFL: $!";
+        fcntl($LOGGER_FD, F_SETFL, $flags | FD_CLOEXEC) or die "fcntl F_SETFL: $!";
     }
     elsif ($CONFIG{debug}) {
         $LOGGER_FD = \*STDERR;
@@ -253,7 +258,7 @@ sub pull(;$) {
         writeUID($uid);
     }, @$ignore);
 
-    # terminate the transmission channel gracefully, cf RFC 5321 section 4.5.3.2
+    # terminate the SMTP transmission channel gracefully, cf RFC 5321 section 4.5.3.2
     smtp_send('QUIT' => '221') if defined $SMTP;
     undef $SMTP;
 
-- 
cgit v1.2.3