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

[zentara]

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__

[flexvault]

zentara,

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