aboutsummaryrefslogtreecommitdiffstats
path: root/lib/Net/IMAP/InterIMAP.pm
diff options
context:
space:
mode:
authorGuilhem Moulin <guilhem@fripost.org>2019-05-25 15:27:59 +0200
committerGuilhem Moulin <guilhem@fripost.org>2019-05-27 00:07:30 +0200
commitbacb78530555f9a73d86564837a11d6e75236de5 (patch)
tree9bfbc392d0a565248e004ef158f97df710f4918c /lib/Net/IMAP/InterIMAP.pm
parentb86a1141f7e71cb9244ba4c5609b554417b506bb (diff)
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).
Diffstat (limited to 'lib/Net/IMAP/InterIMAP.pm')
-rw-r--r--lib/Net/IMAP/InterIMAP.pm60
1 files changed, 21 insertions, 39 deletions
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