#!/usr/bin/perl -Tw
require 5.002;
use strict;
use Socket;
use Carp;

use vars qw(*CLIENT);

use IPC::Open2;

BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }

sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }

my $counter = 0;

sub spawn {
    my ($coderef) = @_;

    unless ($coderef && ref($coderef) eq 'CODE') {
        confess "usage: spawn CODEREF";
    }

    ++$counter;

    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") or die "couldn't dup stdin: $!\n";
    open(STDOUT, ">&CLIENT") or die "couldn't dup stdout: $!\n";

    $| = 1;
    print "*** response number: $counter ***\n";

    exit &$coderef();
}

my $NAME = '/tmp/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";

sub reaper { 
  my $waitedpid = wait;
  $SIG{CHLD} = \&reaper;  # loathe sysV
  logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
}

$SIG{CHLD} = \&reaper;

delete $ENV{ENV};

while (accept(CLIENT, SERVER)) {
    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: $!";
    };
}