7 chmod a+rw list_full list log.log
10 www/fcgiwrap www/nginx
21 add_header Access-Control-Allow-Origin *;
24 fastcgi_pass unix:/var/run/fcgiwrap/fcgiwrap.sock;
25 fastcgi_param SCRIPT_FILENAME $document_root/master.cgi;
26 include fastcgi_params;
31 AddHandler cgi-script .cgi
32 DirectoryIndex index.html
33 Options +ExecCGI +FollowSymLinks
35 <FilesMatch (\.(html?|cgi|fcgi|css|js|gif|png|jpe?g|ico)|(^)|\w+)$>
39 <ifModule mod_headers.c>
40 Header set Access-Control-Allow-Origin: *
49 use warnings "NONFATAL" => "all";
50 no warnings qw(uninitialized);
54 if ($Socket::VERSION ge '2.008') {
55 eval qq{use Socket qw(getaddrinfo getnameinfo NI_NUMERICHOST NIx_NOSERV)}; # >5.16
57 eval qq{use Socket6 qw(getaddrinfo getnameinfo NI_NUMERICHOST NIx_NOSERV)}; # <5.16
60 use Time::HiRes qw(time sleep);
66 ($ENV{'SCRIPT_FILENAME'} || $0) =~ m|^(.+)[/\\].+?$|; #v0w
67 $root_path = $1 . '/' if $1;
68 $root_path =~ s|\\|/|g;
72 list_full => $root_path . 'list_full',
73 list_pub => $root_path . 'list',
74 log => $root_path . 'log.log',
75 time_purge => 86400 * 30,
82 trusted => [qw( 176.9.122.10 )], #masterserver self ip - if server on same ip with masterserver doesnt announced
83 #blacklist => [], # [qw(2.3.4.5 4.5.6.7 8.9.0.1), '1.2.3.4', qr/^10\.20\.30\./, ], # list, or quoted, ips, or regex
85 do($root_path . 'config.pl');
86 our $ping = Net::Ping->new("udp", $config{ping_timeout});
89 sub get_params_one(@) {
90 local %_ = %{ref $_[0] eq 'HASH' ? shift : {}};
92 tr/+/ /, s/%([a-f\d]{2})/pack 'H*', $1/gei for my ($k, $v) = /^([^=]+=?)=(.+)$/ ? ($1, $2) : (/^([^=]*)=?$/, /^-/);
98 sub get_params(;$$) { #v7
99 my ($string, $delim) = @_;
101 read(STDIN, local $_ = '', $ENV{'CONTENT_LENGTH'}) if !$string and $ENV{'CONTENT_LENGTH'};
104 ? get_params_one split $delim, $string
105 : (get_params_one(@ARGV), map { get_params_one split $delim, $_ } split(/;\s*/, $ENV{'HTTP_COOKIE'}), $ENV{'QUERY_STRING'}, $_);
106 wantarray ? %_ : \%_;
109 sub get_params_utf8(;$$) {
110 local $_ = &get_params;
111 utf8::decode $_ for %$_;
112 wantarray ? %$_ : $_;
115 sub file_rewrite(;$@) {
117 return unless open my $fh, '>', $_;
123 return unless open my $fh, '>>', $config{log};
124 print $fh (join ' ', @_), "\n";
128 open my $f, '<', $_[0] or return;
137 eval { $ret = JSON->new->utf8->relaxed(1)->decode(${ref $_[0] ? $_[0] : file_read($_[0]) or \''} || '{}'); }; #'mc
138 printlog "json error [$@] on [", ${ref $_[0] ? $_[0] : \$_[0]}, "]" if $@;
144 print($_), next unless utf8::is_utf8($_);
152 return ($_[0] < 8 and $_[0] - int($_[0]))
153 ? sprintf('%.' . ($_[0] < 1 ? 3 : ($_[0] < 3 ? 2 : 1)) . 'f', $_[0])
159 my ($addr, $port) = @_;
160 printlog "mineping($addr, $port)" if $config{debug};
164 my $socket = IO::Socket::IP->new(
168 'Timeout' => $config{ping_timeout},
170 $socket->send("\x4f\x45\x74\x03\x00\x00\x00\x01");
171 local $SIG{ALRM} = sub { die "alarm time out"; };
172 alarm $config{ping_timeout};
173 $socket->recv($data, POSIX::BUFSIZ) or die "recv: $!";
175 1; # return value from eval on normalcy
177 return 0 unless length $data;
178 $time = float(time - $time);
179 printlog "recvd: ", length $data, " [$time]" if $config{debug};
186 my $param = get_params_utf8;
188 if ($param->{json}) {
190 eval { $j = JSON->new->decode($param->{json}) || {} };
191 $param->{$_} = $j->{$_} for keys %$j;
192 delete $param->{json};
195 s/^false$// for values %$param;
196 $param->{ip} = $r->{REMOTE_ADDR};
197 $param->{ip} =~ s/^::ffff://;
198 for (@{$config{blacklist}}) {
199 return if $param->{ip} ~~ $_;
201 $param->{address} ||= $param->{ip};
202 if ($config{source_check}) {
203 (my $err, local @_) = getaddrinfo($param->{address});
204 my $addrs = [ map{(getnameinfo($_->{addr}, NI_NUMERICHOST, NIx_NOSERV))[1]} @_];
205 if (!($param->{ip} ~~ $addrs) and !($param->{ip} ~~ $config{trusted})) {
206 printlog("bad address (", @$addrs, ")[$param->{address}] ne [$param->{ip}] [$err]") if $config{debug};
210 $param->{port} ||= 30000;
211 $param->{key} = "$param->{ip}:$param->{port}";
212 $param->{off} = time if $param->{action} ~~ 'delete';
213 if ($config{ping} and $param->{action} ne 'delete') {
214 if ($config{mineping}) {
215 $param->{ping} = mineping($param->{ip}, $param->{port});
217 $ping->port_number($param->{port});
218 $ping->service_check(0);
219 my ($pingret, $duration, $ip) = $ping->ping($param->{address});
220 if ($ip ne $param->{ip} and !($param->{ip} ~~ $config{trusted})) {
221 printlog "strange ping ip [$ip] != [$param->{ip}]" if $config{debug};
222 return if $config{source_check} and !($param->{ip} ~~ $config{trusted});
224 $param->{ping} = $duration if $pingret;
225 printlog " PING t=$config{ping_timeout}, $param->{address}:$param->{port} = ( $pingret, $duration, $ip )" if $config{debug};
228 my $list = read_json($config{list_full}) || {};
229 printlog "readed[$config{list_full}] list size=", scalar @{$list->{list}};
230 my $listk = {map { $_->{key} => $_ } @{$list->{list}}};
231 my $old = $listk->{$param->{key}};
232 $param->{time} = $old->{time} if $param->{off};
233 $param->{time} ||= int time;
234 $param->{start} = $param->{action} ~~ 'start' ? $param->{time} : $old->{start} || $param->{time};
235 delete $param->{start} if $param->{off};
236 $param->{first} ||= $old->{first} || $old->{time} || $param->{time};
237 $param->{clients_top} = $old->{clients_top} if $old->{clients_top} > $param->{clients};
238 $param->{clients_top} ||= $param->{clients} || 0;
239 $param->{mods} ||= $old->{mods};
240 delete $param->{action};
241 $listk->{$param->{key}} = $param;
242 #printlog Dumper $param;
243 $list->{list} = [grep { $_->{time} > time - $config{time_purge} } values %$listk];
244 file_rewrite($config{list_full}, JSON->new->encode($list));
245 printlog "writed[$config{list_full}] list size=", scalar @{$list->{list}} if $config{debug};
247 sort { $b->{clients} <=> $a->{clients} || $a->{start} <=> $b->{start} }
248 grep { $_->{time} > time - $config{time_alive} and !$_->{off} and (!$config{ping} or !$config{pingable} or $_->{ping}) }
251 file_rewrite($config{list_pub}, JSON->new->encode($list));
252 printlog "writed[$config{list_pub}] list size=", scalar @{$list->{list}} if $config{debug};
255 return [200, ["Content-type", "application/json"], [JSON->new->encode({})]], $after;
259 my ($p, $after) = request(@_);
261 printu join "\n", map { join ': ', @$_ } shift @$p;
263 printu join '', map { join '', @$_ } @$p;
265 unless ($config{debug}) {
270 $after->() if ref $after ~~ 'CODE';
273 request_cgi() unless caller;