Perl is Unix

Ryan Tomayko asks, so I deliver. Much like Jacob Kaplan-Moss did, I copied the comments as closely as they made sense, with adaptations. I skipped the child SIGINT handler from Ryan’s code since its behaviour is default in Perl. I took some further licence in using a tiny module that I maintain, which doesn’t ship with Perl: Proc::Fork, a forking DSL that I find makes intent much clearer than the standard C-ish fork(2) idiom (which Perl provides verbatim).

#!/usr/bin/perl
use 5.010;
use strict;

# simple preforking echo server in Perl
use Proc::Fork;
use IO::Socket::INET;

sub strip { s/\A\s+//, s/\s+\z// for my @r = @_; @r }

# Create a socket, bind it to localhost:4242, and start listening.
# Runs once in the parent; all forked children inherit the socket's
# file descriptor.
my $acceptor = IO::Socket::INET->new(
  LocalPort => 4242,
  Reuse     => 1,
  Listen    => 10,
) or die "Couln't start server: $!\n";

# Close the socket when we exit the parent or any child process. This
# only closes the file descriptor in the calling process, it does not
# take the socket out of the listening state (until the last fd is
# closed).
END { $acceptor->close }

# Fork you some child processes. The code after the run_fork block runs
# in all process, but because the child block ends in an exit call, only
# the parent executes the rest of the program. If a parent block were
# specified here, it would be invoked in the parent only, and passed the
# PID of the child process.
for ( 1 .. 3 ) {
  run_fork { child {
    while (1) {
      my $socket = $acceptor->accept;
      $socket->printflush( "child $$ echo> " );
      my $message = $socket->getline;
      $socket->print( $message );
      $socket->close;
      say "child $$ echo'd: '${\strip $message}'";
    }
    exit;
  } }
}

# Trap (Ctrl-C) interrupts, write a note, and exit immediately
# in parent. This trap is not inherited by the forks because it
# runs after forking has commenced.
$SIG{ 'INT' } = sub { print "bailing\n"; exit };

# Sit back and wait for all child processes to exit.
1 while 0 < waitpid -1, 0;