#!/usr/bin/perl -w

use strict;
use warnings;

=begin
CREATE TABLE gameservers (
	id BIGINT UNSIGNED NOT NULL AUTO_INCREMENT,
	address VARCHAR(64) NOT NULL,
	port INTEGER UNSIGNED NOT NULL,
	checked BIGINT UNSIGNED NOT NULL,
	PRIMARY KEY (id),
	UNIQUE INDEX idx_gameservers_address_port (address, port)
) ENGINE=InnoDB;
=cut

our $bandnudel;
my $mode = $ARGV[0];
if (($#ARGV < 0) || ($#ARGV > 1)) {
	&show_usage();
} elsif ($mode eq "master") {
	$bandnudel = Bandnudel::Master->new();
} elsif ($mode eq "check") {
	$bandnudel = Bandnudel::Check->new();
} elsif ($mode eq "game") {
	$bandnudel = Bandnudel::Game->new();
} else {
	&show_usage();
}
$bandnudel->run();

sub show_usage() {
	die <<EOF
usage: bandnudel.pl master
       bandnudel.pl game
       bandnudel.pl check [<address>]

    w/o parameter a Sauerbraten master server will be started
    if an address wildcard (SQL syntax like '192.160.%') is given,
    all servers matching that wildcard will be checked

EOF
}


package Bandnudel;

use strict;
use warnings;
use POSIX;
use Sys::Syslog qw(syslog);
use Socket;
use IO::Socket;
use DBI;

sub new() {
	my $type = shift;
	my $self = {};

	$self->{pidfiledir} = "/var/run";
	$self->{sauerserver} = "/usr/local/libexec/sauer_server";
	$self->{statuspage} = "/usr/local/www/apache22/data/index.html";
	$self->{logfile} = "/tmp/sauer.log";
	$self->{"listen"} = "0.0.0.0:28787";
	$self->{facility} = "LOG_LOCAL4";
	$self->{dsn} = "DBI:mysql:mysql_sock=/tmp/mysql.sock;" .
			"database=bandnudel";
	$self->{dbuser} = "bandnudel";
	$self->{dbpass} = "bandnudel";
	$self->{check_timeout} = 300;
	$self->{udp_timeout} = 5;
	$self->{childs} = {};

	foreach (keys %SIG) {
		$SIG{$_} = "IGNORE";
	}
	$SIG{CHLD} = sub {
		local $!;
		while ((my $pid = waitpid(-1, WNOHANG)) > 0) {
			delete $bandnudel->{childs}->{$pid};
		}
	};
	$SIG{HUP} = sub {
		syslog("LOG_INFO", "SIGHUP received, restarting...");
	};
	$SIG{TERM} = "DEFAULT";

	bless($self, $type);
}

sub lookup_user_and_fork() {
	my $self = shift;

	my @user = getpwnam($self->{user});
	die "no such user: $self->{user}" if !@user;

	$self->{uid} = $user[2];
	$self->{homedir} = $user[7];

	if ($self->{group}) {
		my @group = getgrnam($self->{group});
		die "no such group: $self->{group}" if !@group;
		$self->{gid} = $group[2];
	} else {
		$self->{gid} = $user[3];
	}

	my $pid = fork();
	die "fork(): $!" if ($pid < 0);
	exit(0) if ($pid > 0);
}

sub become_daemon() {
	my $self = shift;

	setsid() || die "setsid(): $!";
	die "cannot write pidfile $self->{pidfile}: $!"
		if !open(FH, ">$self->{pidfile}");
	print FH $$;
	close(FH);

	setgid($self->{gid}) || die "setgid(): $!";
	setuid($self->{uid}) || die "setuid(): $!";
	chdir("/") || die "chdir(): $!";
	close(STDIN);
	close(STDOUT);
	open(STDOUT, ">>/dev/null") || die "cannot redirect stdout: $!";
	$self->openlog();
	close(STDERR);
	open(STDERR, ">>/dev/null") ||
		$self->log_and_die("cannot redirect stderr", $!);

	$SIG{TERM} = sub {
		local $!;
		syslog("LOG_INFO", "SIGTERM received, going down...\n");
		$bandnudel->{running} = 0;
	};
}

sub main_loop() {
	my $self = shift;

	syslog("LOG_INFO", "starting...\n");

	for ($self->{running} = 1; $self->{running}; ) {
		$self->main();
	}
}

sub cleanup() {
	my $self = shift;

	unlink($self->{pidfile});
	if (%{$self->{childs}}) {
		kill(15, keys %{$self->{childs}});
		$self->wait_for_children();
	}
	syslog("LOG_INFO", "exiting...\n");
}

sub list_gameservers() {
	my $self = shift;
	print {$self->{client}} map { "addserver $_->{address} $_->{port}\n" }
			@{$self->load_gameservers()};
}

sub register_gameserver() {
	my ($self, $gameserver) = @_;
	my $err;
	for (my $i = 0; $i < 10; $i++) {
		$err = $self->check_gameserver($gameserver);
		last if !$err;
		sleep(3);
	}
	if ($err) {
		print {$self->{client}} "failreg $err\n";
	} else {
		print {$self->{client}} "succreg\n";
	}
}

sub check_gameservers() {
	my $self = shift;
	my $gameservers = $self->load_gameservers();
	foreach my $gameserver(@$gameservers) {
		next if ($gameserver->{checked} + $self->{check_timeout} >
				time());
		next if $self->fork_or_die();
		$0 = "bandnudel: check $gameserver->{address}:" .
				$gameserver->{port};
		$self->close_server_and_reset_signals();
		$self->check_gameserver($gameserver);
		exit(0);
	}
}

sub check_gameserver() {
	my ($self, $gameserver) = @_;
	my $addr = "$gameserver->{address}:" . ($gameserver->{port} + 1);

	my $udp = IO::Socket::INET->new(PeerAddr => $addr, Proto => "udp");
	my $err;
	$err = "cannot create udp socket for $addr: $!" if !$udp;
	if (!$err) {
		local $| = 1;
		print $udp chr(1);
		my $nfound = $self->wait_for_data($udp, $self->{udp_timeout});
		$err = "$addr is not alive" if ($nfound <= 0);
	}
	my $sender;
	if (!$err) {
		my $msg;
		$sender = recv($udp, $msg, 1, 0);
	}
	close($udp) if $udp;
	if (!$sender) {
		$err = "$addr: $!";
	} elsif (length($sender) < 8) {
		$err = "udp header from $addr too short: need 8 bytes, got " .
				length($sender);
	} else {
		my @octets = unpack("C*", $sender);
		my $saddress = join(".", (@octets)[4..7]);
		my $sport = $octets[2] * 256 + $octets[3];
		$err = "forgery from $saddress:$sport for $addr"
			if (($gameserver->{address} ne $saddress) ||
					($gameserver->{port} + 1 != $sport));
	}
	if ($err) {
		syslog("LOG_WARNING", "$err\n");
		$self->delete_gameserver($gameserver);
		return $err;
	}
	
	$self->save_gameserver($gameserver);
	syslog("LOG_INFO", "$addr is alive\n");
	return "";
}

sub load_gameservers() {
	my $self = shift;
	$self->connect_database();
	my $sql = "SELECT address, port, checked FROM gameservers";
	my $err = "db select failed: $sql";
	if (@_) {
		$sql .= " WHERE address LIKE ?";
		$err .= " (" . join(", ", @_) . ")";
	}
	my $sth = $self->do_database_or_die($sql, @_);
	my $gameservers = $sth->fetchall_arrayref({});
	$self->log_and_die($err, $sth->errstr) if $sth->err;
	$sth->finish();
	$self->disconnect_database();
	return $gameservers;
}

sub delete_gameserver() {
	my ($self, $gameserver) = @_;
	$self->connect_database();
	$self->do_database_or_die("DELETE FROM gameservers " .
			"WHERE address=? AND port=?", $gameserver->{address},
			$gameserver->{port})->finish();
	$self->disconnect_database();
}

sub save_gameserver() {
	my ($self, $gameserver) = @_;
	$self->connect_database();
	my $sth = $self->prepare_database("INSERT INTO gameservers " .
			"(address, port, checked) VALUES (?, ?, 0)");
	$sth->execute($gameserver->{address}, $gameserver->{port});
	$sth->finish();
	$self->do_database_or_die("UPDATE gameservers SET checked=? " .
			"WHERE address=? AND port=?", time(),
			$gameserver->{address},
			$gameserver->{port})->finish();
	$self->disconnect_database();
}

sub connect_database() {
	my $self = shift;
	$self->{dbh} = DBI->connect($self->{dsn}, $self->{dbuser},
			$self->{dbpass},
			{ RaiseError => 0, PrintError => 0, PrintWarn => 0 });
	$self->log_and_die("cannot connect to database", $DBI::errstr)	
		if !$self->{dbh};
}

sub prepare_database() {
	my ($self, $sql) = @_;
	my $sth = $self->{dbh}->prepare($sql);
	$self->log_and_die("db prepare failed: $sql", $self->{dbh}->errstr)
		if $self->{dbh}->err;
	return $sth;
}

sub do_database_or_die() {
	my $self = shift;
	my $sql = shift;
	my $err = "db execute failed: $sql";
	$err .= " (" . join(", ", @_) . ")" if @_;
	my $sth = $self->prepare_database($sql);
	$sth->execute(@_);
	$self->log_and_die($err, $self->{dbh}->errstr)
		if $self->{dbh}->err;
	return $sth;
}

sub disconnect_database() {
	my $self = shift;
	if ($self->{dbh}) {
		$self->{dbh}->disconnect();
		$self->{dbh} = undef;
	}
}

sub log_and_die() {
	my $self = shift;
	$self->disconnect_database();
	$self->close_socket("client");
	$self->close_socket("server");
	syslog("LOG_WARNING", join(": ", @_) . "\n");
	exit(-1);
}

sub close_socket() {
	my ($self, $socket) = @_;
	if ($self->{$socket}) {
		close($self->{$socket});
		$self->{$socket} = undef;
	}
}

sub close_server_and_reset_signals() {
	my $self = shift;
	$self->close_socket("server");
	$SIG{TERM} = "DEFAULT";
	$SIG{CHLD} = "DEFAULT";
}

sub fork_or_die() {
	my $self = shift;
	my $pid = fork();
	$self->log_and_die("fork()", $!) if ($pid < 0);
	$self->{childs}->{$pid} = time() if ($pid > 0);
	return $pid;
}

sub wait_for_data() {
	my ($self, $socket, $timeout) = @_;
	my $start = time();
	while ($timeout > 0) {
		my $rin = "";
		vec($rin, fileno($socket), 1) = 1;
		my $nfound = select($rin, undef, undef, $timeout);
		return $nfound if ($nfound >= 0);
		$self->log_and_die("select()", $!) if ($! != EINTR);
		return 0 if !$self->{running};
		my $now = time();
		$timeout -= $now - $start;
		$start = $now;
	}
}

sub wait_for_children() {
	my $self = shift;
	for (my $i = 0; %{$self->{childs}} && ($i < 3); $i++) {
		sleep(1);
	}
	for (my $i = 0; %{$self->{childs}} && ($i < 30); $i++) {
		$self->log_pids("waiting for");
		sleep(2);
	}
	if (%{$self->{childs}}) {
		$self->log_pids("killing");
		kill(9, keys %{$self->{childs}});
	}
}

sub log_pids() {
	my ($self, $prefix) = @_;

	my @childs = keys %{$self->{childs}};
	syslog("LOG_INFO", "$prefix pid" . ($#childs ? "s" : "") .
			join(",", map { " $_" } sort { $a <=> $b }
			@childs) . "\n");
}

sub set_ident() {
	my ($self, $ident) = @_;

	$self->{ident} = "bandnudel: $ident";
	$self->{pidfile} = "$self->{pidfiledir}/bandnudel-$ident.pid";
	$0 = $self->{ident};
}

sub openlog() {
	my $self = shift;
	Sys::Syslog::openlog($self->{ident}, "pid", "LOG_LOCAL4");
}

sub format_date() {
	my ($self, $time) = @_;
	my ($sec, $min, $hour, $day, $mon, $year, @rest) = localtime($time);
	$mon++;
	$year += 1900;
	foreach ($sec, $min, $hour, $day, $mon) {
		$_ = sprintf("%02d", $_);
	}
	return "$year/$mon/$day $hour:$min:$sec";
}

sub format_time() {
	my ($self, $time) = @_;
	my $sec = $time % 60;
	$time /= 60;
	my $min = $time % 60;
	$time /= 60;
	my $hour = $time;
	foreach ($sec, $min, $hour) {
		$_ = sprintf("%02d", $_);
	}
	return "$hour:$min:$sec";
}

package Bandnudel::Master;

use strict;
use warnings;
use Sys::Syslog qw(syslog);
use POSIX;
use base qw(Bandnudel);

sub new() {
	my $type = shift;
	my $self = $type->SUPER::new();

	$self->{user} = "nobody";
	$self->{group} = undef;

	bless($self, $type);
}

sub run() {
	my $self = shift;

	$self->lookup_user_and_fork();
	$self->set_ident("master");
	$self->openlog();
	$self->{server} = IO::Socket::INET->new(
			LocalAddr => $self->{"listen"},
			Listen => 32,
			Proto => "tcp") ||
		die "cannot create listen socket $self->{'listen'}: $!";
	$self->become_daemon();
	$self->main_loop();
	$self->close_socket("server");
	$self->cleanup();
}

sub main() {
	my $self = shift;

	$self->check_gameservers();
	return if !$self->wait_for_data($self->{server}, 60);

	$self->{client} = $self->{server}->accept();
	if (!$self->{client}) {
		return if ($! == EINTR);
		$self->log_and_die("accept()", $!);
	}

	my $pid = $self->fork_or_die();
	if ($pid > 0) {
		close($self->{client});
		return;
	}

	my $peerhost = $self->{client}->peerhost();
	$self->set_ident("serve $peerhost");
	$self->close_server_and_reset_signals();

	my $client = $self->{client};
	my $cmd = <$client>;
	$cmd =~ s/\r?\n$//;

	if ($cmd eq "list") {
		syslog("LOG_INFO", "$peerhost list\n");
		$self->list_gameservers();
	} elsif ($cmd =~ /^regserv (\d{1,5})$/) {
		my $peerport = $1;
		syslog("LOG_INFO", "$peerhost regserv $peerport\n");
		$self->register_gameserver({ address => $peerhost,
				port => $peerport, checked => 0 });
	} else {
		$cmd =~ s/[^\w\t \(\)\[\]\@\&\%\$\"!=\?\+\*#\-\.:,;\<\>]/_/g;
		syslog("LOG_WARNING", "$peerhost unknown command '$cmd'\n");
	}

	close($self->{client});
	exit(0);
}


package Bandnudel::Check;

use strict;
use warnings;
use base qw(Bandnudel);

sub run() {
	my $self = shift;
	$self->set_ident("check");
	$self->openlog();
	my $gameservers = $self->load_gameservers(@_);
	foreach my $gameserver(@$gameservers) {
		next if $self->fork_or_die();
		$self->set_ident("check $gameserver->{address}:" .
				$gameserver->{port});
		$self->check_gameserver($gameserver);
		exit(0);
	}
	$self->wait_for_children();
}


package Bandnudel::Game;

use strict;
use warnings;
use Sys::Syslog qw(syslog);
use POSIX;
use base qw(Bandnudel);

sub new() {
	my $type = shift;
	my $self = $type->SUPER::new();

	$self->{user} = "sauer";
	$self->{group} = undef;

	$self->{statfields} = [
		[ "name",		"Player", ],
		[ "frags",		"Frags", ],
		[ "hostname",		"Host", ],
		[ "team",		"Team", ],
		[ "playermodel",	"Model", ],
		[ "clientmap",		"Map", ],
		[ "deaths",	 	"Deaths", ],
		[ "shotdamage",		"Shotdamage", ],
		[ "damage",		"Damage", ],
		[ "health",		"Health", ],
		[ "maxhealth",		"Max. health", ],
		[ "armour",		"Armour", ],
		[ "armourtype",		"Armourtype", ],
	];
	bless($self, $type);
}

sub run() {
	my $self = shift;

	$self->lookup_user_and_fork();
	$self->set_ident("game");
	$self->openlog();
	$self->become_daemon();
	$self->{configdir} = $self->{homedir};
	$self->main_loop();
	$self->cleanup();
}

sub main() {
	my $self = shift;

	$self->log_and_die("pipe()", $!) if !pipe(STDOUTRD, STDOUTWR);
	my $pid = $self->fork_or_die();
	if (!$pid) {
		close(STDOUTRD);
		close(STDOUT);
		close(STDERR);
		$self->log_and_die("dup()", $!)
			if !open(STDOUT, ">&", \*STDOUTWR);
		$self->log_and_die("dup()", $!)
			if !open(STDERR, ">&", \*STDOUTWR);
		$self->log_and_die($self->{configdir})
			if !chdir($self->{configdir});
		$self->log_and_die($self->{sauerserver}, $!)
			if !exec($self->{sauerserver});
	}
	close(STDOUTWR);
	my $logfh;
	if (!open($logfh, ">>$self->{logfile}")) {
		syslog("LOG_WARNING", "$self->{logfile}: $!\n");
		$logfh = undef;
	}
	$self->{numclients} = 0;
	$self->{clients} = {};
	$self->{start} = time();
	$self->{max_ammo} = 0;
	syslog("LOG_INFO", "started sauer_server (pid=$pid)\n");

	my $buffer = "";
	while (sysread(STDOUTRD, $buffer, 4096, length($buffer))) {
		while ((my $pos = index($buffer, "\n")) >= 0) {
			my $line = substr($buffer, 0, $pos + 1);
			$buffer = substr($buffer, $pos + 1);
			print $logfh $line if $logfh;
			$self->parse_sauer_log($line);
			$self->save_statuspage($pid);
		}
	}

	$self->save_statuspage();
	$self->log_and_die("sauer_server died\n")
		if !exists $self->{childs}->{$pid};

	close($logfh) if $logfh;
	close(STDOUTWR);
	kill(15, $pid);
	syslog("LOG_INFO", "stopped sauer_server (pid=$pid)\n");
}

sub parse_sauer_log() {
	my ($self, $line) = @_;
	if ($line =~ /^status: (\d+) remote clients/) {
		$self->{numclients} = $1;
		$self->{clients} = {};
	} elsif ($line =~ /^clientnum:(\d+)\s/) {
		my $clientno = $1;
		foreach my $statfield(@{$self->{statfields}}) {
			$self->{clients}->{$clientno}->{$statfield->[0]} = $1
				if ($line =~ /\s$statfield->[0]:([^\s]+)\s/);
		}
		while ($line =~ s/ammo:(\d+):(\d+)//) {
			$self->{clients}->{$clientno}->{ammo}->[$1] = $2;
			$self->{max_ammo} = $1 + 1
				if ($1 >= $self->{max_ammo});
		}
	}
}

sub save_statuspage() {
	my ($self, $pid) = @_;

	return if ($self->{numclients} != keys %{$self->{clients}});
	if (!open(FH, ">$self->{statuspage}")) {
		syslog("LOG_WARNING", "$self->{statuspage}: $!");
		return;
	}

	my $client_text = "client" . ($self->{numclients} == 1 ? "" : "s");
	print FH <<EOF;
<html>
<head>
<meta http-equiv="Refresh" content="30">
<title>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:none solid black;
	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:14px;
}
//-->
</style>
</head>
<body>
<h1>Sauerbraten Status</h1>
<p>$self->{numclients} $client_text</p>
<table>
<tr>
EOF
	foreach my $statfield(@{$self->{statfields}}) {
		print FH <<EOF;
<th rowspan="2">$statfield->[1]</th>
EOF
	}
	print FH <<EOF;
<th colspan="$self->{max_ammo}">Ammo</th>
</tr>
<tr>
EOF
	for (my $ammo = 0; $ammo < $self->{max_ammo}; $ammo++) {
		print FH "<th>$ammo</th>\n";
	}
	print FH "</tr>\n";
	my $zeile = 0;
	foreach my $clientno(sort { $self->{clients}->{$a}->{frags} <=> $self->{clients}->{$b}->{frags} } keys %{$self->{clients}}) {
		print FH "<tr>\n";
		foreach my $statfield(@{$self->{statfields}}) {
			print FH <<EOF;
<td class="zeile$zeile">$self->{clients}->{$clientno}->{$statfield->[0]}</td>
EOF
		}
		for (my $ammo = 0; $ammo < $self->{max_ammo}; $ammo++) {
			print FH <<EOF;
<td class="zeile$zeile">$self->{clients}->{$clientno}->{ammo}->[$ammo]</td>
EOF
		}
		print FH "</tr>\n";
		$zeile = 1 - $zeile;
	}

	if ($pid) {
		my $started = $self->format_date($self->{start});
		my $running = $self->format_time(time() - $self->{start});
		print FH <<EOF;
</table>
<br>
<table>
<tr><th colspan="2">Sauerbraten Server</th></tr>
<tr><td>PID:</td><td>$pid</td></tr>
<tr><td>started:</td><td>$started</td></tr>
<tr><td>uptime:</td><td>$running</td></tr>
EOF
	}

	my $created = $self->format_date(time());
	print FH <<EOF;
</table>
<hr>
<tt>created: $created</tt><br>
</body>
</html>
EOF
	close(FH);
}