#!/usr/bin/perl -w # modules use strict; use warnings; use IO::Socket; # constants my $VERSION = "0.3"; my $SERVERINFOPORTOFFSET = 1; my $STARTGAMEMODE = -3; my @GAMEMODES = ( "SP", "DMSP", "demo", "ffa", "coop edit", "teamplay", "instagib", "instagib team", "efficiency", "efficiency team", "tactics", "tactics team", "capture", "regen capture", "ctf", "insta ctf", "protect", "insta protect", ); my $STARTPROTOMODE = -1; my @PROTOMODES = ( "auth", "open", "veto", "locked", "private", "password", ); my @STATES = ( "alive", "dead", "spawning", "lagged", "editing", "spectator", ); my @PRIVILEGES = ( "none", "master", "admin", ); my @GUNS = ( "Chainsaw", "Shotgun", "Chaingun", "Rocketlauncher", "Rifle", "Grenadelauncher", "Pistol", ); my $EXT_ACK = -1; my $EXT_NO_ERROR = 0; my $CMD_INFO = 1; my $CMD_EXT = 0; my $EXT_UPTIME = 0; my $EXT_PLAYERSTATS = 1; my $EXT_TEAMSCORE = 2; my $EXT_PLAYERSTATS_RESP_IDS = -10; my $EXT_PLAYERSTATS_RESP_STATS = -11; my $STATS_ALL_PLAYERS = -1; my $RELOAD = 10; my $TIMEOUT = 2; # subroutines sub parse_teamstats($$) { my ($info, $data) = @_; my $err = parse_extcmd($data); return $err if $err; foreach (qw(teammode gamemode secremain)) { $info->{$_} = getint($data); } return "invalid teamstats reply" if !defined $info->{secremain}; $info->{teammode} = !$info->{teammode}; $info->{teams} = {}; return if !$info->{teammode}; while ($$data) { my $team; ($team, $$data) = split(/\0/, $$data, 2); return "invalid teamstats reply" if !defined $team; $info->{teams}->{$team}->{name} = $team; $info->{teams}->{$team}->{score} = getint($data); my $numbases = getint($data); return "invalid teamstats reply" if !defined $numbases; $info->{teams}->{$team}->{bases} = []; for (my $i = 0; $i < $numbases; $i++) { my $base = getint($data); return "invalid teambases reply" if !defined $base; push @{$info->{teams}->{$team}->{bases}}, $base; } } } sub parse_playerinfo($$) { my ($info, $data) = @_; my $err = parse_extcmd($data); return $err if $err; return "server indicated error" if (getint($data) != $EXT_NO_ERROR); return "invalid playerinfo reply" if (getint($data) != $EXT_PLAYERSTATS_RESP_STATS); my $clientnum = getint($data); return "nonexisting clientnum" if !exists $info->{clients}->{$clientnum}; $info->{clients}->{$clientnum}->{ping} = getint($data); ($info->{clients}->{$clientnum}->{name}, $info->{clients}->{$clientnum}->{team}, $$data) = split(/\0/, $$data, 3); foreach (qw(frags flags deaths teamkills damage health armour gunselect privilege state)) { $info->{clients}->{$clientnum}->{$_} = getint($data); } return "invalid playerinfo reply" if (length($$data) != 3); return "invalid player state" if (($info->{clients}->{$clientnum}->{state} < 0) || ($info->{clients}->{$clientnum}->{state} > $#STATES)); return "invalid player privilege" if (($info->{clients}->{$clientnum}->{privilege} < 0) || ($info->{clients}->{$clientnum}->{privilege} > $#PRIVILEGES)); return "invalid player gun" if (($info->{clients}->{$clientnum}->{gunselect} < 0) || ($info->{clients}->{$clientnum}->{gunselect} > $#GUNS)); $info->{clients}->{$clientnum}->{ip} = join("", map { "$_." } unpack("C*", $$data)) . "x"; return; } sub parse_playerstats($$) { my ($info, $data) = @_; my $err = parse_extcmd($data); return $err if $err; return "server indicated error" if (getint($data) != $EXT_NO_ERROR); return "invalid playerstats reply" if (getint($data) != $EXT_PLAYERSTATS_RESP_IDS); $info->{clients} = {}; while (defined (my $clientnum = getint($data))) { $info->{clients}->{$clientnum} = {}; } return "number of clients mismatch" if ($info->{numclients} != keys %{$info->{clients}}); return; } sub parse_uptime($$) { my ($info, $data) = @_; my $err = parse_extcmd($data); return $err if $err; $info->{uptime} = getint($data); return "invalid uptime reply" if !defined $info->{uptime}; return; } sub parse_extcmd($) { my $data = shift; return "server indicated error" if (getint($data) != $EXT_ACK); return "invalid extcmd reply" if !defined getint($data); return; } sub parse_serverinfo($$) { my ($info, $data) = @_; foreach (qw(numclients numattrs protover gamemode secremain maxclients protomode)) { $info->{$_} = getint($data); } ($info->{mapname}, $info->{serverdesc}) = split(/\0/, $$data); return "invalid serverinfo reply" if (!defined $info->{serverdesc} || ($info->{numattrs} != 5)); return "invalid gamemode" if (($info->{gamemode} < $STARTGAMEMODE) || ($info->{gamemode} > $STARTGAMEMODE + $#GAMEMODES)); return "invalid protection mode" if (($info->{protomode} < $STARTPROTOMODE) || ($info->{protomode} > $STARTPROTOMODE + $#PROTOMODES)); return; } sub gameserver_info($$) { my ($server, $info) = @_; my $socket = IO::Socket::INET->new(PeerAddr => $info->{address}, PeerPort => $info->{port} + $SERVERINFOPORTOFFSET, Proto => "udp"); return $! if !$socket; # get overall serverinfo my $data; my $err = docmd(\$data, $server, $socket, $CMD_INFO); if ($err) { close($socket); return $err; } $err = parse_serverinfo($info, \$data); if ($err) { close($socket); return $err; } # get uptime $err = docmd(\$data, $server, $socket, $CMD_EXT, $EXT_UPTIME); if ($err) { close($socket); return $err; } $err = parse_uptime($info, \$data); if ($err) { close($socket); return $err; } # get info about each client my $cmd_and_cookie = sendcmd($socket, $CMD_EXT, $EXT_PLAYERSTATS, $STATS_ALL_PLAYERS); $err = recvcmd(\$data, $server, $socket, $cmd_and_cookie); if ($err) { close($socket); return $err; } $err = parse_playerstats($info, \$data); if ($err) { close($socket); return $err; } foreach (keys %{$info->{clients}}) { $err = recvcmd(\$data, $server, $socket, $cmd_and_cookie); if ($err) { close($socket); return $err; } $err = parse_playerinfo($info, \$data); if ($err) { close($socket); return $err; } } # get info about teams $err = docmd(\$data, $server, $socket, $CMD_EXT, $EXT_TEAMSCORE); if ($err) { close($socket); return $err; } $err = parse_teamstats($info, \$data); if ($err) { close($socket); return $err; } close($socket); return; } sub sendcmd($@) { my ($socket, @cmd) = @_; my $cookie = int(rand(time())); my $cmd_and_cookie = ""; foreach (@cmd) { $cmd_and_cookie .= putint($_); } $cmd_and_cookie .= putint($cookie); print $socket $cmd_and_cookie; return $cmd_and_cookie; } sub wait_for_data($$) { my ($socket, $timeout) = @_; my $rin = ""; vec($rin, fileno($socket), 1) = 1; return select($rin, undef, undef, $timeout); } sub recvcmd($$$$) { my ($data, $server, $socket, $cookie_and_cmd) = @_; my $err = wait_for_data($socket, $TIMEOUT); return $! if ($err < 0); return "timeout" if !$err; my $sender = recv($socket, $$data, 8192, 0); return $! if !$sender; return "udp header too small" if (length($sender) < 8); my @octets = unpack("C*", $sender); my $saddress = join(".", (@octets)[4..7]); my $sport = $octets[2] * 256 + $octets[3] - $SERVERINFOPORTOFFSET; my $sserver = "$saddress:$sport"; return "forgery from $sserver" if ($sserver ne $server); my $scookie_and_cmd = substr($$data, 0, length($cookie_and_cmd)); return "cookie mismatch" if ($scookie_and_cmd ne $cookie_and_cmd); $$data = substr($$data, length($cookie_and_cmd)); return; } sub docmd($$$@) { my ($data, $server, $socket, @cmd) = @_; my $cmd_and_cookie = sendcmd($socket, @cmd); return recvcmd($data, $server, $socket, $cmd_and_cookie); } sub putint($) { my $int = shift; if (($int < 128) && ($int > - 127)) { return pack("c", $int); } elsif (($int < 0x8000) && ($int >= -0x8000)) { return pack("c", -128) . pack("s", $int); } else { return pack("c", -127) . pack("i", $int); } } sub getint($) { my $buf = shift; return if (length($$buf) < 1); my $int = unpack("c", substr($$buf, 0, 1)); $$buf = substr($$buf, 1); if ($int == -127) { return if (length($$buf) < 4); $int = unpack("i", substr($$buf, 0, 4)); $$buf = substr($$buf, 4); } elsif ($int == -128) { return if (length($$buf) < 2); $int = unpack("s", substr($$buf, 0, 2)); $$buf = substr($$buf, 2); } return $int; } sub print_teaminfos($) { my $teams = shift; my $buf = <Teams EOF my $zeile = 0; foreach my $team(sort { $teams->{$b}->{score} <=> $teams->{$a}->{score} || $teams->{$a}->{name} cmp $teams->{$b}->{name} } keys %$teams) { $buf .= print_teaminfo($teams->{$team}, $zeile); $zeile = 1 - $zeile; } $buf .= "
Name Score Captured bases
\n"; return $buf; } sub print_teaminfo($$) { my ($team, $zeile) = @_; return "\n" . "" . tohtml($team->{name}) . "\n" . "" . tohtml($team->{score}) . "\n" . "" . join(", ", @{$team->{bases}}) . "\n" . "\n"; } sub print_clientinfos($) { my $clients = shift; my $buf = <Players EOF my $zeile = 0; foreach my $client(sort { $clients->{$b}->{frags} <=> $clients->{$a}->{frags} || $clients->{$a}->{name} cmp $clients->{$b}->{name} } keys %$clients) { $buf .= print_clientinfo($clients->{$client}, $zeile); $zeile = 1 - $zeile; } $buf .= "
Name Team Frags Deaths Teamkills Damage Health Armour Gun IP Ping State Privilege
\n"; return $buf; } sub print_clientinfo($$) { my ($client, $zeile) = @_; return "\n" . "" . tohtml($client->{name}) . "\n" . "" . tohtml($client->{team}) . "\n" . "" . tohtml($client->{frags}) . "\n" . "" . tohtml($client->{deaths}) . "\n" . "" . tohtml($client->{teamkills}) . "\n" . "" . tohtml($client->{damage}) . "\n" . "" . tohtml($client->{health}) . "\n" . "" . tohtml($client->{armour}) . "\n" . "" . $GUNS[$client->{gunselect}] . "\n" . "" . tohtml($client->{ip}) . "\n" . "" . tohtml($client->{ping}) . "ms\n" . "" . $STATES[$client->{state}] . "\n" . "" . $PRIVILEGES[$client->{privilege}] . "\n" . "\n"; } sub print_serverinfo($) { my $info = shift; my $uptime = $info->{uptime}; my $sec = $uptime % 60; $uptime /= 60; my $min = $uptime % 60; $uptime /= 60; my $hour = $uptime % 24; $uptime /= 24; my $days = int($uptime); foreach ($sec, $min, $hour) { $_ = sprintf("%02d", $_); } $uptime = ""; if ($days) { $uptime .= "${days} day"; $uptime .= "s" if ($days > 1); $uptime .= ", "; } $uptime .= "$hour:$min:$sec"; return "{name}\">\n" . "

" . tohtml($info->{serverdesc}) . "

\n" . "

Info

\n" . "\n" . "\n" . "\n" . "\n" . "\n" . "\n" . "\n" . "\n" . "\n" . "\n" . "\n" . "\n" . "\n" . "\n" . "\n" . "\n" . "\n" . "\n" . "\n" . "\n" . "\n" . "\n" . "\n" . "\n" . "\n" . "\n" . "\n" . "\n" . "\n" . "\n" . "\n" . "\n" . "
Address:$info->{name}
Gamemode:" . $GAMEMODES[$info->{gamemode} - $STARTGAMEMODE] . "" . gamemode_seealso($info->{gamemode}) . "
Teammode:" . ($info->{teammode} ? "yes" : "no") . "
#Clients:$info->{numclients}/" . "$info->{maxclients}
Map:" . tohtml($info->{mapname}) . "
Protection:$PROTOMODES[$info->{protomode} - $STARTPROTOMODE]" . "
Time remaining:$info->{secremain} seconds
Uptime:$uptime
\n"; } sub gamemode_seealso($) { my $gamemode = shift; return " (
see also)" if ($gamemode > 8); return " (see also)" if ($gamemode < -1); return " (see also)" if ($gamemode == -1); return ""; } sub tohtml($) { my $str = shift; $str =~ s/\/>/g; return $str; } sub savehtml($$$) { my ($servers, $masterserver, $htmlfile) = @_; my $tmpfile = "$htmlfile.$$"; return "$tmpfile: $!" if !open(FH, ">$tmpfile"); my $title = "Sauerbraten status on $masterserver"; print FH < $title

$title

EOF my @servers = sort { $servers->{$a}->{serverdesc} cmp $servers->{$b}->{serverdesc} } keys %$servers; print FH join(" ", map { "

" . tohtml($servers->{$_}->{serverdesc}) . "

\n" } @servers); print FH "
\n"; foreach my $server(@servers) { my $info = $servers->{$server}; print FH print_serverinfo($info); my $clients = $info->{clients}; print FH print_clientinfos($clients) if %$clients; my $teams = $info->{teams}; print FH print_teaminfos($teams) if %$teams; print FH "
\n"; } my ($sec, $min, $hour, $day, $mon, $year) = localtime(); $mon++; $year += 1900; foreach ($sec, $min, $hour, $day, $mon) { $_ = sprintf("%02d", $_); } print FH <Generated: $year/$mon/$day $hour:$min:$sec by Bandnudel V$VERSION (http://ogris.de/bandnudel/) EOF close(FH); die "cannot rename $tmpfile to $htmlfile: $!" if !rename($tmpfile, $htmlfile); } ### MAIN ### # flush streams after each print $| = 1; # evaluate commandline options my ($masterserver, $htmlfile) = @ARGV; die "usage: bandnudel.pl \n" if !$htmlfile; # main loop for (;;) { sleep($RELOAD); # get gameserver list from masterserver my $mastersocket = IO::Socket::INET->new(PeerAddr => $masterserver, PeerPort => 28787, Proto => "tcp"); if (!$mastersocket) { warn "$masterserver: $!"; next; } my %servers = (); print $mastersocket "list\n"; my $err = wait_for_data($mastersocket, $TIMEOUT); if ($err <= 0) { warn "$masterserver: " . ($err < 0 ? $! : "timeout"); close($mastersocket); next; } while (<$mastersocket>) { $servers{"$1:$2"} = { address => $1, port => $2, name => "$1:$2", } if /^addserver ([^ ]+) (\d+)$/; } close($mastersocket); # get info from each gameserver my @servers = keys %servers; foreach my $server(@servers) { my $err = gameserver_info($server, $servers{$server}); if ($err) { warn "$server: $err"; delete $servers{$server}; } } savehtml(\%servers, $masterserver, $htmlfile); }