Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid

Re: IO::Select and correct way to detect client crashed?

by zentara (Archbishop)
on Oct 18, 2012 at 16:02 UTC ( #999761=note: print w/replies, xml ) Need Help??

in reply to IO::Select and correct way to detect client crashed?

I can only relate what I have found is the best way, and that is to use the Glib eventloop system's IO addwatch to handle the conditions. What I have found from practical usage, is that if you get a IN condition, but there are no bytes to be read by sysread, then your connection is down. If you watch the eventloop run, you will see many IN callbacks fired, but there is never any data... there is your clue the connection is lost.

Here is the Glib eventloop code, and it works well with a GUI.

#!/usr/bin/perl use warnings; use strict; use Glib; use IO::Socket; $|++; my @clients; #used for root messaging to all # a cheap and easy way to prevent zombie children # when the forked child exits # avoids the waitpid stuff,otherwise, the defunct # forked children will wait until the main parent script ends. $SIG{CHLD} = 'IGNORE'; my $num_of_client = -1; my $port = 2345; my $server = new IO::Socket::INET( Timeout => 7200, Proto => "tcp", LocalPort => $port, Reuse => 1, Listen => SOMAXCONN ); print "\n",$server,' ',fileno($server),"\n"; if( ! defined $server){ print "\nERROR: Can't connect to port $port on host: $!\n" ; exit; } else{ print "\nServer up and running on $port\n" } my $main_loop = Glib::MainLoop->new; #my $con_watcher = Gtk2::Helper->add_watch ( fileno( $server ), # 'in', \&callback, $server ); #my $stdin_watcher = Gtk2::Helper->add_watch ( fileno( 'STDIN' ), # 'in', \&watch_stdin, 'STDIN' ); my $con_watcher = Glib::IO->add_watch ( fileno( $server ), 'in', \&callback, $server ); my $stdin_watcher = Glib::IO->add_watch ( fileno( 'STDIN' ), 'in', \&watch_stdin, 'STDIN' ); $main_loop->run; sub watch_stdin { # this is line oriented, # enter as many lines as you want # and you must press Control-d when # finished to send # print "@_\n"; my ($fd, $condition, $fh) = @_; my (@lines) = (<STDIN>); print @lines; foreach my $cli(@clients){ if($cli->connected){ print $cli 'MESSAGE-> ', @lines; }else{ # remove dead client @clients = grep { $_ ne $cli } @clients; + } } #always return TRUE to continue the callback return 1; } sub callback{ my ( $fd, $condition, $fh ) = @_; print "callback start $fd, $condition, $fh\n"; #this grabs the incoming connections and forks them off my $client; do { $client = $server->accept } until ( defined($client) ); print "accepted a client, id = ", ++$num_of_client, "\n"; # going into forked handler if ( !fork ) { close($server); #this only closes the copy in the child pro +cess # Gtk2::Helper->remove_watch( $con_watcher ); #remove server po +rt watch in child # Gtk2::Helper->remove_watch( $stdin_watcher ); #remove STDIN w +atch in child Glib::Source->remove( $con_watcher ); #remove server port watc +h in child Glib::Source->remove( $stdin_watcher ); #remove STDIN watch in + child # add a new watch in the forked client my $cli_watcher = Glib::IO->add_watch( fileno( $client ), ['in', 'hup','err'], \&cli_callback, $client); sub cli_callback{ print "\ncli_callback @_\n"; my ( $fd, $condition, $client ) = @_; # since 'in','hup', and 'err' are not mutually exclusive, # they can all come in together, so test for hup/err first if ( $condition >= 'hup' or $condition >= 'err' ) { # End Of File, Hang UP, or ERRor. that means # we're finished. #print "\nhup or err received\n"; #close socket $client->close; $client = undef; # normally return 0 here, # except we need to exit the fork, down below # return 0; #stop callback } # if the client still exists, get data and return 1 to keep callback a +live if ($client) { if ( $condition >= 'in' ){ # data available for reading my $bytes = sysread($client,my $data,1024); if ( defined $data ) { # do something useful with the text. print length $data, $data,"\n"; print $client "$data\n"; #echo back } } # the file handle is still open, so return TRUE to # stay installed and be called again. # print "still connected\n"; # possibly have a "connection alive" indicator #print "still alive\n"; return 1; } else { # we're finished with this job. start another one, # if there are any, and uninstall ourselves. print "child exiting\n"; #return 0; #exit instead exit; #since this is forked, we exit } } #end of client callback } #end of forked code else { push @clients, $client; #save clients for root message # back to parent, close client that's been forked #print "\nin parent closed forked client $client\n"; #close($client); # this only closes the copy in the parent proces +s, # assume the parent no longer need talk to the clie +nt } return 1; # keep the main port watching callback alive } __END__

I'm not really a human, but I play one on earth.
Old Perl Programmer Haiku ................... flash japh

Replies are listed 'Best First'.
Re^2: IO::Select and correct way to detect client crashed?
by flexvault (Monsignor) on Oct 18, 2012 at 17:16 UTC


    Thanks, I'll look into it. What I was hoping for was a core Perl solution, but a solution is better than no solution...Ed

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

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://999761]
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (6)
As of 2018-05-24 18:04 GMT
Find Nodes?
    Voting Booth?