#!/usr/bin/perl
######################################################################
# SETTINGS
######################################################################
# If you only want to monitor one Quake 3 server, uncomment this line
# and change the address to the address of your server
# @Quake3Servers = ('64.7.24.67:27960');
# Stylesheet Location
$StyleSheet = "http://www.demohq.com/q3mon.css";
# QstatPath specifies where I can find the qstat executable. This path
# MUST be here.
$QstatPath = "./qstat";
# 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.demohq.com/cgi-bin/q3mon.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.ptarena.net/qsmon";
#######################################################################
# 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;
}
}
# Do this loop for each server
foreach (@Quake3Servers) {
# Run qstat and split results into 3 groups
split(/\n/,`$QstatPath -R -P -cn -tsw -q3s $_ -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
The Quake server at $_ did not respond. The server may be down or only
temporarily unreachable.
!;
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
print qq!
Quake 3 Server Stats
$General[2] playing $map
Server IP:
$General[1]
Game Type
$gamename
Dmflags:
$dmflags
Timelimit:
$timelimit
Fraglimit:
$fraglimit
Players / Max:
$General[5] / $General[4]
Ping / Timeout:
$General[6] / $General[7]
Player Name
Ping
Frags
!;
# Check to see if there's more than 0 players
if ($General[5] == 0) {
print "
NO PLAYERS ONLINE
\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(/,,/,$_);
$Player[0] =~ s/\^0//g;
$Player[0] =~ s/\^1//g;
$Player[0] =~ s/\^2//g;
$Player[0] =~ s/\^3//g;
$Player[0] =~ s/\^4//g;
$Player[0] =~ s/\^5//g;
$Player[0] =~ s/\^6//g;
$Player[0] =~ s/\^7//g;
# Strip color tags of the format ^# or ^* from player name if any left.
$Player[0] =~ s/\^\d//g;
$Player[0] =~ s/\^\*//g;
$Player[0] =~ s/\^\.//g;
$Player[0] =~ s/\^\#//g;
# Output a table row for each player
print qq!
$Player[0]
$Player[2]
$Player[1]
!;
}
}
print qq!
!;
} # 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!
Quake Server Monitor
Quake Server Monitor
To see what's happening on a Quake server, enter the IP address
(i.e. 207.49.0.5) or host name
(i.e. quake1.wasatchfault.com) 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.e. 207.49.0.5,207.49.0.6).
!;
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);
}
