http://www.perlmonks.org?node_id=855342
wokka has asked for the wisdom of the Perl Monks concerning the following question:

I was trying out the Unix-Domain sockets example in the perlipc documentation, and I'm running into some behavior I don't quite understand.

When I run the server and fire off one client request at a time, it behaves just fine, but if I do something like:
~/tmp$ ./sockclient & ./sockclient & ./sockclient
In an attempt to fire off multiple requests at once from a bash prompt (where '~/tmp$' is the prompt), the server will die with no errors. Once or twice it segfaulted, but most of the time one or two repetitions of the above line will cause the server to simply die.

This behavior is consistent and reproducible on my Ubuntu desktop, a Slackware VM, and a FreeBSD server (all running bash).

Given the following server code (taken directly from the documentation):

#!/usr/bin/perl -Tw use warnings; use strict; use Socket; use Carp; BEGIN { $ENV{PATH} = '/usr/ucb:/bin' } sub spawn; # forward declaration sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" } my $NAME = 'catsock'; my $uaddr = sockaddr_un($NAME); my $proto = getprotobyname('tcp'); socket(Server,PF_UNIX,SOCK_STREAM,0) || die "socket: $!"; unlink($NAME); bind (Server, $uaddr) || die "bind: $!"; listen(Server,SOMAXCONN) || die "listen: $!"; logmsg "server started on $NAME"; my $waitedpid; use POSIX ":sys_wait_h"; sub REAPER { my $child; while (($waitedpid = waitpid(-1,WNOHANG)) > 0) { logmsg "reaped $waitedpid" . ($? ? " with exit $?" : ''); } $SIG{CHLD} = \&REAPER; # loathe SysV } $SIG{CHLD} = \&REAPER; for ( $waitedpid = 0; accept(Client,Server) || $waitedpid; $waitedpid = 0, close Client) { next if $waitedpid; logmsg "connection on $NAME"; spawn sub { print "Hello there, it's now ", scalar localtime, "\n"; exec '/usr/games/fortune' or die "can't exec fortune: $!"; }; } sub spawn { my $coderef = shift; unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') { confess "usage: spawn CODEREF"; } my $pid; if (!defined($pid = fork)) { logmsg "cannot fork: $!"; return; } elsif ($pid) { logmsg "begat $pid"; return; # I'm the parent } # else I'm the child -- go spawn open(STDIN, "<&Client") || die "can't dup client to stdin"; open(STDOUT, ">&Client") || die "can't dup client to stdout"; ## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr"; exit &$coderef(); }

And the following client code (also taken directly from the documentation):
#!/usr/bin/perl use 5.10.0; use strict; use warnings; use Socket; my ($rendezvous, $line); $rendezvous = shift || 'catsock'; socket(SOCK, PF_UNIX, SOCK_STREAM, 0) || die "socket: $!"; connect(SOCK, sockaddr_un($rendezvous)) || die "connect: $!"; while (defined($line = <SOCK>)) { print $line; } exit;
The client terminal looks like this:
~/tmp$ ./sockclient & ./sockclient &./sockclient
1 27089
2 27090
Hello there, it's now Mon Aug 16 15:09:34 2010
Hello there, it's now Mon Aug 16 15:09:34 2010
Hello there, it's now Mon Aug 16 15:09:34 2010
You will be married within a year, and divorced within two.
~/tmp$ You will remember something that you should not have forgotten.
Just to have it is enough.
And the server terminal looks like this:
~/tmp$ ./sockserv
./sockserv 22710: server started on catsock at Mon Aug 16 15:02:33 2010
./sockserv 22710: connection on catsock at Mon Aug 16 15:09:34 2010
./sockserv 22710: begat 27092 at Mon Aug 16 15:09:34 2010
./sockserv 22710: connection on catsock at Mon Aug 16 15:09:34 2010
./sockserv 22710: begat 27093 at Mon Aug 16 15:09:34 2010
./sockserv 22710: connection on catsock at Mon Aug 16 15:09:34 2010
./sockserv 22710: begat 27094 at Mon Aug 16 15:09:34 2010
./sockserv 22710: reaped 27092 at Mon Aug 16 15:09:34 2010
./sockserv 22710: reaped 27094 at Mon Aug 16 15:09:34 2010
~/tmp$
Any ideas what's going on here? The only hint I have is that the third reaping isn't happening. Since it's consistent across the environments I have, it's got to be something with the code or the way I'm calling the client, but I don't know the specifics and would appreciate any edification you can offer.