|
#!/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->());
|
|
}
|