Skip to content

Instantly share code, notes, and snippets.

@timbunce
Created June 14, 2013 10:53
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save timbunce/5780999 to your computer and use it in GitHub Desktop.
Save timbunce/5780999 to your computer and use it in GitHub Desktop.
Concurrent non-blocking connections in perl
use strict;
use Data::Dumper;
my @hosts = (
'74.125.24.101:80', # google
'74.125.24.101:9999', # google but bad port
'17.172.224.47:80', # apple
'117.53.170.202:80', # www.gov.au
);
my $connected = parallel_connect(hosts => \@hosts, minimum => 1, timeout => 2);
warn Dumper($connected);
exit 0;
use Fcntl;
use Errno qw(EINPROGRESS EALREADY EISCONN);
use Socket;
use Time::HiRes qw ( time sleep );
use Carp qw(croak);
sub parallel_connect {
my %opts = @_;
my $hosts = delete $opts{hosts} or croak "No hosts specified";
my $timeout = delete $opts{timeout} || 2.0;
my $minimum = delete $opts{minimum} || 1;
croak "Unknown options: @{[ sort keys %opts ]}" if %opts;
my $end_time = time() + $timeout;
my $poll_delay = 0.01;
my $proto = getprotobyname('tcp');
# create a non-blocking socket for each host
my %socks = map {
my $socket;
my $flags = 0;
socket($socket, PF_INET, SOCK_STREAM, $proto) || die("socket: $!");
fcntl($socket, F_GETFL, $flags) || die("fcntl: $!");
fcntl($socket, F_SETFL, $flags | O_NONBLOCK) || die("fcntl: $!");
# we assume we've been given ip addresses in dotted-quad notation
# (non-blocking DNS resolution is a whole other ball of wax)
my ($ip, $port) = split /:/, $_;
my %sockinfo = ( socket => $socket, ip => $ip, $port => $port );
my $inet_aton = inet_aton($ip) || die("inet_aton $ip: $!");
$sockinfo{sockaddr} = sockaddr_in($port, $inet_aton);
($_ => \%sockinfo)
} @$hosts;
my %connected;
while (%socks) {
while ( my ($host, $sockinfo) = each %socks ) {
connect($sockinfo->{socket}, $sockinfo->{sockaddr})
and next; # let EISCONN below handle this (rare) race 'hazard'
# 'Operation now in progress' and 'Operation already in progress'
if ($! == EINPROGRESS() || $! == EALREADY()) {
next; # still connecting
}
# at this point we've either connected or failed
delete $socks{$host};
if ($! == EISCONN()) {
delete $sockinfo->{sockaddr};
$connected{$host} = $sockinfo;
}
else {
warn "Unable to connect to $host: $! ".($!+0);
}
}
# check termination conditions
# XXX perhaps via a callback - for now just take the first one(s)
last if keys %connected > $minimum;
last if time() > $end_time;
sleep $poll_delay;
}
return undef unless %connected;
return \%connected;
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment