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

sub spawn;  # forward declaration
sub logmsg { print STDERR "$0 $$: @_ at ", scalar localtime(), "\n" }

my $port  = 3128;
die "invalid port" unless $port =~ /^ \d+ $/x;

my $proto = getprotobyname("tcp");

socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) || die "setsockopt: $!";
bind(Server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!";
listen(Server, SOMAXCONN) || die "listen: $!";

logmsg "server started on port $port";

my $paddr;

use POSIX ":sys_wait_h";
use Errno;

sub REAPER {
	local $!;
	while ((my $pid = waitpid(-1, WNOHANG)) > 0 && WIFEXITED($?)) {
		logmsg "reaped $pid" . ($? ? " with exit $?" : "");
	}
	$SIG{CHLD} = \&REAPER;
}

$SIG{CHLD} = \&REAPER;

for (;;) {
	$paddr = accept(Client, Server) || do {
		next if $!{EINTR};
		die "accept: $!";
	};
	my ($port, $iaddr) = sockaddr_in($paddr);
	my $name = gethostbyaddr($iaddr, AF_INET);

	logmsg "connection from $name [", inet_ntoa($iaddr), "] at port $port";

	spawn sub { $| = 1; while (<>) { print; print STDERR $_; } };
	close Client;
}

sub spawn {
	my $coderef = shift;
	confess "usage: spawn CODEREF" unless @_ == 0 && $coderef && ref($coderef) eq "CODE";

	my $pid;
	unless (defined($pid = fork())) {
		logmsg "cannot fork: $!";
		return;
	}
	if ($pid) {
		logmsg "begat $pid";
		return;
	}

	open(STDIN,  "<&Client") || die "can't dup client to stdin";
	open(STDOUT, ">&Client") || die "can't dup client to stdout";
	exit($coderef->());
}