Hi, Here is just some general advice. I would suggest you add some code which detects errors as they occur, and prints out some sort of message so you can locate where your script is actually failing. See
Simple threaded chat server and if you want, see
Gtk2 server and client GUI's with root messaging for an example of a Gtk2/Glib event-loop socket script which can detect different error conditions. You can check for different socket conditions, like 'in', 'nohup', 'error' and if there is any data.
The key test is if there is an 'in' condition, but no data to be read, you have to assume the connection has failed somewhere, and this close the socket and remove it from your select array.
In your code, try sprinkling warnings after socket operations, or print a debug message at critical points to see where your code fails when it crashes.
Just as a longshot, that sometimes works, try putting $SIG{CHLD} = 'IGNORE' in your script.
If you are going to stick with a select() while loop, it sometimes is useful to test for $socket->can_write at an appropriate place to give an indication that the socket is still alive.
#!/usr/bin/perl
use warnings;
use strict;
use IO::Socket;
use IO::Select;
my @sockets;
my $machine_addr = 'localhost';
my $main_sock = new IO::Socket::INET(LocalAddr=>$machine_addr,
LocalPort=>1200,
Proto=>'tcp',
Listen=>3,
Reuse=>1,
);
die "Could not connect: $!" unless $main_sock;
print "Starting Server\n";
my $readable_handles = new IO::Select();
$readable_handles->add($main_sock);
while (1)
{
# my ($new_readable) = IO::Select->select($readable_handles, undef, u
+ndef, 0 ); # causes 100% cpu usage
my ($new_readable) = IO::Select->select($readable_handles, undef, un
+def, undef );
foreach my $sock (@$new_readable)
{
if ($sock == $main_sock)
{
my $new_sock = $sock->accept();
$readable_handles->add($new_sock);
}
else
{
my $count = sysread $sock, my $buf, 1024;
print "$count\n";
if ($buf)
{
print "$buf\n";
my @sockets = $readable_handles->can_write(1);
print "@sockets\n";
#print $sock "You sent $buf\n";
foreach my $sck(@sockets){print $sck "$buf\n";}
}
else
{
$readable_handles->remove($sock);
close($sock);
}
}
}
}
print "Terminating Server\n";
close $main_sock;
getc();
Here is a basic forking client that works really well for testing connections, the fork separates the send from the receive.
#!/usr/bin/perl -w
use strict;
use IO::Socket;
my ( $host, $port, $kidpid, $handle, $line );
#unless ( @ARGV == 2 ) { die "usage: $0 host port" }
( $host, $port ) = @ARGV || ('localhost',8989);
# create a tcp connection to the specified host and port
$handle = IO::Socket::INET->new(
Proto => "tcp",
PeerAddr => $host,
PeerPort => $port
)
or die "can't connect to port $port on $host: $!";
$handle->autoflush(1); # so output gets there right away
print STDERR "[Connected to $host:$port]\n";
# split the program into two processes, identical twins
die "can't fork: $!" unless defined( $kidpid = fork() );
# the if{} block runs only in the parent process
if ($kidpid) {
# copy the socket to standard output
while ( defined( $line = <$handle> ) ) {
print STDOUT $line;
}
kill( "TERM", $kidpid ); # send SIGTERM to child
}
# the else{} block runs only in the child process
else {
# copy standard input to the socket
while ( defined( $line = <STDIN> ) ) {
print $handle $line;
}
}
It can get confusing, I hope the above helps you out.