diff options
Diffstat (limited to 'util/master/master.cgi')
| -rwxr-xr-x | util/master/master.cgi | 257 |
1 files changed, 257 insertions, 0 deletions
diff --git a/util/master/master.cgi b/util/master/master.cgi new file mode 100755 index 000000000..b918876bd --- /dev/null +++ b/util/master/master.cgi @@ -0,0 +1,257 @@ +#!/usr/bin/perl + +=info +install: + cpan JSON JSON::XS + touch list_full list + chmod a+rw list_full list + +freebsd: + www/fcgiwrap www/nginx + +rc.conf.local: +nginx_enable="YES" +fcgiwrap_enable="YES" +fcgiwrap_user="www" + +nginx: + + location / { + index index.html; + } + location /announce { + fastcgi_pass unix:/var/run/fcgiwrap/fcgiwrap.sock; + fastcgi_param SCRIPT_FILENAME $document_root/master.cgi; + include fastcgi_params; + } + + +apache .htaccess: + AddHandler cgi-script .cgi + DirectoryIndex index.html + Options +ExecCGI +FollowSymLinks + Order allow,deny + <FilesMatch (\.(html?|cgi|fcgi|css|js|gif|png|jpe?g|ico)|(^)|\w+)$> + Allow from all + </FilesMatch> + Deny from all + + +=cut + +use strict; +no strict qw(refs); +use warnings "NONFATAL" => "all"; +no warnings qw(uninitialized); +use utf8; +use Socket; +use Time::HiRes qw(time sleep); +use IO::Socket::INET; +use JSON; +use Net::Ping; +our $root_path; +($ENV{'SCRIPT_FILENAME'} || $0) =~ m|^(.+)[/\\].+?$|; #v0w +$root_path = $1 . '/' if $1; +$root_path =~ s|\\|/|g; + +our %config = ( + #debug => 1, + list_full => $root_path . 'list_full', + list_pub => $root_path . 'list', + time_purge => 86400 * 30, + time_alive => 650, + source_check => 1, + ping_timeout => 3, + ping => 1, + mineping => 1, + pingable => 1, + trusted => [qw( 176.9.122.10 )], #masterserver self ip - if server on same ip with masterserver doesnt announced + #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 +); +do($root_path . 'config.pl'); +our $ping = Net::Ping->new("udp", $config{ping_timeout}); +$ping->hires(); + +sub get_params_one(@) { + local %_ = %{ref $_[0] eq 'HASH' ? shift : {}}; + for (@_) { + tr/+/ /, s/%([a-f\d]{2})/pack 'H*', $1/gei for my ($k, $v) = /^([^=]+=?)=(.+)$/ ? ($1, $2) : (/^([^=]*)=?$/, /^-/); + $_{$k} = $v; + } + wantarray ? %_ : \%_; +} + +sub get_params(;$$) { #v7 + my ($string, $delim) = @_; + $delim ||= '&'; + read(STDIN, local $_ = '', $ENV{'CONTENT_LENGTH'}) if !$string and $ENV{'CONTENT_LENGTH'}; + local %_ = + $string + ? get_params_one split $delim, $string + : (get_params_one(@ARGV), map { get_params_one split $delim, $_ } split(/;\s*/, $ENV{'HTTP_COOKIE'}), $ENV{'QUERY_STRING'}, $_); + wantarray ? %_ : \%_; +} + +sub get_params_utf8(;$$) { + local $_ = &get_params; + utf8::decode $_ for %$_; + wantarray ? %$_ : $_; +} + +sub file_rewrite(;$@) { + local $_ = shift; + return unless open my $fh, '>', $_; + print $fh @_; +} + +sub file_read ($) { + open my $f, '<', $_[0] or return; + local $/ = undef; + my $ret = <$f>; + close $f; + return \$ret; +} + +sub read_json { + my $ret = {}; + eval { $ret = JSON->new->utf8->relaxed(1)->decode(${ref $_[0] ? $_[0] : file_read($_[0]) or \''} || '{}'); }; #'mc + warn "json error [$@] on [", ${ref $_[0] ? $_[0] : \$_[0]}, "]" if $@; + $ret; +} + +sub printu (@) { + for (@_) { + print($_), next unless utf8::is_utf8($_); + my $s = $_; + utf8::encode($s); + print($s); + } +} + +sub name_to_ip_noc($) { + my ($name) = @_; + unless ($name =~ /^\d+\.\d+\.\d+\.\d+$/) { + local $_ = (gethostbyname($name))[4]; + return ($name, 1) unless length($_) == 4; + $name = inet_ntoa($_); + } + return $name; +} + +sub float { + return ($_[0] < 8 and $_[0] - int($_[0])) + ? sprintf('%.' . ($_[0] < 1 ? 3 : ($_[0] < 3 ? 2 : 1)) . 'f', $_[0]) + : int($_[0]); + +} + +sub mineping ($$) { + my ($addr, $port) = @_; + warn "mineping($addr, $port)" if $config{debug}; + my $data; + my $time = time; + eval { + my $socket = IO::Socket::INET->new( + 'PeerAddr' => $addr, + 'PeerPort' => $port, + 'Proto' => 'udp', + 'Timeout' => $config{ping_timeout}, + ); + $socket->send("\x4f\x45\x74\x03\x00\x00\x00\x01"); + local $SIG{ALRM} = sub { die "alarm time out"; }; + alarm $config{ping_timeout}; + $socket->recv($data, POSIX::BUFSIZ) or die "recv: $!"; + alarm 0; + 1; # return value from eval on normalcy + } or return 0; + return 0 unless length $data; + $time = float(time - $time); + warn "recvd: ", length $data, " [$time]" if $config{debug}; + return $time; +} + +sub request (;$) { + my ($r) = @_; + $r ||= \%ENV; + my $param = get_params_utf8; + my $after = sub { + if ($param->{json}) { + my $j = {}; + eval { $j = JSON->new->decode($param->{json}) || {} }; + $param->{$_} = $j->{$_} for keys %$j; + delete $param->{json}; + } + if (%$param) { + s/^false$// for values %$param; + $param->{ip} = $r->{REMOTE_ADDR}; + for (@{$config{blacklist}}) { + return if $param->{ip} ~~ $_; + } + $param->{address} ||= $param->{ip}; + if ($config{source_check} and name_to_ip_noc($param->{address}) ne $param->{ip} and !($param->{ip} ~~ $config{trusted})) { + warn("bad address [$param->{address}] ne [$param->{ip}]") if $config{debug}; + return; + } + $param->{port} ||= 30000; + $param->{key} = "$param->{ip}:$param->{port}"; + $param->{off} = time if $param->{action} ~~ 'delete'; + + if ($config{ping} and $param->{action} ne 'delete') { + if ($config{mineping}) { + $param->{ping} = mineping($param->{ip}, $param->{port}); + } else { + $ping->port_number($param->{port}); + $ping->service_check(0); + my ($pingret, $duration, $ip) = $ping->ping($param->{address}); + if ($ip ne $param->{ip} and !($param->{ip} ~~ $config{trusted})) { + warn "strange ping ip [$ip] != [$param->{ip}]" if $config{debug}; + return if $config{source_check} and !($param->{ip} ~~ $config{trusted}); + } + $param->{ping} = $duration if $pingret; + warn " PING t=$config{ping_timeout}, $param->{address}:$param->{port} = ( $pingret, $duration, $ip )" if $config{debug}; + } + } + my $list = read_json($config{list_full}) || {}; + warn "readed[$config{list_full}] list size=", scalar @{$list->{list}}; + my $listk = {map { $_->{key} => $_ } @{$list->{list}}}; + my $old = $listk->{$param->{key}}; + $param->{time} = $old->{time} if $param->{off}; + $param->{time} ||= int time; + $param->{start} = $param->{action} ~~ 'start' ? $param->{time} : $old->{start} || $param->{time}; + delete $param->{start} if $param->{off}; + $param->{first} ||= $old->{first} || $old->{time} || $param->{time}; + $param->{clients_top} = $old->{clients_top} if $old->{clients_top} > $param->{clients}; + $param->{clients_top} ||= $param->{clients} || 0; + delete $param->{action}; + $listk->{$param->{key}} = $param; + $list->{list} = [grep { $_->{time} > time - $config{time_purge} } values %$listk]; + file_rewrite($config{list_full}, JSON->new->encode($list)); + warn "writed[$config{list_full}] list size=", scalar @{$list->{list}}; + $list->{list} = [ + sort { $b->{clients} <=> $a->{clients} || $a->{start} <=> $b->{start} } + grep { $_->{time} > time - $config{time_alive} and !$_->{off} and (!$config{ping} or !$config{pingable} or $_->{ping}) } + @{$list->{list}} + ]; + file_rewrite($config{list_pub}, JSON->new->encode($list)); + warn "writed[$config{list_pub}] list size=", scalar @{$list->{list}}; + } + }; + return [200, ["Content-type", "application/json"], [JSON->new->encode({})]], $after; +} + +sub request_cgi { + my ($p, $after) = request(@_); + shift @$p; + printu join "\n", map { join ': ', @$_ } shift @$p; + printu "\n\n"; + printu join '', map { join '', @$_ } @$p; + if (fork) { + unless ($config{debug}) { + close STDOUT; + close STDERR; + } + } else { + $after->() if ref $after ~~ 'CODE'; + } +} +request_cgi() unless caller; |