comment on

Dear Monks,

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.

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?

Note: The code is an adaption of code provided by BroswerUK .

Server:

#!/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 internal
+ly 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_Cl
+ients{$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$da
+ta \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;
[download]

Client:

#!/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;
            }
        }
   }
[download]

Thanks for looking...Ed

"Well done is better than well said." - Benjamin Franklin

In reply to IO::Select and correct way to detect client crashed? by flexvault

Are you posting in the right place? Check out Where do I post X? to know for sure.
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
Want more info? How to link or How to display code and escape characters are good places to start.


laziness, impatience, and hubris
	PerlMonks