#!/usr/bin/perl -w

# modules
use strict;
use warnings;
use IO::Socket;

# constants
our $SERVERINFOPORTOFFSET = 1;
our $STARTGAMEMODE = -3;
our @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",
);
our $STARTPROTOMODE = -1;
our @PROTOMODES = (
	"auth",
	"open",
	"veto",
	"locked",
	"private",
	"password",
);
our @STATES = (
	"alive",
	"dead",
	"spawning",
	"lagged",
	"editing",
	"spectator",
);
our @PRIVILEGES = (
	"none",
	"master",
	"admin",
);
our @GUNS = (
	"Chainsaw",
	"Shotgun",
	"Chaingun",
	"Rocketlauncher",
	"Rifle",
	"Grenadelauncher",
	"Pistol",
);
our $EXT_ACK = -1;
our $EXT_NO_ERROR = 0;
our $CMD_INFO = 1;
our $CMD_EXT = 0;
our $EXT_UPTIME = 0;
our $EXT_PLAYERSTATS = 1;
our $EXT_TEAMSCORE = 2;
our $EXT_PLAYERSTATS_RESP_IDS = -10;
our $EXT_PLAYERSTATS_RESP_STATS = -11;
our $STATS_ALL_PLAYERS = -1;
our $RELOAD = 10;
our $TIMEOUT = 2;

# flush streams after each print
$| = 1;

# evaluate commandline options
my ($masterserver, $htmlfile) = @ARGV;
die "usage: bandnudel.pl <masterserver[:masterport]> <htmlfile>\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 }
			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);
}


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;
		}
	}

	close($socket);

	return;
}

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 server 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 server 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 server 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 server 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 minremain maxclients
			protomode)) {
		$info->{$_} = &getint($data);
	}
	($info->{mapname}, $info->{serverdesc}) = split(/\0/, $$data);

	return "invalid server info 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 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 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 wait_for_data() {
	my ($socket, $timeout) = @_;
	my $rin = "";
	vec($rin, fileno($socket), 1) = 1;
	return select($rin, undef, undef, $timeout);
}

sub savehtml() {
	my $servers = shift;

	my $tmpfile = "$htmlfile.$$";
	return "$tmpfile: $!" if !open(FH, ">$tmpfile");

	print FH <<EOF;
<html>
<head>
<meta http-equiv="Refresh" content="$RELOAD">
<title>Bandnudel: Sauerbraten status</title>
<style type="text/css">
<!--
body {
	background-color:white;
	color:black;
	font-family:Arial, sans-serif;
	font-size:12px;
}
table {
	background-color:orange;
	border:0px solid transparent;
	border-spacing:2px;
}
th {
	background-color:#777;
	color:white;
	font-size:10px;
}
td {
	padding:2px;
	font-size:12px;
	background-color:white;
}
td.zeile0 {
	background-color:#CCC;
}
td.zeile1 {
	background-color:#EEE;
}
h1 {
	font-size:16px;
}
h2 {
	font-size:14px;
}
hr {
	border:1px dashed gray;
}
#navig {
	position:absolute;
	top:10px;
	right:10px;
	background-color:#FFE;
	border:1px dotted gray;
	padding:5px;
}
#navig p {
	padding:0px;
	margin:0px;
}
-->
</style>
</head>
<body>
<h1>Sauerbraten status</h1>
<span id="navig">
EOF
	my @servers = sort {
		$servers->{$a}->{serverdesc} cmp $servers->{$b}->{serverdesc}
	} keys %$servers;
	print FH join(" ", map {
		"<p><a href=\"#$_\">" .
		&tohtml($servers->{$_}->{serverdesc}) . "</a></p>\n"
	} @servers);
	print FH "</span>\n";

	foreach my $server(@servers) {
		my $info = $servers->{$server};
		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";
		print FH "<a name=\"$server\"><h2>",
			&tohtml($info->{serverdesc}), "</h2>\n<table>\n",
			"<tr><td>Address:</td><td>$server</td></tr>\n",
			"<tr><td>Gamemode:</td><td><a href=\"http://" .
			"sauerbraten.org/docs/game.html#mode\" ",
			"target=\"_new\">",
			$GAMEMODES[$info->{gamemode} - $STARTGAMEMODE],
			"</a>", &gamemode_seealso($info->{gamemode}),
			"</td></tr>\n",
			"<tr><td>#Clients:</td><td>$info->{numclients}/",
			"$info->{maxclients}</td></tr>\n",
			"<tr><td>Map:</td><td>", &tohtml($info->{mapname}),
			"</td></tr>\n",
			"<tr><td>Protection:</td><td>",
			$PROTOMODES[$info->{protomode} - $STARTPROTOMODE],
			"</td></tr>\n",
			"<tr><td>Time remaining:</td><td>$info->{minremain} ",
			"minutes</td></tr>\n",
			"<tr><td>Uptime:</td><td>$uptime</td></tr>\n",
			"</table><br><table><tr>\n",
			"<th>Name</th><th>Team</th><th>Frags</th>",
			"<th>Deaths</th><th>Teamkills</th><th>Damage</th>",
			"<th>Health</th><th>Armour</th><th>Gun</th>",
			"<th>IP</th><th>Ping</th><th>State</th>",
			"<th>Privilege</th></tr>\n";

		my $zeile = 0;
		my $clients = $info->{clients};
		foreach my $client(sort {
			$clients->{$b}->{frags} <=> $clients->{$a}->{frags} ||
			$clients->{$a}->{name} cmp $clients->{$b}->{name} 
		} keys %$clients) {
			print FH "<tr>\n",
				"<td class=\"zeile$zeile\">",
				&tohtml($clients->{$client}->{name}),
				"</td>\n",
				"<td class=\"zeile$zeile\">",
				&tohtml($clients->{$client}->{team}),
				"</td>\n",
				"<td class=\"zeile$zeile\">",
				&tohtml($clients->{$client}->{frags}),
				"</td>\n",
				"<td class=\"zeile$zeile\">",
				&tohtml($clients->{$client}->{deaths}),
				"</td>\n",
				"<td class=\"zeile$zeile\">",
				&tohtml($clients->{$client}->{teamkills}),
				"</td>\n",
				"<td class=\"zeile$zeile\">",
				&tohtml($clients->{$client}->{damage}),
				"</td>\n",
				"<td class=\"zeile$zeile\">",
				&tohtml($clients->{$client}->{health}),
				"</td>\n",
				"<td class=\"zeile$zeile\">",
				&tohtml($clients->{$client}->{armour}),
				"</td>\n",
				"<td class=\"zeile$zeile\">",
				$GUNS[$clients->{$client}->{gunselect}],
				"</td>\n",
				"<td class=\"zeile$zeile\">",
				&tohtml($clients->{$client}->{ip}),
				"</td>\n",
				"<td class=\"zeile$zeile\">",
				&tohtml($clients->{$client}->{ping}),
				"ms</td>\n",
				"<td class=\"zeile$zeile\">",
				$STATES[$clients->{$client}->{state}],
				"</td>\n",
				"<td class=\"zeile$zeile\">",
				$PRIVILEGES[$clients->{$client}->{privilege}],
				"</td>\n",
				"</tr>\n";
			$zeile = 1 - $zeile;
		}
		print FH "</table>\n<hr>\n";
	}

	my ($sec, $min, $hour, $day, $mon, $year) = localtime();
	$mon++;
	$year += 1900;
	foreach ($sec, $min, $hour, $day, $mon) {
		$_ = sprintf("%02d", $_);
	}
	print FH "<tt>Generated: $year/$mon/$day $hour:$min:$sec</tt>\n",
		"</body>\n</html>\n";
	close(FH);
	die "cannot rename $tmpfile to $htmlfile: $!"
			if !rename($tmpfile, $htmlfile);
}

sub tohtml() {
	my $str = shift;
	$str =~ s/\</&lt;/g;
	$str =~ s/\>/&gt;/g;
	return $str;
}

sub gamemode_seealso() {
	my $gamemode = shift;

	return " (<a href=\"http://sauerbraten.org/docs/game.html" .
		"#capture\" target=\"_new\">see also</a>)"
		if ($gamemode > 8);
	return " (<a href=\"http://sauerbraten.org/docs/game.html" .
		"#singleplayer_modes\" target=\"_new\">see also</a>)"
		if ($gamemode < -1);
	return " (<a href=\"http://sauerbraten.org/docs/game.html" .
		"#demo_recording\" target=\"_new\">see also</a>)"
		if ($gamemode == -1);

	return "";
}