1 |
root |
1.17 |
#! perl # mandatory |
2 |
root |
1.1 |
|
3 |
|
|
# this listens for new tcp connections and hands them over to the server core |
4 |
root |
1.19 |
# whether this being an extension introduces or reduces stability problems |
5 |
root |
1.1 |
# is unknown as of today. |
6 |
|
|
|
7 |
|
|
use Socket; |
8 |
root |
1.12 |
use AnyEvent::Socket; |
9 |
root |
1.1 |
|
10 |
root |
1.20 |
CONF BIND_ADDRESSES = [[undef, 13327]]; |
11 |
|
|
|
12 |
root |
1.25 |
our $MAX_DETECT; # how many bytes to read to identify the protocol |
13 |
root |
1.21 |
|
14 |
root |
1.15 |
our @LISTENERS; |
15 |
root |
1.25 |
our @DETECTORS; |
16 |
|
|
our %DETECTORS; |
17 |
root |
1.12 |
|
18 |
root |
1.25 |
sub _update_detectors { |
19 |
|
|
$MAX_DETECT = List::Util::max map $_->[1], values %DETECTORS; |
20 |
root |
1.23 |
} |
21 |
|
|
|
22 |
root |
1.25 |
sub register($$$$) { |
23 |
|
|
my ($name, $max_detect, $detect, $serve) = @_; |
24 |
|
|
|
25 |
root |
1.27 |
$DETECTORS{$name} = [$max_detect, $detect, $serve, $name]; |
26 |
root |
1.25 |
_update_detectors; |
27 |
|
|
|
28 |
|
|
Guard::guard { |
29 |
|
|
delete $DETECTORS{$name}; |
30 |
|
|
_update_detectors; |
31 |
|
|
} |
32 |
|
|
} |
33 |
|
|
|
34 |
|
|
our $deliantra_detector = ext::tcp::register deliantra => 10, sub { |
35 |
|
|
/^..version /s |
36 |
|
|
}, sub { |
37 |
|
|
my $ns = cf::client::create fileno $_[1], $_[0]; |
38 |
root |
1.26 |
$ns->run; |
39 |
root |
1.25 |
$ns->inbuf_append ($_[2]); |
40 |
|
|
}; |
41 |
|
|
|
42 |
root |
1.20 |
for (@$BIND_ADDRESSES) { |
43 |
root |
1.12 |
my ($host, $port) = @$_; |
44 |
root |
1.16 |
cf::info "listening on ", (format_hostport $host, $port), "\n"; |
45 |
root |
1.12 |
|
46 |
root |
1.15 |
push @LISTENERS, tcp_server $host, $port, sub { |
47 |
root |
1.12 |
my ($fh, $host, $port) = @_ |
48 |
|
|
or return; |
49 |
|
|
|
50 |
root |
1.18 |
my $lhost = AnyEvent::Socket::format_address |
51 |
|
|
+(AnyEvent::Socket::unpack_sockaddr getsockname $fh)[1]; |
52 |
|
|
|
53 |
root |
1.21 |
my $id = format_hostport $host, $port; |
54 |
|
|
|
55 |
root |
1.25 |
cf::info "$id: accepted connection.\n" |
56 |
root |
1.18 |
if $lhost ne $host; # do not log connections from the host, e.g. for watchdogs |
57 |
root |
1.12 |
|
58 |
root |
1.21 |
my $buf; |
59 |
|
|
my $w; $w = AE::io $fh, 0, sub { |
60 |
|
|
my $len = sysread $fh, $buf, 512, length $buf; |
61 |
|
|
|
62 |
|
|
if ($len) { |
63 |
root |
1.25 |
for ($buf) { |
64 |
root |
1.27 |
for my $v (values %DETECTORS) { |
65 |
root |
1.25 |
if (my $cb = $v->[1]()) { |
66 |
|
|
undef $w; |
67 |
root |
1.27 |
cf::debug "$id: detected protocol $v->[3].\n"; |
68 |
root |
1.25 |
$v->[2]($id, $fh, $buf); |
69 |
|
|
return; |
70 |
|
|
} |
71 |
|
|
} |
72 |
|
|
|
73 |
|
|
if (length >= $MAX_DETECT) { # unable to detect protocol |
74 |
|
|
undef $w; |
75 |
|
|
cf::debug "$id: data received, but cannot detect protocol, closing.\n"; |
76 |
|
|
} |
77 |
root |
1.21 |
} |
78 |
|
|
} else { |
79 |
|
|
undef $w; |
80 |
root |
1.25 |
cf::info "$id: read error during protocol detection ($!)\n"; |
81 |
root |
1.21 |
} |
82 |
|
|
}; |
83 |
root |
1.12 |
}; |
84 |
root |
1.1 |
} |
85 |
|
|
|