Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

TCP Client-Server: Server exits though it shouldn't

by svenXY (Deacon)
on Jan 26, 2009 at 09:55 UTC ( #738892=perlquestion: print w/replies, xml ) Need Help??

svenXY has asked for the wisdom of the Perl Monks concerning the following question:

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

Replies are listed 'Best First'.
Re: TCP Client-Server: Server exits though it shouldn't
by svenXY (Deacon) on Jan 26, 2009 at 13:59 UTC

    some further findings:

  • I was able to boil this down to the REAPER, using $SIG{CHLD} = 'IGNORE'; works like a charm but is not what I want
  • reaping (a.k.a. calling waitpid()) in the parent-part of the while loop also works, but will not clean up often enough
  • I also debugged this with -d now and it seems that the REAPER-sub throws the server out of the while loop
  • NOW: this is all pretty much what is in the docs, camelbook etc., but does not seem to work... --- no ideas out there???
    Regards,
    svenXY
SOLVED: Re: TCP Client-Server: Server exits though it shouldn't
by svenXY (Deacon) on Jan 26, 2009 at 16:10 UTC

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://738892]
Approved by marto
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (6)
As of 2021-11-28 21:04 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?