1 |
#! perl # mandatory |
2 |
|
3 |
# this listens for new tcp connections and hands them over to the server core |
4 |
# whether this being an extension introduces or reduces stability problems |
5 |
# is unknown as of today. |
6 |
|
7 |
use Socket; |
8 |
use AnyEvent::Socket; |
9 |
|
10 |
CONF BIND_ADDRESSES = [[undef, 13327]]; |
11 |
|
12 |
our $MAX_DETECT; # how many bytes to read to identify the protocol |
13 |
|
14 |
our @LISTENERS; |
15 |
our @DETECTORS; |
16 |
our %DETECTORS; |
17 |
|
18 |
sub _update_detectors { |
19 |
$MAX_DETECT = List::Util::max map $_->[1], values %DETECTORS; |
20 |
} |
21 |
|
22 |
sub register($$$$) { |
23 |
my ($name, $max_detect, $detect, $serve) = @_; |
24 |
|
25 |
$DETECTORS{$name} = [$max_detect, $detect, $serve, $name]; |
26 |
_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 |
$ns->run; |
39 |
$ns->inbuf_append ($_[2]); |
40 |
}; |
41 |
|
42 |
for (@$BIND_ADDRESSES) { |
43 |
my ($host, $port) = @$_; |
44 |
cf::info "listening on ", (format_hostport $host, $port), "\n"; |
45 |
|
46 |
push @LISTENERS, tcp_server $host, $port, sub { |
47 |
my ($fh, $host, $port) = @_ |
48 |
or return; |
49 |
|
50 |
my $lhost = AnyEvent::Socket::format_address |
51 |
+(AnyEvent::Socket::unpack_sockaddr getsockname $fh)[1]; |
52 |
|
53 |
my $id = format_hostport $host, $port; |
54 |
|
55 |
cf::info "$id: accepted connection.\n" |
56 |
if $lhost ne $host; # do not log connections from the host, e.g. for watchdogs |
57 |
|
58 |
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 |
for ($buf) { |
64 |
for my $v (values %DETECTORS) { |
65 |
if (my $cb = $v->[1]()) { |
66 |
undef $w; |
67 |
cf::debug "$id: detected protocol $v->[3].\n"; |
68 |
$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 |
} |
78 |
} else { |
79 |
undef $w; |
80 |
cf::info "$id: read error during protocol detection ($!)\n"; |
81 |
} |
82 |
}; |
83 |
}; |
84 |
} |
85 |
|