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 |
root |
1.25 |
use Data::Dump; |
22 |
|
|
ddx [$MAX_DETECT, \%DETECTORS]; |
23 |
root |
1.23 |
} |
24 |
|
|
|
25 |
root |
1.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 |
root |
1.20 |
for (@$BIND_ADDRESSES) { |
45 |
root |
1.12 |
my ($host, $port) = @$_; |
46 |
root |
1.16 |
cf::info "listening on ", (format_hostport $host, $port), "\n"; |
47 |
root |
1.12 |
|
48 |
root |
1.15 |
push @LISTENERS, tcp_server $host, $port, sub { |
49 |
root |
1.12 |
my ($fh, $host, $port) = @_ |
50 |
|
|
or return; |
51 |
|
|
|
52 |
root |
1.18 |
my $lhost = AnyEvent::Socket::format_address |
53 |
|
|
+(AnyEvent::Socket::unpack_sockaddr getsockname $fh)[1]; |
54 |
|
|
|
55 |
root |
1.21 |
my $id = format_hostport $host, $port; |
56 |
|
|
|
57 |
root |
1.25 |
cf::info "$id: accepted connection.\n" |
58 |
root |
1.18 |
if $lhost ne $host; # do not log connections from the host, e.g. for watchdogs |
59 |
root |
1.12 |
|
60 |
root |
1.21 |
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 |
root |
1.25 |
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 |
root |
1.21 |
} |
80 |
|
|
} else { |
81 |
|
|
undef $w; |
82 |
root |
1.25 |
cf::info "$id: read error during protocol detection ($!)\n"; |
83 |
root |
1.21 |
} |
84 |
|
|
}; |
85 |
root |
1.12 |
}; |
86 |
root |
1.1 |
} |
87 |
|
|
|