Originally, I didn't have the timeout of 5 seconds in the select, but I added it in for debug. And what I noticed is that once the client is killed, even the default timeout stops occurring. It's as if the select stops working altogether.
Why do you assume your program is hanging on the select()?
This code usually works like gangbusters
I don't see how that's possible:
1) What does the second line here do:
for (keys %openStreamsSock) {
...
...
$openStreamsSock($streamRequest++) = $sock->accept();
2) This causes an error for me:
$openStreamsSock($streamRequest++) = $sock->accept();
..even when I use IO::Socket.
3) You never add new connections to the $fin string:
if (vec($fout, fileno($sock),1))
{
$openStreamsSock($streamRequest++) = $sock->accept();
}
As a result, when you ask select() to check all the filehandles in your $fin string:
my $nfound = select ($fout=$fin, undef, undef, 5);
the select never checks to see if any of the new connections are readable. Therefore, this if-statement:
if (vec($fout, fileno($openStreamsSock{$streamID}),1))
fails for any new connection.
4) This conditional:
if (defined ($msgSize) && ($msgSize > 0))
is equivalent to:
if ($msgSize > 0)
or simply:
if ($msgSize)
Although, I think the '> 0' conditional is more specific and therefore clearer.
5) You never delete closed connections from the $fin string:
else
{
# $msgSize being 0 indicates end of stream, or
# $msgSize being undef indicates error, so close
close ($openStreamsSock{$streamID});
delete ($openStreamsSock{$streamID});
}
Therefore, your select() will continue to check whether all your filehandles are readable--even filehandles for disconnected sockets. I wouldn't think that would be a problem; I would think that select() would say that a filehandle on a closed socket wouldn't be readable. You would be just unnecessarily checking the filehandle. However, that is in fact your problem. I replaced your $sock->accept() line with this:
say "in 2nd if";
#$openStreamsSock{$streamRequest++} = $LISTEN_SOCK->accept();
my $packed_remote_addr = accept(my $CONNECTION, $LISTEN_SOCK)
or warn "Couldn't connect: $!";
say "before 3rd if";
if ($packed_remote_addr) #then created a connection
{
vec($fin, fileno $CONNECTION, 1) = 1;
$openStreamsSock{$streamRequest++} = $CONNECTION;
}
And after a client disconnects, somehow the code blocks on the accept(). Inexplicably, after a client disconnects the select() says that the $LISTEN_SOCK is readable--in other words, select() says a client is trying to connect, which doesn't make any sense. Unfortunately, I have no idea why that is the case. Fortunately, there is a solution: remove the closed socket from $fin,
else
{
# $msgSize being 0 indicates end of stream, or
# $msgSize being undef indicates error, so close
vec($fin, fileno $openStreamsSock{$streamID}, 1) = 0;
close ($openStreamsSock{$streamID});
delete ($openStreamsSock{$streamID});
Make sure you remove the socket from $fin *before* closing the socket.
The following is a working example that avoids all the problems you experienced--by properly adding and removing filehandles from $fin. Using this select():
select($rout=$rin, undef, undef, undef)worked fine for me.
#CLIENT(run in multiple terminals to simulate multiple clients)
use strict;
use warnings;
use 5.010;
use Socket;
my $protocol = getprotobyname 'tcp';
socket my $SOCK, AF_INET, SOCK_STREAM, $protocol
or die "Couldn't create socket: $!";
my $port = 12555;
my $host = 'localhost';
my $packed_host = gethostbyname $host
or die "Unknown host: $!";
my $sock_addr = sockaddr_in $port, $packed_host;
connect $SOCK, $sock_addr or die "couldn't connect: $!";
my $old_out = select $SOCK;
$| = 1;
select $old_out;
print "Enter some text: ";
while (my $to_send = <STDIN>) { #ctrl+C to kill client, ctrl+D to sen
+d eof
print $SOCK $to_send;
}
close $SOCK;
#SERVER:
use strict;
use warnings;
use 5.010;
use Socket;
my $protocol = getprotobyname 'tcp';
socket my $LISTEN_SOCK, AF_INET, SOCK_STREAM, $protocol
or die "Can't make socket: $!";
setsockopt $LISTEN_SOCK, SOL_SOCKET, SO_REUSEADDR, 1
or die "Cant set SO_REUSADDR: $!";
my $port = 12555;
my $listen_addr = sockaddr_in $port, INADDR_ANY;
bind $LISTEN_SOCK, $listen_addr or die "bind failed: $!";
listen $LISTEN_SOCK, 5;
warn "processing sockets...\n";
my $rin = '';
my $rout;
vec($rin, fileno($LISTEN_SOCK), 1) = 1;
my %open_sockets;
my ($remote_host, $remote_port);
while (1) {
my $nfound = select ($rout=$rin, undef, undef, undef);
if ($nfound) {
if (vec $rout, fileno $LISTEN_SOCK, 1) {
my $packed_remote_addr = accept my ($CONNECTION), $LISTEN_
+SOCK;
if ($packed_remote_addr) {
vec($rin, fileno $CONNECTION, 1) = 1;
($remote_port, my $packed_remote_host) =
unpack_sockaddr_in($packed_remote_addr);
$remote_host = inet_ntoa $packed_remote_host;
warn "adding new connection to hash...\n";
$open_sockets{fileno $CONNECTION} =
[$CONNECTION, "$remote_host : $remote_port"];
}
else {
warn "couldn't connect";
}
}
for my $filenum (keys %open_sockets) {
my ($CONN, $remote_info) = @{$open_sockets{$filenum}};
if (vec $rout, $filenum, 1) {
my $available_data;
my $result = sysread $CONN, $available_data, 8096;
if ($result) { #data was read from socket
print "[$remote_info] says: $available_data";
}
elsif ($result == 0) { #eof=>socket closed
delete $open_sockets{$filenum};
vec($rin, $filenum, 1) = 0;
close $CONN;
say "[$remote_info]: deleted from hash. Goodbye!";
}
else {#undef=>IO error on socket
warn "[$remote_info]: experienced an IO error: $!"
+;
}
}
}
}
}
|