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 |
use Data::Dump; |
22 |
ddx [$MAX_DETECT, \%DETECTORS]; |
23 |
} |
24 |
|
25 |
sub register($$$$) { |
26 |
my ($name, $max_detect, $detect, $serve) = @_; |
27 |
|
28 |
$DETECTORS{$name} = [$max_detect, $detect, $serve]; |
29 |
_update_detectors; |
30 |
|
31 |
Guard::guard { |
32 |
delete $DETECTORS{$name}; |
33 |
_update_detectors; |
34 |
} |
35 |
} |
36 |
|
37 |
our $deliantra_detector = ext::tcp::register deliantra => 10, sub { |
38 |
/^..version /s |
39 |
}, sub { |
40 |
my $ns = cf::client::create fileno $_[1], $_[0]; |
41 |
$ns->inbuf_append ($_[2]); |
42 |
}; |
43 |
|
44 |
for (@$BIND_ADDRESSES) { |
45 |
my ($host, $port) = @$_; |
46 |
cf::info "listening on ", (format_hostport $host, $port), "\n"; |
47 |
|
48 |
push @LISTENERS, tcp_server $host, $port, sub { |
49 |
my ($fh, $host, $port) = @_ |
50 |
or return; |
51 |
|
52 |
my $lhost = AnyEvent::Socket::format_address |
53 |
+(AnyEvent::Socket::unpack_sockaddr getsockname $fh)[1]; |
54 |
|
55 |
my $id = format_hostport $host, $port; |
56 |
|
57 |
cf::info "$id: accepted connection.\n" |
58 |
if $lhost ne $host; # do not log connections from the host, e.g. for watchdogs |
59 |
|
60 |
my $buf; |
61 |
my $w; $w = AE::io $fh, 0, sub { |
62 |
my $len = sysread $fh, $buf, 512, length $buf; |
63 |
|
64 |
if ($len) { |
65 |
for ($buf) { |
66 |
while (my ($name, $v) = each %DETECTORS) { |
67 |
if (my $cb = $v->[1]()) { |
68 |
undef $w; |
69 |
cf::debug "$id: detected protocol $name.\n"; |
70 |
$v->[2]($id, $fh, $buf); |
71 |
return; |
72 |
} |
73 |
} |
74 |
|
75 |
if (length >= $MAX_DETECT) { # unable to detect protocol |
76 |
undef $w; |
77 |
cf::debug "$id: data received, but cannot detect protocol, closing.\n"; |
78 |
} |
79 |
} |
80 |
} else { |
81 |
undef $w; |
82 |
cf::info "$id: read error during protocol detection ($!)\n"; |
83 |
} |
84 |
}; |
85 |
}; |
86 |
} |
87 |
|