the problem with the REAPER (see TCP Client-Server: Server exits though it shouldn't)
as stated out in the OP, the REAPER throws the parent-process out of the while loop (or accept() is not true). This is a rewrite with onlys the required lines to show this problem. I get the feeling that this is a bug.
Server Code:
#!/usr/bin/perl -w
use strict;
use IO::Socket;
use Sys::Hostname;
use POSIX qw(:sys_wait_h);
# choose either. ignore will work, REAPER won't
$SIG{CHLD} = 'IGNORE'; # still loathe sysV
$SIG{CHLD} = \&REAPER; # still loathe sysV
my $sock = new IO::Socket::INET(
LocalHost => '127.0.0.1',
LocalPort => 9898,
Proto => 'tcp',
Listen => 10,
ReuseAddr => 1
);
$sock or die "no socket :$!";
print STDERR "Parent $$: Server up\n";
while ( my $new_sock = $sock->accept() ) {
$new_sock->autoflush(1);
my($buf, $kid);
if ($kid = fork) {
print STDERR "Parent $$ after fork\n";
}
else {
die "fork: $!" unless defined $kid;
# child now...
print STDERR "Child $$: started\n";
# read from client
$buf = <$new_sock>;
chomp $buf;
print "Child $$: Read from client: $buf\n";
# do something (sleep some random secs)
my $secs = int(rand(srand())*10)+1;
sleep $secs;
print $new_sock "READY\n";
print "Child $$: Sent READY, closing\n";
exit 0;
}
}
print STDERR "Parent $$: Should never get here\n";
########################################################
sub REAPER {
########################################################
my $child;
while (($child = waitpid(-1,WNOHANG)) > 0) {
print "Parent $$: Reaped $child\n";
}
$SIG{CHLD} = \&REAPER; # still loathe sysV
}
Client code
#!/usr/bin/env perl
use strict;
use warnings;
use IO::Socket;
my $remote = IO::Socket::INET->new( Proto => "tcp",
PeerAddr => '127.0.0.1',
PeerPort => "9898",
);
unless ($remote) { die "cannot connect" }
$remote->autoflush(1);
print $remote "client $$\n";
while ( <$remote> ) { print;last; }
close $remote;
print "Socket gone, exiting\n";
output (on the server side) is then:
Parent 28877: Server up
Parent 28877 after forking
Child 28949: started
Child 28949: Read from client: client 28948
Child 28949: Sent READY, closing
Parent 28877: Reaped 28949
Parent 28877: Should never get here
and the server is gone.
Any hints/ideas/whatever greatly appreciated!
Sorting an HTML table by the first column has been removed. /msg me if you are interested, but the suggested solutions (see HTML::TreeBuilder: sort a Definition List (<dl>)) are much better than my initial code.
Nodes with good snippets
Perl Special Variables Quick Reference
Re: Perl script to comment out lines in named.con file - going through lines with curly braces and know when the last one shows up
Re: Date and time for log files
Clear output line of arbitrary length in windows
use Win32::Console::ANSI;
$|=1;
print "\e[s"; # store 1st pos otherwise it will clear the whole screen
for ( 'a'x300, 'b'x200, 'c'x100) {
print "\e[u\e[0J"; # go to stored pos, del to end
print "\e[s$_"; # store pos, print output
sleep 3;
}
oneliner to count pregnancy weeks (or weeks since birth) perl -MDateTime -e '$i=DateTime->new(year => 2007,month => 11,day => 1);print "Woche $_ ab ",$i->add(weeks => 1)->strftime(q{%d.%m.%y}), $/ for 1..40'
# module versions
for i in `cat perlmodules`; do echo -n "$i ";perl -le 'eval "require $ARGV[0]" and print $ARGV[0]->VERSION' $i; done
brian's Guide to Solving Any Perl Problem
|