#!/usr/bin/perl use warnings; use strict; use Glib; use Gtk2::Helper; # can use plain Glib instead, see below 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; # Gtk2::Helper shown for comparison, use either Helper or IO 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' ); # if you just want to use pure Glib, use these instead, and alter the # removers below # 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 por +t watch in child Gtk2::Helper->remove_watch( $stdin_watcher ); #remove STDIN wa +tch in child # removers for IO, if used above # Glib::Source->remove( $con_watcher ); #remove server port watch +in child # Glib::Source->remove( $stdin_watcher ); #remove STDIN watch in c +hild # 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 { #back in parent, save clients for messaging or close them 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__
In reply to Glib based forking server with root messaging by zentara
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |