#!/usr/bin/perl -w

##
##  cube masterserver
##  (c) 2004, Hungerburg, License same as Cube (z-lib)
##

=cut

Changes

- start from scratch (4h)
  Son Mai 30 19:05:26 CEST 2004
- drop stale servers after 65 mins, misc wording (1h)
  Mit Jun  2 22:55:59 CEST 2004
- cube protocol (4h)
  Fre Jun  4 19:23:54 CEST 2004
- dont register when ping fails (bug), hide admin (2h)
  Sam Jun  5 13:59:09 CEST 2004
- ping servers before displaying, use -w argument (1h)
  Die Jun  8 13:14:31 CEST 2004
- better unpack template (1h)
  Mon Jun 14 17:43:25 CEST 2004

TODO

- concurrency, locking
- ping times need Time::HiRes installed

INSTALL

1) change the password below
2) on your webserver, create a directory "cgi-bin/cube"
3) put this file in the cgi-bin/cube directory
4) make the masterserver executable (chmod 755 masterserver)
5) make the cube directory world writable (chmod 777 .)
6) goto http://your.webserver.dom/cgi-bin/cube/masterserver
7) do a "Reset" twice - you will have to login
   ignore the error: a data and a log file will be created
8) make the cube directory only writable to you again (chmod 755 .)
9) start cube with -myour.webserver.dom/cgi-bin/cube/masterserver/

=cut

#unshift (@INC, '../../perl');

use CGI qw/:standard *table/;
use CGI::Carp qw/fatalsToBrowser/;
use Storable;
use IO::Socket;
#use Time::HiRes qw/gettimeofday/;


# configuration
$password = 'blah';
$datfile  = 'srv.dat';
$logfile  = 'log.txt';
$timeout  = 60*65;

# globals
$now     = time();
$dummy   = {
	'Address' => [
		'Hostname', 'Map', 'Description', 'Mode',
		'Players', 'Ping', 'Protocol', 'Time', 'Modified'
	]
};


##########################################################################
#				utility functions
##########################################################################

# write log entry
sub log {
	$msg = shift;
	$remote = remote_addr();

	open(LOG, ">>$logfile") or die "Cannot open $logfile for write: $!";
	print LOG "$now, $msg, $remote\n";
	close(LOG);
}

# reset servers list
sub master_reset {
	store($dummy, $datfile) or die "Cannot store servers: $!";
	open(LOG, ">$logfile") or die "Cannot open $logfile for write: $!";
	close(LOG);
	&log('Reset');
}


##########################################################################
#		 	  master to server communications
##########################################################################

sub cube_ping {
	$port    = 28766;
	$MAXLEN  = 255;
	$TIMEOUT = 2;
	$address = shift;

	$sock = IO::Socket::INET->new(
			Proto => 'udp',
			PeerPort => $port,
			PeerAddr => $address) or die "Create socket: $!";

	#$millies = gettimeofday();
	#$buf = pack('N', $millies);
	$buf = pack('N', $now);
	$sock->send($buf) or die "Send to socket: $!";
	eval {
		local $SIG{ALRM} = sub { close(SOCK); die "Alarm time out"; };
		alarm $TIMEOUT;
		$sock->recv($buf, $MAXLEN) or die "Read from socket";
		alarm 0;
		1; # return success
	} or 0;
	close(SOCK);
	$buf;
}

sub server_ping {
	$address = shift;
	$players = $ping = $protocol = $time = $mode = 0;
	$map = $description = '';

	$pong = &cube_ping($address);
	if (!$pong) { 
		return 0;
	}

	# unpack/split ping result
	($millies, $protocol, $mode, $players, $time, $map, $description)
		= unpack('NC4Z*Z*', $pong);

	#$ping = gettimeofday() - $millies;
	$ping = time() - $millies;
	$hostname = $address unless $hostname;

	[
		$hostname, $map, $description, $mode, $players, $ping,
		$protocol, $time, $now
	];
}


##########################################################################
#				user/admin pages
##########################################################################

# navigation bar html fragment
sub print_nav {
	$pw=param('password');

	print p(scalar(localtime));
	print hr;
	print qq{
		<form method="post">
		<input name="password" type="hidden" value="$pw" />
		<input name="status" type="submit" value="Status" />
		<input name="log" type="submit" value="Log" />
		<input name="reset" type="submit" value="Reset" />
		</form>
	};
	print hr;
}

# failure message page
sub print_failure {
	$msg = shift;
	&log($msg);

	print header;
	print start_html('Error'), h1('Error');
	print p($msg);
	print end_html;
}

# password validation
sub check_password {
	if (!param('password')) {
		&print_login();
		exit;
	}
	elsif (param('password') ne $password) {
		print_failure('Sorry');
		exit;
	}
}

# login form
sub print_login {
	print header;
	print start_html('Login'), h1('Login');

	print qq{
		<form method="post">
		<input name="password" type="password" />
		<input type="submit" value="Login" />
		</form>
	};
	print end_html;
}

# server status page
sub print_status {
	print header;
	print start_html('Status'), h1('Status');
	if (param('password')) { &print_nav(); }

	$servers = retrieve($datfile) or die "Unable to retrieve servers: $!";
	# drop stale ones
	while (($key, $value) = each %$servers) {
		if ($now - @$value[8] > $timeout) {
			delete $servers->{$key}
		}
	}

	print start_table;
	# table header
	while (($key,$value) = each %$dummy) {
		print Tr(th($dummy->{$key}));
	} 
	# drop dummy
	delete $servers->{each %$dummy};
	# currently active servers
	while (($address) = each %$servers) {
		$servers->{$address} = &server_ping($address) and
		print Tr(td($servers->{$address}));
	} 
	print end_table;

	if (!param('password')) {
		$myself = self_url;
		print p(a({href=>"$myself/admin.do"},'Admin'));
	}
	print end_html;
}

# log view page
sub print_log {
	print header;
	print start_html('Log'), h1('Log');
	&print_nav();

	open(LOG, "<$logfile") or die "Cannot open $logfile for read: $!";
	while (<LOG>) {
		chomp;
		s/([0-9]+), // && push @entries, "$_, " . localtime($1);
	}
	close(LOG);

	print code(ul(li(\@entries)));
	print end_html;
}


##########################################################################
#			   masterserver actions
##########################################################################

# final message
sub final {
	print header('text/plain');
	print shift;
	exit;
}

# Add a server
sub action_add {
	$address  = remote_addr();
	$hostname = remote_host();

	$servers = retrieve($datfile) or die "Unable to retrieve servers: $!";
	# drop stale ones
	while (($key, $value) = each %$servers) {
		if ($now - @$value[8] > $timeout) {
			delete $servers->{$key}
		}
	}
	# drop dummy
	#delete $servers->{each %$dummy};

	$servers->{$address} = &server_ping($address)
		or &final('Server not registered. Could not ping you.');
	store ($servers, $datfile) or die "Cannot store servers: $!";

	&log('Add');
	&final('Registration successful.');
}

# List servers
sub item_list {
	print header('text/plain');

	$servers = retrieve($datfile) or die "Unable to retrieve servers: $!";
	# drop stale ones
	while (($key, $value) = each %$servers) {
		if ($now - @$value[8] > $timeout) {
			delete $servers->{$key}
		}
	}

	print "// cube masterserver list\n";
	while (($key) = each %$servers) {
		print "addserver $key\n";
	} 
}


##########################################################################
#			   controller
##########################################################################

sub retrieve_do {
	if (param('item') eq 'list') { &item_list(); }
}

sub register_do {
	if (param('action') eq 'add') { &action_add(); }
}

sub master {
	$request = $ENV{'PATH_INFO'};
	if ($request eq '/retrieve.do') { &retrieve_do(); }
	elsif ($request eq '/register.do') { &register_do(); }
	else { &print_failure('Unknown Masterserver request: '. $request)};
}

sub admin {
	&check_password();
	SWITCH: {
		if (param('log')) { &print_log(); last SWITCH; }
		elsif (param('reset')) { &master_reset(); }
		&print_status();
	}
}

sub public {
	&print_status();
}


##########################################################################
#				   main
##########################################################################

MAIN:
{
	# process administrative requests
	if ($ENV{'PATH_INFO'} && $ENV{'PATH_INFO'} =~ '/admin') { &admin(); }
	# process masterserver requests
	elsif ($ENV{'PATH_INFO'}) { &master(); }
	# display status
	else { &public; }
}
# eof.