x.pl

tpchin, 09/20/2011 12:01 PM

Download (1.59 KB)

 
1
#!/usr/bin/env perl -Tw
2
use strict;
3
use Socket;
4
use Carp;
5

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

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

    
12
my $proto = getprotobyname("tcp");
13

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

    
19
logmsg "server started on port $port";
20

    
21
my $paddr;
22

    
23
use POSIX ":sys_wait_h";
24
use Errno;
25

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

    
34
$SIG{CHLD} = \&REAPER;
35

    
36
for (;;) {
37
	$paddr = accept(Client, Server) || do {
38
		next if $!{EINTR};
39
		die "accept: $!";
40
	};
41
	my ($port, $iaddr) = sockaddr_in($paddr);
42
	my $name = gethostbyaddr($iaddr, AF_INET);
43

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

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

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

    
54
	my $pid;
55
	unless (defined($pid = fork())) {
56
		logmsg "cannot fork: $!";
57
		return;
58
	}
59
	if ($pid) {
60
		logmsg "begat $pid";
61
		return;
62
	}
63

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