2011-10-12 13:16:34,972 DEBUG kcmdproxy(22168):509 Accepted connection 1 from 192.168.1.23:52674
2011-10-12 13:16:35,002 DEBUG kcmdproxy.io(22168):388 bufrdline: <<special,endofworld<lf>>>
2011-10-12 13:16:35,028 INFO  kcmdproxy(22168):538 Routed "special,endofworld" to localhost.localdomain(127.0.0.1):2000
2011-10-12 13:16:35,034 DEBUG kcmdproxy.child(22171):564 In child
2011-10-12 13:16:35,051 DEBUG kcmdproxy.io(22171):435 Output: <<PROXY,192.168.1.23<lf>>>
2011-10-12 13:16:35,036 INFO  kcmdproxy(22168):652 Forked child 22171
2011-10-12 13:16:35,052 DEBUG kcmdproxy.io(22171):435 Output: <<special,endofworld<lf>>>
2011-10-12 13:16:35,130 DEBUG kcmdproxy.child(22171):578 Copying request data from client to server
2011-10-12 13:16:35,170 DEBUG kcmdproxy.io(22171):404 sockcopy start keep 0
2011-10-12 13:16:35,214 DEBUG kcmdproxy.io(22171):338 bufrd
2011-10-12 13:16:35,254 DEBUG kcmdproxy.io(22171):344 bufrd a
2011-10-12 13:16:52,531 INFO  kcmdproxy(22168):496 Accept returned EINTR
2011-10-12 13:16:52,563 DEBUG kcmdproxy.io(22171):349 bufrd res <<8>>: <<END,END<lf>>> err 
2011-10-12 13:16:52,564 DEBUG kcmdproxy.io(22171):435 Output: <<END,END<lf>>>

##</code><code>##

#! /usr/bin/perl

use strict;
use warnings;
use IO::Socket;
use POSIX qw ( :sys_wait_h :fcntl_h );
use Errno qw ( EINTR EAGAIN );

my $testport = 8080;


# This is what runs in the child process
sub kidstuff {
    my $sock = shift;
    # Read and log whatever comes in
  BUFRD:
    while (1) {
	$! = 0;
	my $data;
	my $res = $sock->read($data, 99);
	# res: #chars, or 0 for EOF, or undef for error
	die "read failed on $!" unless defined($res);
	last BUFRD if $res == 0; # EOF
	print "Read($res): $data\n";
    }
}

$|=1;				# autoflush
my $listener = IO::Socket::INET->new (
				      LocalPort => $testport,
				      type => SOCK_STREAM,
				      Proto => 'tcp',
				      Reuse => 1,
				      Listen => 5,
				      );
if (!defined($listener)) {
    die "Failed to listen on port $testport: $!";
}

CLIENT: while (1) {
    my $client = $listener->accept();
    if (!defined($client)) {
	# Some kind of error
	if ($! == EINTR) {
	    print "Accept returned EINTR\n";
	    next CLIENT;
	}
	# If it's an undef other than EINTR, maybe not really a client,
	die "Accept error: $!";
    }

    # Read first line from client
    my $l1 = $client->getline();
    die "client read error $!" unless defined($l1);
    print "Server, first client line is $l1\n";

    # Now fork server
    my $kid = fork();
    die "Fork failed" unless defined($kid);
    if ($kid == 0) {
	print "Child $$ running\n";
	kidstuff($client);
	print "Child $$ complete, exiting\n";
	exit 0;
    }
    # Parent continues here.
    while ((my $k = waitpid(-1, WNOHANG)) > 0) {
	# $k is kid pid, or -1 if no such, or 0 if some running none dead
	my $stat = $?;
	print "Reaped $k stat $stat\n";
    }
}				# CLIENT: while (1)