Question about Perl TCP socket programming

Question

The below code does run a TCP Server which fork a new process when receiving TCP request. Why does it exits, just after the first request accepted?


#!/usr/bin/perl

use Socket;
use POSIX qw(:sys_wait_h);

sub REAPER {
  1 until -1 == waitpid(-1, WNOHANG);
  $SIG{CHLD} = \&REAPER;
}

$SIG{CHLD} = \&REAPER;
socket(SERVER, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
setsockopt(SERVER, SOL_SOCKET, SO_REUSEADDR, 1);
$my_addr = sockaddr_in(8080, INADDR_ANY);
bind SERVER, $my_addr;
listen(SERVER, 1000);
REQUEST:
while (accept(CLIENT, SERVER)) {
  if ($pid = fork) {
    close CLIENT;
    next REQUEST;
  }
  die "$!" unless defined $pid;
  close SERVER;
  print CLIENT "hello\n";
  close CLIENT;
  exit;
}

I don't know the answer but the first thing I'd do is run it under strace to see what the system calls are. — araqnid
– araqnid, Commented Dec 27, 2010 at 2:01

cjm · Accepted Answer · 2010-12-27 02:32:34Z

It exits because accept gets interrupted by a signal (SIGCHLD) and you don't handle that case. Try the more sophisticated version in perlipc: Internet TCP Clients and Servers (scroll down to the multithreaded version).

Also, consider using a module that handles these details for you. Net::Server::Fork is similar to what you seem to be trying to write. There are other modules if you don't like that one.

Anyway, here's some minimal corrections to your version:

#!/usr/bin/perl

use strict;
use warnings;
use Socket;
use POSIX qw(:sys_wait_h);

sub REAPER {
  local $!;                    # Don't let signal handler mess with $!
  1 until -1 == waitpid(-1, WNOHANG);
  $SIG{CHLD} = \&REAPER;
}

$SIG{CHLD} = \&REAPER;
socket(SERVER, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
setsockopt(SERVER, SOL_SOCKET, SO_REUSEADDR, 1);
my $my_addr = sockaddr_in(8080, INADDR_ANY);
bind SERVER, $my_addr;
listen(SERVER, 1000);
REQUEST:
while (1) {
  my $paddr = accept(CLIENT, SERVER) || do {
    # try again if accept() returned because a signal was received
    next REQUEST if $!{EINTR};
    die "accept: $!";
  };

  my $pid;
  if ($pid = fork) {
    close CLIENT;
    next REQUEST;
  }
  die "$!" unless defined $pid;
  close SERVER;
  print CLIENT "hello\n";
  close CLIENT;
  exit;
}

ysth · Accepted Answer · 2010-12-27 03:13:55Z

0

I'm taking your question as asking how the code works, not asking why it doesn't.

The if ($pid = fork) forks, that is, creates a child process to handle the request. In the parent, fork() returns the child's pid, so the parent closes the CLIENT handle and proceeds to wait for the next request to some in. Only in the child, where fork() returns 0, does the code beyond the if block get executed, where the child handles the request and then exits, since the parent will deal with waiting for and handling the next request.

answered Dec 27, 2010 at 3:13

ysth

99.1k6 gold badges126 silver badges219 bronze badges

1 Comment

cjm Over a year ago

If you try running the program as posted, and connect to it with netcat or something, you'll see that the server exits after handling the first connection (see my answer for the reason).

Collectives™ on Stack Overflow

Question about Perl TCP socket programming

2 Answers 2

Comments

1 Comment

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

Comments

1 Comment

Your Answer

Sign up or log in

Post as a guest

Related