#!/usr/bin/perl

# q3mon.pl  -  HALF-LIFE SERVER MONITOR  -  version 2.2.2
#---------------------------------------------------------------------
#
# Qsmon was originally written to query Quake servers using qstat.
# I've taken it a few steps further however and added a few new
# features. Many of the features in this script are edited out
# right now, and must be hand edited back in, because I've set this
# up for querying Quake 3 servers.
#
# Acknowledgments
# ---------------
# Steve Wainstead - Help on 2.1 rewrite
# Mike "Pestilence" Hallock - maintainer
#
#
#---------------------------------------------------------------------

######################################################################
# SETTINGS
######################################################################

# If you only want to monitor one Half-Life server, uncomment this line 
# and change the address to the address of your server
# @Quake3Servers = ('209.209.214.5:27015','209.209.196.8:27015');
@Quake3Servers = ('24.153.172.212:14567','199.240.91.62:14567','205.218.177.22:14567','204.119.240.50:14567','209.209.214.5:14567');

# Colors and background settings for the web pages.
$BodyArgs = "BGCOLOR=\"#5F776A\" BACKGROUND=\"http://www.lamerc.com/images/bg.jpg\" TEXT=\"#000000\" LINK=\"#5F776A\" ALINK=\"#990000\" VLINK=\"#990000\" TOPMARGIN=\"0\" LEFTMARGIN=\"0\" MARGINWIDTH=\"0\" MARGINHEIGHT=\"0\"";

# Web page table parameters.
$TableArgs = "border=\"0\" cellspacing=\"0\" cellpadding=\"1\"";

# QstatPath specifies where I can find the qstat executable. This path 
# MUST be here.
$QstatPath = "/usr/local/www/cgi-bin/qstat2/qstat";

# @date = `date`;

# The URL for this script.  Most HTTP servers will set the
# environment variables SERVER_NAME and SCRIPT_NAME which can be used
# to construct the script's URL.  If this doesn't work, then just go
# ahead and use a hard-coded URL like this:
# $ScriptURL = 'http://www.my.host/cgi-bin/qsmon.cgi';
$ScriptURL = 'http://www.lamerc.com/cgi-bin/bfmon.pl';

# This is new here: I am puting this in for image finding easier.
# By default it grabs the map images from LinuxQuake.com, which
# is probably the definitive source for map images fitting the
# size in this script:
#$ImageURL = "http://www.linuxquake.com/gif/Maps";
$ImageURL = "http://www.lamerc.com/images/mappics";


#######################################################################
#  MAIN PROGRAM
#######################################################################

# First tell Perl to bypass the buffer so in case the HTTP server is
# bogged down we won't get timed-out.  Then output the 'magic' HTML
# header so that the HTTP server knows this is an HTML document.
# This will also allow us to output any debugging info to the web.
# the web and so that in the case of a bogged down server, we won't
# get timed-out. 

$! = 1;
print "Content-type: text/html\n\n";

# What to do?  If the list of Quake servers is set in this program,
# use them.  If a list of servers is provided via CGI, use them.  If
# no servers were specified, output a form so the user can supply a
# server list.
if (!@Quake3Servers) {
	$Result = &ReadParse;
	if ($Result) {
		if ($in{'Quake3Servers'} ne "") {
			@Value = split(/,/, $in{'Quake3Servers'});
		} else { 
			@Value = split(/,/, $in); 
		}
		foreach (@Value) { 
			push (@Quake3Servers, $_); 
		}
	} else {
		&OutputForm;
	}
}

print qq^


^;


# Do this loop for each server
foreach (@Quake3Servers) {

	# Run qstat and split results into 3 groups
	split(/\n/,`$QstatPath -R -P -cn -tsw -cfg qstat/qstat.cfg -bds $_ -raw ,,`);
	$GeneralLine = shift(@_);
	$RulesLine = shift(@_);
	@PlayerLines = @_;

	# Split general and rules info into seperate variables
	@General = split(/,,/,$GeneralLine);
	for (split ',,', $RulesLine) {
		# split each value on '='
		if (($var_name, $var_value) = split /=/) {
			${$var_name} = $var_value; # create a variable with the name given
		}
	}

	# Check to see if the server is not responding
	if ($General[2] eq 'DOWN') {
		print qq!
			$GeneralLine
			<table $TableArgs>
			<tr align="center">
			<th><tt><font class=four>$_ Not Responding</font></tt></th>
			</tr>
			<tr align="center">
			<td>The Half-life server at <b>$_</b> did not respond. The server may be down or only
			temporarily unreachable.</td>
			</tr>
			</table>
			<hr>
		!;
		next;
	}

	# Let's set some of the default settings
	if ($fraglimit == 0) { 
		$fraglimit = 'None'; 
	}
	if ($dmflags == 0) { 
		$dmflags = 'Default'; 
	}	   
	if ($timelimit == 0) { 
		$timelimit = 'None'; 
	}
	$map = $General[3];


	# Now that we have all of the actual informational stuff done, let's print
	# it out:
	# Output the entire dynamic HTML stuff

if (-f "/usr/local/www/data/images/mappics/$map.jpg")
	{
	$mappic = "$ImageURL/$map.jpg";
	}
else
	{
	$mappic = "$ImageURL/cstrike_nopicture.jpg";
	};

	print qq!

<TABLE BORDER=1 CELLPADDING=0 CELLSPACING=0 WIDTH=950>

<TR BGCOLOR=#00044f>

<TD><FONT FACE="Arial, Helvetica" SIZE="-1" COLOR="#ffffff"><B>&nbsp;Server Name</B></FONT></TD>

<TD ALIGN="center"><FONT FACE="Arial, Helvetica" SIZE="-1" COLOR="#ffffff"><B>&nbsp;Players&nbsp;</B></FONT></TD>

<TD ALIGN="center"><FONT FACE="Arial, Helvetica" SIZE="-1" COLOR="#ffffff"><B>Map ($map)</B></FONT></TD>

<TD ALIGN="center"><FONT FACE="Arial, Helvetica" SIZE="-1" COLOR="#ffffff"><B>Game</B></FONT></TD>

<TD ALIGN="center"><FONT FACE="Arial, Helvetica" SIZE="-1" COLOR="#ffffff"><B>Address</B></FONT></TD>

</TR>


<TR>

<TD><FONT FACE="Arial, Helvetica" SIZE="-1"><B>&nbsp;$General[2]</B></FONT></TD>

<TD ALIGN="center"><FONT FACE="Arial, Helvetica" SIZE="-1"><B>&nbsp;$General[5] / $General[4]&nbsp;</B></FONT></TD>

<TD ALIGN="center"><FONT FACE="Arial, Helvetica" SIZE="-1"><B><img src="$mappic" width=125 height=100 border=0></B></FONT></TD>

<TD ALIGN="center"><FONT FACE="Arial, Helvetica" SIZE="-1"><B>&nbsp;$gamename&nbsp;</B></FONT></TD>

<TD ALIGN="center"><FONT FACE="Arial, Helvetica" SIZE="-1"><B>&nbsp;$General[1]&nbsp;</B></FONT></TD>

</TR>

<TR BGCOLOR=#00044f>

<TD><FONT FACE="Arial, Helvetica" SIZE="-1" COLOR="#ffffff"><B>&nbsp;Player Name</B></FONT></TD>

<TD ALIGN=center><FONT FACE="Arial, Helvetica" SIZE="-1" COLOR="#ffffff"><B>Ping</B></FONT></TD>

<TD colspan=3>&nbsp;</TD>

</TR>

	!;

if ($General[5] == 0) {
                print "<tr><td align=center colspan=5><FONT FACE=\"Arial, Helvetica\" SIZE=\"-1\"No Players</FONT></td></tr>\n";
        } else {
                # Sort the players by frags
                foreach $I (0 .. $#PlayerLines) {
                        ($Name[$I], $Frags[$I], $TheRest[$I]) = split(/,,/, $PlayerLines[$I]);
                        $Frags[$I] = $Frags[$I]. ".$I";
                }
                @Name = ();
                @Address = ();
                @TheRest = ();   
                @SortedFrags = sort {$b <=> $a} @Frags;
                @Frags = ();
                @SortedPlayerLines = ();
                foreach $I (0 .. $#SortedFrags) {
                        ($Frags, $Index) = split(/\./, $SortedFrags[$I]);
                        push (@SortedPlayerLines, $PlayerLines[$Index]);
                }
  		
		# Ouput the player table data
                foreach (@SortedPlayerLines) {
                        @Player = split(/,,/,$_);
        
                        # Output a table row for each player
                        print qq!
                         <tr>
                          <td><FONT FACE="Arial, Helvetica" SIZE="-1">$Player[0]</FONT></td>
                          <td align=center><FONT FACE="Arial, Helvetica" SIZE="-1">$Player[2]</FONT></td>
                          <td colspan=3>&nbsp;</TD>
			 </tr>

                        !; 
                }


        }

		print qq!
			</TABLE>
		
			<p>
		!;







} # End of the server stats loop...

print qq^

^;

exit;
# End of the main program



#######################################################################
# SUB ROUTINES
#######################################################################

# Display the form for entering Quake server(s)
sub OutputForm {
	print qq!
		<html>
		<head>
		<title>Half-life Server Monitor</title>
		</head>
		<body $BodyArgs>
		<center>
		<h2>Half-Life Server Monitor</h2>
		<hr>
		<form method="post" action="$ScriptURL">
		<p><b>Half-life Server(s):</b>   
		<input type="text" name="QuakeServers" size="60">
		</form>
		</center>
		<p>To see what's happening on a Quake server, enter the IP address
		(<i>i.e. 207.49.0.5</i>) or host name
		(<i>i.e. quake1.wasatchfault.com</i>) of a Quake server in the text
		box above and then press 'Enter' (the key on your keyboard).
		To monitor multiple servers, seperate the servers by commas
		(<i>i.e. 207.49.0.5,207.49.0.6</i>).</p>
		</body>
		</html>
	!;
	exit;
}

# ReadParse
# Reads in GET or POST data, converts it to unescaped text, and puts
# one key=value in each member of the list "@in"
# Also creates key/value pairs in %in, using '\0' to separate multiple
# selections

# Returns TRUE if there was input, FALSE if there was no input
# UNDEF may be used in the future to indicate some failure.

# Now that cgi scripts can be put in the normal file space, it is useful
# to combine both the form and the script in one place.  If no parametersM
# are given (i.e., ReadParse returns FALSE), then a form could be output.M

# If a variable-glob parameter (e.g., *cgi_input) is passed to ReadParse,M
# information is stored there, rather than in $in, @in, and %in.M

sub ReadParse {
	local (*in) = @_ if @_;
	local ($i, $key, $val);

	# Read in text from form
	if ($ENV{'REQUEST_METHOD'} eq "GET") {
		$in = $ENV{'QUERY_STRING'};
	} elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
		read(STDIN,$in,$ENV{'CONTENT_LENGTH'});
	}

	# Read in query from ISINDEx
	if ($ENV{'HTTP_SEARCH_ARGS'} ne "") { 
		$in = $ENV{'HTTP_SEARCH_ARGS'}; 
	}

	@in = split(/&/,$in);

	foreach $i (0 .. $#in) {
		# Convert plus's to spaces
		$in[$i] =~ s/\+/ /g; 

		# Split into key and value.
		($key, $val) = split(/=/,$in[$i],2);          # splits on the first =.

		# Convert %XX from hex numbers to alphanumeric
		$key =~ s/%(..)/pack("c",hex($1))/ge;
		$val =~ s/%(..)/pack("c",hex($1))/ge;

		# Associate key and value
		$in{$key} .= "\0" if (defined($in{$key}));    # \0 is the multiple separator
		$in{$key} .= $val;

	}

	return length($in); 
}