From: Andy Wardley Date: Fri, 14 Jul 2006 10:11:44 +0000 (-0700) Subject: [perl #39835] Patch for perlipc.pod to update TCP server example wrt safe signals... X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c5ae63656a09c14dda09ad4ebf15c6b83c200467;p=p5sagit%2Fp5-mst-13.2.git [perl #39835] Patch for perlipc.pod to update TCP server example wrt safe signals and accept() From: Andy Wardley (via RT) Message-ID: p4raw-id: //depot/perl@28622 --- diff --git a/pod/perlipc.pod b/pod/perlipc.pod index 3de879f..4061dd1 100644 --- a/pod/perlipc.pod +++ b/pod/perlipc.pod @@ -915,67 +915,91 @@ go back to service a new client. my $paddr; use POSIX ":sys_wait_h"; + use Errno; + sub REAPER { - my $child; - while (($waitedpid = waitpid(-1,WNOHANG)) > 0) { - logmsg "reaped $waitedpid" . ($? ? " with exit $?" : ''); - } - $SIG{CHLD} = \&REAPER; # loathe sysV + local $!; # don't let waitpid() overwrite current error + while ((my $pid = waitpid(-1,WNOHANG)) > 0 && WIFEXITED($?)) { + logmsg "reaped $waitedpid" . ($? ? " with exit $?" : ''); + } + $SIG{CHLD} = \&REAPER; # loathe sysV } $SIG{CHLD} = \&REAPER; - for ( $waitedpid = 0; - ($paddr = accept(Client,Server)) || $waitedpid; - $waitedpid = 0, close Client) - { - next if $waitedpid and not $paddr; - my($port,$iaddr) = sockaddr_in($paddr); - my $name = gethostbyaddr($iaddr,AF_INET); - - logmsg "connection from $name [", - inet_ntoa($iaddr), "] - at port $port"; - - spawn sub { - $|=1; - print "Hello there, $name, it's now ", scalar localtime, $EOL; - exec '/usr/games/fortune' # XXX: `wrong' line terminators - or confess "can't exec fortune: $!"; - }; - + while(1) { + $paddr = accept(Client, Server) || do { + # try again if accept() returned because a signal was received + next if $!{EINTR}; + die "accept: $!"; + }; + my ($port, $iaddr) = sockaddr_in($paddr); + my $name = gethostbyaddr($iaddr, AF_INET); + + logmsg "connection from $name [", + inet_ntoa($iaddr), + "] at port $port"; + + spawn sub { + $|=1; + print "Hello there, $name, it's now ", scalar localtime, $EOL; + exec '/usr/games/fortune' # XXX: `wrong' line terminators + or confess "can't exec fortune: $!"; + }; + close Client; } sub spawn { - my $coderef = shift; + my $coderef = shift; - unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') { - confess "usage: spawn CODEREF"; - } + 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 + 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(); + 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(); } -This server takes the trouble to clone off a child version via fork() for -each incoming request. That way it can handle many requests at once, -which you might not always want. Even if you don't fork(), the listen() -will allow that many pending connections. Forking servers have to be -particularly careful about cleaning up their dead children (called -"zombies" in Unix parlance), because otherwise you'll quickly fill up your -process table. +This server takes the trouble to clone off a child version via fork() +for each incoming request. That way it can handle many requests at +once, which you might not always want. Even if you don't fork(), the +listen() will allow that many pending connections. Forking servers +have to be particularly careful about cleaning up their dead children +(called "zombies" in Unix parlance), because otherwise you'll quickly +fill up your process table. The REAPER subroutine is used here to +call waitpid() for any child processes that have finished, thereby +ensuring that they terminate cleanly and don't join the ranks of the +living dead. + +Within the while loop we call accept() and check to see if it returns +a false value. This would normally indicate a system error that needs +to be reported. However the introduction of safe signals (see +L above) in Perl 5.7.3 means that +accept() may also be interrupted when the process receives a signal. +This typically happens when one of the forked sub-processes exits and +notifies the parent process with a CHLD signal. + +If accept() is interrupted by a signal then $! will be set to EINTR. +If this happens then we can safely continue to the next iteration of +the loop and another call to accept(). It is important that your +signal handling code doesn't modify the value of $! or this test will +most likely fail. In the REAPER subroutine we create a local version +of $! before calling waitpid(). When waitpid() sets $! to ECHILD (as +it inevitably does when it has no more children waiting), it will +update the local copy leaving the original unchanged. We suggest that you use the B<-T> flag to use taint checking (see L) even if we aren't running setuid or setgid. This is always a good idea