perlquestion
flexvault
<p><a href="http://www.perlmonks.org/?node_id=109">Dear Monks</a>,</p>
<p>I am trying to write a server that uses 'IO::Select' to support multiple clients. The following code works 98% of the time, but ever once in a while the server doesn't get any errors that client(s) have crashed. For normal client termination, the client sends a 'close' command and everything is fine. This is only for abnormal termination sessions.
</p><p>
The problem is that when the server thinks it has at least one client, but in fact they are all closed, the loop takes up 100% of the cpu doing nothing. How do I get 99.999% detection?</p><p><b>Note:</b> The code is an adaption of
<a href="http://www.perlmonks.org/?node_id=969030"> code </a> provided by <a href="http://www.perlmonks.org/?node_id=171588"> BroswerUK </a>.
<readmore>
<b>Server:</b>
<code>
#!/usr/local/bin/pyrperl -w
### Server
use strict;
use warnings;
use IO::Socket::INET;
use IO::Select;
# flush after every write
$| = 1;
$SIG{PIPE} = 'IGNORE';
our ( $socket, $select, @ready_clients, %All_Clients );
my $localhost = '127.0.0.1'; my $port = 12345;
# creating object interface of IO::Socket::INET modules which internally does
# socket creation, binding and listening at the specified port address.
$socket = new IO::Socket::INET (
LocalHost => $localhost,
LocalPort => $port,
Proto => 'tcp',
Listen => 5,
Reuse => 1,
) or die "ERROR in Socket Creation : $!\n";
$socket->autoflush;
binmode $socket; $| = 1;
$select = new IO::Select() or die "IO::Select $!";
$select->add($socket); # add the main socket to the set
$All_Clients{$socket} = 1;
print "SERVER Waiting for client connection on port $port\n";
my $rdata = ""; for ( 0..255) { $rdata .= chr($_); }
my $len = pack 'N',length($rdata);
my $sdata = $len . $rdata;
my $start = 0; my $finish = 0; my $tasks = 0;
while(1)
{
my @ready = $select->can_read(.025);
foreach my $client (@ready)
{
if ( $client == $socket ) #{ next; }
# if ( ! exists $All_Clients{$client} )
{ # Create a new socket
my $new = $client->accept();
# binmode $new; $| = 1;
$select->add($new); $All_Clients{$new} = 1;
$start++; $tasks++; print " Client connected\n";
}
else
{ # Process socket
my $lost = 0;
my $ret = recv( $client, my $in, 4, 0 );
if ( ! defined $ret ) { $lost++; }
if ( ( $lost==0 )&&( length($in)==4 ) )
{ my $len = unpack('N',$in); # print "**** received ****\n";
$ret = recv( $client, my $data, $len, 0 );
if ( ! defined $ret ) { $lost++; }
if ( $lost==0 )
{ if ( $rdata ne $data ) { die "3.\n$rdata\n$data \n"; }
$ret = send( $client, $sdata, length($sdata), 0 );
if ( ! defined $ret ) { $lost++; }
}
}
if ( $lost > 0 )
{ # Maybe we have finished with the socket
$select->remove($client);
$client->close;
$tasks--; my $total = $select->count();
print " Client dis-connected, $tasks left $total\n";
}
}
}
my $total = $select->count();
if ( ( $start )&&( $total == 1 ) )
{ if ( $finish == 0 ) { $finish = time; }
else
{ if ( time - $finish > 3 ) { exit; }
}
}
}
exit;
</code>
<b>Client:</b>
<code>
#!/usr/local/bin/pyrperl -w
#Client
use strict;
use Time::HiRes qw[ time usleep ];
use IO::Socket::INET;
$\ = $/ = chr(13).chr(10);
my $rdata = ""; for ( 0..255) { $rdata .= chr($_); }
my $len = pack 'N',length($rdata);
my $sdata = $len . $rdata;
print length($rdata),"\n";
my $svr = IO::Socket::INET->new( "localhost:12345" )
or die "Client: First client connect failed $^E";
binmode $svr; $| = 1;
print "Client connected";
my $last = time + 1; my $exchanges = 0;
while( 1 )
{ send( $svr, $sdata, length($sdata), 0 ) or die "$! / $^E";
my $in;
recv ( $svr, $in, 4, 0 );
if ( defined $in )
{ my $len = unpack('N',$in);
recv ( $svr, my $data, $len, 0 );
if ( $rdata ne $data ) { die "3. $! \n"; }
++$exchanges; # print "$len\t$exchanges\n";
if( time > $last )
{
my $rate = sprintf( "%.f", $exchanges );
print "$$ Rate: $rate exchanges/sec\n";
$last = time + 1; $exchanges = 0;
}
}
}
</code>
</readmore>
</p>
<p>Thanks for looking...Ed</p>
<div class="pmsig"><div class="pmsig-733061">
<p><b>"Well done is better than well said." - Benjamin Franklin</b></p>
</div></div>