#!/usr/bin/perl -w
#
# Quake2 Server Monitor auto-resart script - V1.4
# Author: Bill Kelly <billk@tastyspleen.net> http://tastyspleen.net
#
# Usage: Tweak the config variables below as needed.  This script will
# spawn a quake2 server (presumably dedicated) and still allows you to
# type console commands to the server.  But the script pings the server
# for status every N seconds, and if M consecutive pings go unanswered
# by the server, the script kills the server process and restarts it.
#
# Example: ./q2mon.pl q2-exe my-q2-server.net 27911 +set game ctf
#
# This software is not copyrighted, and comes with ABSOLUTELY NO WARRANTY
# of any kind.  Share and enjoy!!
#
# The latest version of this software may be obtained via anonymous CVS
# from the dorkbuster quake2 admin project, generously hosted by
# rubyforge ( http://rubyforge.org/projects/dorkbuster/ ).
#
# Type the following two lines at your command prompt to get the latest
# q2mon.pl.
#
# cvs -d:pserver:anonymous@rubyforge.org:/var/cvs/dorkbuster login
# (press enter at password prompt)
# cvs -z3 -d:pserver:anonymous@rubyforge.org:/var/cvs/dorkbuster co q2mon

use IO::Socket;
use POSIX qw(strftime);
use strict;

our $PROGNAME = "q2mon";
(@ARGV >= 3) or die("Usage: $PROGNAME q2-exe server-ip server-port [optional extra server command line arguments]\n");

$config::server_ping_interval_secs     = 5;  # check server alive every N seconds
$config::dead_when_consec_packets_lost = 6;  # consider server dead when N consecutive status-pings lost

$config::server_binary = shift @ARGV;
$config::server_ip     = shift @ARGV;
$config::server_port   = shift @ARGV;

@config::server_args = (
  "+set", "ip", $config::server_ip,
  "+set", "net_ip", $config::server_ip,
  "+set", "port", $config::server_port,
  "+set", "net_port", $config::server_port,
  "+set", "dedicated", "1",
  @ARGV);


(-x $config::server_binary) or die("$PROGNAME: can't find server executable $config::server_binary\n");


$SIG{PIPE} = 'IGNORE';
$SIG{CHLD} = 'IGNORE';
$| = 1;


our $sv = $config::server_ip.":".$config::server_port;

sub server_ping {
 my $status = "";
 eval {
  my $sock = IO::Socket::INET->new(
          Proto => "udp",
          PeerAddr => $config::server_ip,
          PeerPort => $config::server_port
   );
  $sock->send("\xff\xff\xff\xffstatus");
 
  my $rin = '';
  my $rout;
  vec($rin, fileno($sock), 1) = 1;
  my $nfound = select($rout = $rin, undef, undef, 3.0);
  if ($nfound > 0) {
   $sock->recv($status, 2048);
  }
 };
 warn $@ if $@;

 return defined($status) && ($status ne "");
}


sub wait_till_dead {
	my ($pid) = @_;
	my $consec_lost = 0;
	while (1) {
		my $server_proc_died = !kill(0, $pid);
		if ($server_proc_died) {
			print STDERR ("$PROGNAME: server $sv process died...\n");
			return;
		}

		if (server_ping()) {
			print STDERR ("$PROGNAME: server $sv still alive...\n") if ($consec_lost > 0);
			$consec_lost = 0;
		}
		else {
			$consec_lost++;
			if ($consec_lost >= $config::dead_when_consec_packets_lost) {
				print STDERR ("$PROGNAME: server $sv failed response to all pings...\n");
				return;
			}
			else {
				print STDERR ("$PROGNAME: warning: $consec_lost consecutive packets lost to server $sv...\n");
			}
		}
		sleep($config::server_ping_interval_secs);
	}
}

sub spawn_server {
	my $pid = undef;
	while (! defined($pid = fork)) {
		print STDERR ("$PROGNAME: warning: failed to fork: $! ...retrying...\n");
		sleep(3);
	}
	if (! $pid) {  # child...
		$| = 1;
		print STDERR ("$PROGNAME: spawning server $sv (pid $$)...\n");

		# Substitue any time/date format specifiers in the command line arguments
		my @now = localtime;
		@config::server_args = map { strftime($_, @now) } @config::server_args;

		exec($config::server_binary, @config::server_args)
			or print STDERR ("$PROGNAME: child $$: exec($config::server_binary, @config::server_args) failed: $!\n");
		exit;  # normally never reach here
	}
	return $pid;
}

sub kill_server {
	my ($pid) = @_;
	if (kill(0, $pid)) {
		print STDERR ("$PROGNAME: sending server $sv (pid $pid) TERM signal...\n");
		kill('TERM', $pid);
		sleep(2);
		if (kill(0, $pid)) {
			print STDERR ("$PROGNAME: sending server $sv (pid $pid) KILL signal...\n");
			kill('KILL', $pid);
			sleep(2);
		}
	}
}

$SIG{INT} = sub { die "\n$PROGNAME: exiting...\n" };

while (1) {
	my $pid = spawn_server();
	sleep(10);  # wait for server to come up
	wait_till_dead($pid);
	kill_server($pid);
}