util/master/master.cgi

   1 #!/usr/bin/perl
   2
   3 =info
   4 install:
   5  cpan JSON JSON::XS
   6  touch list_full list log.log
   7  chmod a+rw list_full list log.log
   8
   9 freebsd:
  10  www/fcgiwrap www/nginx
  11
  12 rc.conf.local:
  13 nginx_enable="YES"
  14 fcgiwrap_enable="YES"
  15 fcgiwrap_user="www"
  16
  17 nginx:
  18
  19         location / {
  20             index  index.html;
  21             add_header Access-Control-Allow-Origin *;
  22         }
  23         location /announce {
  24             fastcgi_pass   unix:/var/run/fcgiwrap/fcgiwrap.sock;
  25             fastcgi_param  SCRIPT_FILENAME $document_root/master.cgi;
  26             include        fastcgi_params;
  27         }
  28
  29
  30 apache .htaccess:
  31  AddHandler cgi-script .cgi
  32  DirectoryIndex index.html
  33  Options +ExecCGI +FollowSymLinks
  34  Order allow,deny
  35  <FilesMatch (\.(html?|cgi|fcgi|css|js|gif|png|jpe?g|ico)|(^)|\w+)$>
  36   Allow from all
  37  </FilesMatch>
  38  Deny from all
  39  <ifModule mod_headers.c>
  40      Header set Access-Control-Allow-Origin: *
  41  </ifModule>
  42
  43
  44
  45 =cut
  46
  47 use strict;
  48 no strict qw(refs);
  49 use warnings "NONFATAL" => "all";
  50 no warnings qw(uninitialized);
  51 no if $] >= 5.017011, warnings => 'experimental::smartmatch';
  52 use utf8;
  53 use Socket;
  54 BEGIN {
  55     if ($Socket::VERSION ge '2.008') {
  56         eval qq{use Socket qw(getaddrinfo getnameinfo NI_NUMERICHOST NIx_NOSERV)}; # >5.16
  57     } else {
  58         eval qq{use Socket6 qw(getaddrinfo getnameinfo NI_NUMERICHOST NIx_NOSERV)}; # <5.16
  59     }
  60 };
  61 use Time::HiRes qw(time sleep);
  62 use IO::Socket::IP;
  63 use JSON;
  64 use Net::Ping;
  65 #use Data::Dumper;
  66 our $root_path;
  67 ($ENV{'SCRIPT_FILENAME'} || $0) =~ m|^(.+)[/\\].+?$|;    #v0w
  68 $root_path = $1 . '/' if $1;
  69 $root_path =~ s|\\|/|g;
  70
  71 our %config = (
  72     #debug        => 1,
  73     list_full    => $root_path . 'list_full',
  74     list_pub     => $root_path . 'list',
  75     log          => $root_path . 'log.log',
  76     time_purge   => 86400 * 1,
  77     time_alive   => 650,
  78     source_check => 1,
  79     ping_timeout => 3,
  80     ping         => 1,
  81     mineping     => 1,
  82     pingable     => 1,
  83     trusted      => [qw( 176.9.122.10 )],       #masterserver self ip - if server on same ip with masterserver doesnt announced
  84     #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 );
  86 do($root_path . 'config.pl');
  87 our $ping = Net::Ping->new("udp", $config{ping_timeout});
  88 $ping->hires();
  89
  90 sub get_params_one(@) {
  91     local %_ = %{ref $_[0] eq 'HASH' ? shift : {}};
  92     for (@_) {
  93         tr/+/ /, s/%([a-f\d]{2})/pack 'H*', $1/gei for my ($k, $v) = /^([^=]+=?)=(.+)$/ ? ($1, $2) : (/^([^=]*)=?$/, /^-/);
  94         $_{$k} = $v;
  95     }
  96     wantarray ? %_ : \%_;
  97 }
  98
  99 sub get_params(;$$) {    #v7
 100     my ($string, $delim) = @_;
 101     $delim ||= '&';
 102     read(STDIN, local $_ = '', $ENV{'CONTENT_LENGTH'}) if !$string and $ENV{'CONTENT_LENGTH'};
 103     local %_ =
 104       $string
 105       ? get_params_one split $delim, $string
 106       : (get_params_one(@ARGV), map { get_params_one split $delim, $_ } split(/;\s*/, $ENV{'HTTP_COOKIE'}), $ENV{'QUERY_STRING'}, $_);
 107     wantarray ? %_ : \%_;
 108 }
 109
 110 sub get_params_utf8(;$$) {
 111     local $_ = &get_params;
 112     utf8::decode $_ for %$_;
 113     wantarray ? %$_ : $_;
 114 }
 115
 116 sub file_rewrite(;$@) {
 117     local $_ = shift;
 118     return unless open my $fh, '>', $_;
 119     print $fh @_;
 120 }
 121
 122 sub printlog(;@) {
 123     #local $_ = shift;
 124     return unless open my $fh, '>>', $config{log};
 125     print $fh (join ' ', @_), "\n";
 126 }
 127
 128 sub file_read ($) {
 129     open my $f, '<', $_[0] or return;
 130     local $/ = undef;
 131     my $ret = <$f>;
 132     close $f;
 133     return \$ret;
 134 }
 135
 136 sub read_json {
 137     my $ret = {};
 138     eval { $ret = JSON->new->utf8->relaxed(1)->decode(${ref $_[0] ? $_[0] : file_read($_[0]) or \''} || '{}'); };    #'mc
 139     printlog "json error [$@] on [", ${ref $_[0] ? $_[0] : \$_[0]}, "]" if $@;
 140     $ret;
 141 }
 142
 143 sub printu (@) {
 144     for (@_) {
 145         print($_), next unless utf8::is_utf8($_);
 146         my $s = $_;
 147         utf8::encode($s);
 148         print($s);
 149     }
 150 }
 151
 152 sub float {
 153     return ($_[0] < 8 and $_[0] - int($_[0]))
 154       ? sprintf('%.' . ($_[0] < 1 ? 3 : ($_[0] < 3 ? 2 : 1)) . 'f', $_[0])
 155       : int($_[0]);
 156 }
 157
 158 sub mineping ($$) {
 159     my ($addr, $port) = @_;
 160     printlog "mineping($addr, $port)" if $config{debug};
 161     my $data;
 162     my $time = time;
 163     eval {
 164         my $socket = IO::Socket::IP->new(
 165             'PeerAddr' => $addr,
 166             'PeerPort' => $port,
 167             'Proto'    => 'udp',
 168             'Timeout'  => $config{ping_timeout},
 169         );
 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: $!";
 174         alarm 0;
 175         1;    # return value from eval on normalcy
 176     } or return 0;
 177     return 0 unless length $data;
 178     $time = float(time - $time);
 179     printlog "recvd: ", length $data, " [$time]" if $config{debug};
 180     return $time;
 181 }
 182
 183 sub request (;$) {
 184     my ($r) = @_;
 185     $r ||= \%ENV;
 186     my $param = get_params_utf8;
 187     my $after = sub {
 188         if ($param->{json}) {
 189             my $j = {};
 190             eval { $j = JSON->new->decode($param->{json}) || {} };
 191             $param->{$_} = $j->{$_} for keys %$j;
 192             delete $param->{json};
 193         }
 194         #printlog 'recv', Dumper $param;
 195         if (%$param) {
 196             s/^false$// for values %$param;
 197             $param->{ip} = $r->{REMOTE_ADDR};
 198             $param->{ip} =~ s/^::ffff://;
 199             for (@{$config{blacklist}}) {
 200                 #printlog("blacklist", $param->{ip} ~~ $_) if $config{debug};
 201                 return if $param->{ip} ~~ $_;
 202             }
 203             $param->{address} ||= $param->{ip};
 204             if ($config{source_check}) {
 205                 (my $err, local @_) = getaddrinfo($param->{address});
 206                 my $addrs = [ map{(getnameinfo($_->{addr}, NI_NUMERICHOST, NIx_NOSERV))[1]} @_];
 207                 if (!($param->{ip} ~~ $addrs) and !($param->{ip} ~~ $config{trusted})) {
 208                     printlog("bad address (", @$addrs, ")[$param->{address}] ne [$param->{ip}] [$err]") if $config{debug};
 209                     return;
 210                 }
 211             }
 212             $param->{port} ||= 30000;
 213             $param->{key} = "$param->{ip}:$param->{port}";
 214             $param->{off} = time if $param->{action} ~~ 'delete';
 215             if ($config{ping} and $param->{action} ne 'delete') {
 216                 if ($config{mineping}) {
 217                     $param->{ping} = mineping($param->{ip}, $param->{port});
 218                 } else {
 219                     $ping->port_number($param->{port});
 220                     $ping->service_check(0);
 221                     my ($pingret, $duration, $ip) = $ping->ping($param->{address});
 222                     if ($ip ne $param->{ip} and !($param->{ip} ~~ $config{trusted})) {
 223                         printlog "strange ping ip [$ip] != [$param->{ip}]" if $config{debug};
 224                         return if $config{source_check} and !($param->{ip} ~~ $config{trusted});
 225                     }
 226                     $param->{ping} = $duration if $pingret;
 227                     printlog " PING t=$config{ping_timeout}, $param->{address}:$param->{port} = ( $pingret, $duration, $ip )" if $config{debug};
 228                 }
 229                 return if !$param->{ping};
 230             }
 231             my $list = read_json($config{list_full}) || {};
 232             printlog "readed[$config{list_full}] list size=", scalar @{$list->{list}} if $config{debug};
 233             my $listk = {map { $_->{key} => $_ } @{$list->{list}}};
 234             my $old = $listk->{$param->{key}};
 235             $param->{time} = $old->{time} if $param->{off};
 236             $param->{time} ||= int time;
 237             $param->{start} = $param->{action} ~~ 'start' ? $param->{time} : $old->{start} || $param->{time};
 238             delete $param->{start} if $param->{off};
 239             $param->{clients} ||= scalar @{$param->{clients_list}} if ref $param->{clients_list} eq 'ARRAY';
 240             $param->{first} ||= $old->{first} || $old->{time} || $param->{time};
 241             $param->{clients_top} = $old->{clients_top} if $old->{clients_top} > $param->{clients};
 242             $param->{clients_top} ||= $param->{clients} || 0;
 243             # params reported once on start, must be same as src/serverlist.cpp:~221 if(server["action"] == "start") { ...
 244             for (qw(dedicated rollback liquid_finite mapgen mods)) {
 245                 $param->{$_} ||= $old->{$_} if $old->{$_} and !($param->{action} ~~ 'start');
 246             }
 247             $param->{pop_n} = $old->{pop_n} + 1;
 248             $param->{pop_c} = $old->{pop_c} + $param->{clients};
 249             $param->{pop_v} = $param->{pop_c} / $param->{pop_n};
 250             delete $param->{action};
 251             $listk->{$param->{key}} = $param;
 252             #printlog 'write', Dumper $param if $config{debug};
 253             my $list_full = [grep { $_->{time} > time - $config{time_purge} } values %$listk];
 254
 255             $list->{list} = [
 256                 sort { $b->{clients} <=> $a->{clients} || $a->{start} <=> $b->{start} }
 257                   grep { $_->{time} > time - $config{time_alive} and !$_->{off} and (!$config{ping} or !$config{pingable} or $_->{ping}) }
 258                   @{$list_full}
 259             ];
 260             $list->{total} = {clients => 0, servers => 0};
 261             for (@{$list->{list}}) {
 262                 $list->{total}{clients} += $_->{clients};
 263                 ++$list->{total}{servers};
 264             }
 265             $list->{total_max}{clients} = $list->{total}{clients} if $list->{total_max}{clients} < $list->{total}{clients};
 266             $list->{total_max}{servers} = $list->{total}{servers} if $list->{total_max}{servers} < $list->{total}{servers};
 267
 268             file_rewrite($config{list_pub}, JSON->new->encode($list));
 269             printlog "writed[$config{list_pub}] list size=", scalar @{$list->{list}} if $config{debug};
 270
 271             $list->{list} = $list_full;
 272             file_rewrite($config{list_full}, JSON->new->encode($list));
 273             printlog "writed[$config{list_full}] list size=", scalar @{$list->{list}} if $config{debug};
 274
 275         }
 276     };
 277     return [200, ["Content-type", "application/json"], [JSON->new->encode({})]], $after;
 278 }
 279
 280 sub request_cgi {
 281     my ($p, $after) = request(@_);
 282     shift @$p;
 283     printu join "\n", map { join ': ', @$_ } shift @$p;
 284     printu "\n\n";
 285     printu join '', map { join '', @$_ } @$p;
 286     if (fork) {
 287         unless ($config{debug}) {
 288             close STDOUT;
 289             close STDERR;
 290         }
 291     } else {
 292         $after->() if ref $after ~~ 'CODE';
 293     }
 294 }
 295 request_cgi() unless caller;