in reply to
TCP Server hangs with multiple client connections
I looked at your server socket. There's a problem with
IO::Select's can_read. If there's no timeout given, or if it
contains a registered handler, can_read will block. Here's
how I would handle the socket:
#!/usr/bin/perl
select(STDERR);
$| = 1;
select(STDOUT);
$| = 1;
use autodie;
use strictures 1;
use IO::Socket;
use IO::Select;
use Log::Log4perl;
my $sock = new IO::Socket::INET(
LocalAddr => 'www.example.com',
LocalPort => 9000,
Listen => 128,
Reuse => 1,
Blocking => 0,
Proto => 'tcp',
);
our $selSock = new IO::Select($sock);
while( my(@ready) = $selSock->can_read(10) ) {
use strict qw/refs/;
use warnings FATAL => 'syntax';
foreach $_ (@ready) {
if ($_ == $sock) {
my $logger;
my $clientPool;
$logger->info("Base socket is " . $sock);
$logger->info("Adding new socket");
my $newSock = $sock->accept or die;
$logger->info("Added new socket " . $newSock);
$selSock->add($newSock);
my $fd = $selSock->fileno($newSock);
my $address = inet_ntoa($newSock->peeraddr);
my @values = ($fd, $address);
if ($clientPool->queueJob(
queueValues => \@values)) {
$logger->error(
"Failed to queue client connection"
);
my $trash = <$newSock>;
$trash->send($newSock, "** ENQUEUE_FAILED **", 0);
$trash->send($newSock, "** ZERO_BYTES_LEFT **", 0);
$selSock->remove($trash);
$newSock = undef;
sleep 1;
exit;
}
}
}
}