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

Hi,

A friend asked me about this problem, and I am stuck, so I'm asking for your help. The following code is taken almost directly from chapter 12 of Advanced Perl Programming (under "Handling Multiple Clients -Multiple Threads of Execution").

# Forking server
use IO::Socket;
use POSIX;

sub REAPER {
  my $stiff;
  while( $stiff=waitpid(-1,WNOHANG)>0) { }
  $SIG{CHLD}=\&REAPER;
}
$SIG{CHLD} = \&REAPER;

$main_sock = new IO::Socket::INET (LocalHost => 'localhost',
                                   LocalPort => 7070,
                                   Listen    => 5,
                                   Proto     => 'tcp',
                                   Reuse     => 1,
                                );
die "Error: $!\n" unless ($main_sock);
while ($new_sock = $main_sock->accept()) {
    $pid = fork();
    die "Cannot fork: $!" unless defined($pid);
    if ($pid == 0) {
        # Child process
        while (defined($buf = <$new_sock>)) {
           # do something with $buf ....
           print $new_sock "You said: $buf\n";
        }
        exit(0);   # Child process exits when it is done.
    } else {
    # Close new socket in the parent
        $new_sock->close;
    }
}
close ($main_sock);

[download]
When I test it by telnetting to port 7070, it works correctly, printing back what I type. But when I close the connection, the server program exits. Some examination seems to indicate that the accept() call is not being restarted after the signal handler returns. If I set the signal handler to 'IGNORE', everything works ok, which is good for our purposes, but now I am curious as to why this does not work.

I also tried explicitly setting the SA_RESTART flag on the SIGCHLD signal, so that it restarts interrupted slow system calls. So I replaced the assignment to $SIG{CHLD} with the following: 

$sigset=POSIX::SigSet->new(SIGCHLD);
$sigaction=POSIX::SigAction->new('main::REAPER', $sigset, &POSIX::SA_R
+ESTART);
$osigact=POSIX::SigAction->new;
sigaction(SIGCHLD, $sigaction, $osigact);

[download]
But I get the exact same behavior. I am on Solaris 2.7, with perl 5.005. Any ideas?

Thanks,

--ZZamboni

Replies are listed 'Best First'.
Re: SIGCHLD interrupting accept call?
by dempa (Friar) on May 09, 2000 at 12:39 UTC
    In Solaris 7, accept() is not restarted automatically. I found that out the hard way in a project I'm working on. This seems to work for me:
    ## Infinite loop
while(1) {
  for($waitepid = 0; ($clientaddr = accept(SOCK_CLNT,SOCK_SRV) || $wai
+tepid); $waitepid = 0, close(SOCK_CLNT)) {
    next if $waitepid and not $clientaddr;
    ## do things...
  }
}

    [download]
    HTH! /dempa

    PS. BTW, this is my first post here. :)
[reply]
[d/l]
      Thanks! This works perfectly. That for statement goes to my Perl bag-o-tricks :-)

      The only thing that took me a couple of minutes was how to assign the value of $waitepid. Because here's what I had in my signal handler: 

      sub REAPER {
  my $stiff;
  while ($stiff=waitpid(-1,WNOHANG)>0) { }
}

      [download]
      Simply replacing $stiff with $waitepid and making it global would not have worked, since the loop is waiting until it is zero or less than zero. So here's what I did: 
      sub REAPER {
  my $stiff;
  while ($stiff=waitpid(-1,WNOHANG)>0) { $waitepid+=$stiff; }
}

      [download]
      Which gives the appropriate effect. However, I'm wondering now if there is a better way of doing it. Any ideas?

      Thanks a lot!

      --ZZamboni

[reply]
[d/l]
[select]
Re: SIGCHLD interrupting accept call?
by lhoward (Vicar) on May 09, 2000 at 03:44 UTC
    I just tested your code on Linux 2.0.36 / Perl 5.005_02 and it worked just fine (the server program does not exit).

    Here are a few ideas in no particular order:

    You may want to try using lsof to see what the process is doing (lsof is an awesome utility that lets you look at what files, network ports, etc...a process has open. Also works the other way around.. what processes have a partifular file, network port, etc... open).

    How does it behave if you connect 2 clients to it? Does the server program exit when the first client disconnects or only after both disconnect? If you disconnect one of them can you connect a third one at that point?

    Are you running the most current version of IO::Socket

    Try setting your SIGCHLD handler to: 

        $SIG{CHLD}='IGNORE';

    [download]
[reply]
[d/l]
      I just tested your code on Linux 2.0.36 / Perl 5.005_02 and it worked just fine (the server program does not exit).
      Hm... interesting.
      You may want to try using lsof
      Will do.
      How does it behave if you connect 2 clients to it?
      It exits after the first one disconnect. Even when I run it under the debugger, after returning from the signal handler the accept call exits. Since it did not return with a new socket, the loop terminates. What I think it should be doing is restarting the accept call automatically, as supposedly most modern Unices do.
      Are you running the most current version of IO::Socket
      Yes. Version 1.25.
      Try setting your SIGCHLD handler to: $SIG{CHLD}='IGNORE'
      I did already (I mentioned it in my original post). With that, the program behaves perfectly. That's what gave me the definite indication that it was the return from the signal handler that was messing things up.

      Thanks for your time, and for the lsof pointer. Any other ideas will be very appreciated!

      --ZZamboni

[reply]
Re: SIGCHLD interrupting accept call?
by perlmonkey (Hermit) on May 09, 2000 at 12:07 UTC
    You aren't going to like this, but I just tested and it worked like a champ. The machines I used are Redhat 6.2 Linux 2.2.14-5.0 w/ perl 5.005_03 and the other is SGI Irix 6.5.5 w/ perl 5.005_02

    So it seems to be a specific Solaris thing. And if the $SIG{'CHLD'} = 'IGNORE' works fine, than it seems to me that your problem would be in REAPER, and not the accept call, but I could be wrong. Maybe Solaris has issues with waitpid?

    Another thought is that maybe for some reason the server is getting a SIGPIPE when your client disconnects. This is a total guess though, but you may want to explicitly ingore the SIGPIPE (ie $SIG{'PIPE'} = 'IGNORE';) and see if that works.
[reply]
Re: SIGCHLD interrupting accept call?
by chromatic (Archbishop) on May 09, 2000 at 20:10 UTC
    accept() is implemented using the accept(2) system call. I'd expect it to act slightly differently on the various flavors of Unix. Check your specific man page for the nitty gritty.
[reply]

Back to Seekers of Perl Wisdom