Fellow brethren,
I'm struggling with a - at least that's what I thought - simple TCP server/client. I boiled it down to the most simple code, but still the server exits after having communicated with one client.
Below is what I have (more or less reduced to what is in the cookbook...), any hints more than welcome!
update: you can find an even more stripped down version of this in my scratchpad
update 2: perlipc explains this nicely and offers a solution. To make it short: $sock->accept() is also interrupted by the signal and when it returns, there is no socket and then the while loop ends :-(. This could =~ s/c/sh/ be fixed in the docs (is this still wrong in newer editions of the cookbook???)... Solution in my post below to keep the node history intact
Server code:
#!/usr/bin/perl -w
use strict;
use IO::Socket;
use Sys::Hostname;
use POSIX qw(:sys_wait_h);
sub REAP {
1 until (-1 == waitpid(-1, WNOHANG));
$SIG{CHLD} = \&REAP;
}
$SIG{CHLD} = \&REAP;
my $sock = new IO::Socket::INET(
LocalHost => '127.0.0.1',
LocalPort => 9898,
Proto => 'tcp',
Listen => 10,
Reuse => 1);
$sock or die "no socket :$!";
STDOUT->autoflush(1);
STDERR->autoflush(1);
my($new_sock, $buf, $kid);
print STDERR "Parent $$: Server up\n";
while ($new_sock = $sock->accept()) {
next if $kid = fork;
die "fork: $!" unless defined $kid;
# child now...
print STDERR "Child $$\n";
# close the passive socket - not needed
$sock->shutdown(2);
# read from client
$buf = <$new_sock>;
$new_sock->shutdown(0);
chomp $buf;
print "Child $$: Read from client: $buf\n";
print $new_sock "READY\n";
print "Child $$: Sent READY, closing\n";
$new_sock->shutdown(2);
exit;
} continue {
# parent closes the client since
# it is not needed
print STDERR "Parent $$: Closing child socket\n";
close $new_sock;
}
print STDERR "Parent $$: Should never get here\n";
Client code:
#!/usr/bin/perl
use strict;
use warnings;
use IO::Socket;
my $me = 'some_client';
my $socket = IO::Socket::INET->new( PeerAddr => '127.0.0.1',
PeerPort => '9898',
Proto => 'tcp',
Type => SOCK_STREAM )
or die "Couldn't connect to 127.0.0.1:9898: $@\n";
$socket->autoflush(1);
print $socket "$me $$\n";
# no more writing from here
$socket->shutdown(1);
my $line = <$socket>;
chomp $line;
print STDOUT "$line\n";
$socket->close;
exit 1 unless $line eq 'SUCCESS';
exit 0;
Output is
Parent 11124: Server up
Parent 11124: Closing child socket
Child 11131
Parent 11124: Should never get here
Child 11131: Read from client: some_client 11130
Child 11131: Sent READY, closing
The client gets the READY fine from the server.
This can't be too hard to resolve, but I'm lost here. I have tried so much, I seem to be missing the obvious.
Thanks,
svenXY