Connect() with timeout (in Perl)

From Devpit
Jump to: navigation, search

Setting timeouts with TCP is a well-known secret. If you don't know how to do it, good luck finding docs.

Typically when reading or writing, we use select() to time out an operation. Alternatively, we can use socket options SO_RCVTIMEO or SO_SNDTIMEO, but those don't work for connect(). connect() isn't a read or a write operation, so what do we use? The key points are:

  • Set O_NONBLOCK on the socket before calling connect().
  • Call connect(), which will immediately return.
  • Now select() the socket for writing. What we realize here is, any freshly connected socket has an empty write buffer, and can therefore accept at least a small bit of data, and select() will report this. Do not specify reading; there won't be data to read until the remote side writes. Even if you want to wait for the remote side, first block for writing, then immediately follow up with a block for reading. Otherwise in the event of failure, you won't know whether you're reporting an error connecting or a timeout for reading.
  • If connect() fails, report the error. You can't simply read $! since that will be at the whim of the select() call, not the connect() call. Instead, use $! = unpack("L", getsockopt($connection, SOL_SOCKET, SO_ERROR));

Waiting for a connection on a listening socket is much easier. Just select() the listening socket for reading.

So to put it together, here's an example. This is actually a pretty standard procedure. You may find very similar code in C or Perl in other projects.

use strict;
use warnings;

use Errno;
use Fcntl;
use Socket;

# Send an HTTP request, and check for a particular response. Any failure dies.
sub myconnect {
        my ($name, $port, $timeout) = @_;

        my $ip;
        if(lc $name eq "localhost") {
                $ip = "127.0.0.1";  # Don't depend on a DNS for this triviality.
        } elsif($name =~ qr~[a-zA-Z]~s) {
                # DNS lookup.
                defined ($ip = gethostbyname($name)) or die("gethostbyname ${name}: $?\n");
                $ip = inet_ntoa($ip);
        } else {
                $ip = $name;
        }

        # Create socket.
        socket(my $connection, PF_INET, SOCK_STREAM, getprotobyname("tcp")) or die("socket: $!\n");

        # Set autoflushing.
        $_ = select($connection); $| = 1; select $_;

        # Set FD_CLOEXEC.
        $_ = fcntl($connection, F_GETFL, 0) or die "fcntl: $!\n";
        fcntl($connection, F_SETFL, $_ | FD_CLOEXEC) or die "fnctl: $!\n";

        if($timeout) {
                # Set O_NONBLOCK so we can time out connect().
                $_ = fcntl($connection, F_GETFL, 0) or die "fcntl F_GETFL: $!\n";  # 0 for error, 0e0 for 0.
                fcntl($connection, F_SETFL, $_ | O_NONBLOCK) or die "fcntl F_SETFL O_NONBLOCK: $!\n";  # 0 for error, 0e0 for 0.
        }

        # Connect returns immediately because of O_NONBLOCK.
        connect($connection, pack_sockaddr_in($port, inet_aton($ip))) or $!{EINPROGRESS} or die("connect ${ip}:${port} (${name}): $!\n");

        return $connection unless $timeout;

        # Reset O_NONBLOCK.
        $_ = fcntl($connection, F_GETFL, 0) or die "fcntl F_GETFL: $!\n";  # 0 for error, 0e0 for 0.
        fcntl($connection, F_SETFL, $_ & ~ O_NONBLOCK) or die "fcntl F_SETFL not O_NONBLOCK: $!\n";  # 0 for error, 0e0 for 0.

        # Use select() to poll for completion or error. When connect succeeds we can write.
        my $vec = "";
        vec($vec, fileno($connection), 1) = 1;
        select(undef, $vec, undef, $timeout);
        unless(vec($vec, fileno($connection), 1)) {
                # If no response yet, impose our own timeout.
                $! = Errno::ETIMEDOUT();
                die("connect ${ip}:${port} (${name}): $!\n");
        }

        # This is how we see whether it connected or there was an error. Document Unix, are you kidding?!
        $! = unpack("L", getsockopt($connection, SOL_SOCKET, SO_ERROR));
        die("connect ${ip}:${port} (${name}): $!\n") if $!;

        # Set timeout on all reads and writes.
        #
        # Note the difference between Perl's sysread() and read() calls: sysread()
        # queries the kernel exactly once, with max delay specified here. read()
        # queries the kernel repeatedly until there's a read error (such as this
        # timeout), EOF, or a full buffer. So when using read() with a timeout of one
        # second, if the remote server sends 1 byte repeatedly at 1 second intervals,
        # read() will read the whole buffer very slowly and sysread() will return only
        # the first byte. The print() and syswrite() calls are similarly different.
        # <> is of course similar to read() but delimited by newlines instead of buffer
        # sizes.
        setsockopt($connection, SOL_SOCKET, SO_SNDTIMEO, pack("L!L!", $timeout, 0)) or die "setsockopt SOL_SOCKET, SO_SNDTIMEO: $!\n";
        setsockopt($connection, SOL_SOCKET, SO_RCVTIMEO, pack("L!L!", $timeout, 0)) or die "setsockopt SOL_SOCKET, SO_RCVTIMEO: $!\n";

        return $connection;
}

sub start_listening {
        my ($port) = @_;

        my $socket;
        socket($socket, PF_INET, SOCK_STREAM, getprotobyname("tcp")) or die("socket: $!\n");
        setsockopt($socket, SOL_SOCKET, SO_REUSEADDR, 1) or die("setsockopt SOL_SOCKET, SO_REUSEADDR: $!\n");
        bind($socket, pack_sockaddr_in($port, INADDR_ANY)) or die("bind ${port}: $!\n");
        listen($socket, SOMAXCONN) or die("listen ${port}: $!\n");

        # Set FD_CLOEXEC.
        $_ = fcntl($socket, F_GETFL, 0) or die "fcntl: $!\n";
        fcntl($socket, F_SETFL, $_ | FD_CLOEXEC) or die "fnctl: $!\n";

        return $socket;
}

sub accept_with_timeout {
        my ($timeout, $socket) = @_;

        my $vec = "";
        vec($vec, fileno($socket), 1) = 1;
        select($vec, undef, undef, $timeout);
        return undef unless vec($vec, fileno($socket), 1);
        die "accept: $!\n" unless accept(my $connection, $socket);
        $_ = select($connection); $| = 1; select $_;

        # Set FD_CLOEXEC.
        $_ = fcntl($connection, F_GETFL, 0) or die "fcntl: $!\n";
        fcntl($connection, F_SETFL, $_ | FD_CLOEXEC) or die "fnctl: $!\n";

        return $connection;
}