#!/usr/bin/perl 

# quakec5.pl
# NDC Code Release 1
#
# Connects to a Quake2 server, queries current map, players, mod
# and various other stuff, and builds a web page from that.
# Templates are supported.
# CGI-Parameters:
#	server:		IP or FQDN of server. Defaults to 194.64.167.5
#	port:		Port. Defaults to 27910
#	template:	Template file. Defaults to ndc
#
#   Copyright (C) 2001 Andreas Ulbrich, Ralf Ertzinger (ndccode@ndc.sh)
#
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; either version 2 of the License, or
#   (at your option) any later version.
#
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software
#   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

#use strict;
require 5.002;
use Socket;
use Sys::Hostname;
use DBI;
use CGI;

# Define some variables
my %eingabe;
my %variables;
my %mapnames;
my $mappath = "/maparchiv"; # Path to map thumbnails
my $template_path = "."; # Path to templates.
my $mapnamefile = "mapnames.txt";
my $scriptpath = "http://www.ndc.sh/cgi-bin/quake/quakec5.pl"; # The script itself when called by HTTP
my $quakeresponse;
my $template;
my $template_file;
my $CGIquery;

# Info about the script
$variables{parser_selfinfo} =	"<!--\nThis is the [NDC] serverinfo script, Release 5.\n" .
				"Featuring support for Quake2, HTML templatefiles and SQL-Queries.\n" .
				"Parsing-Engine: Lilith, Version 1.1.\n" .
				"Output is HTML 4.01 strict compliant.\n\n" .
				"Original Release by [NDC]Maria.\n" .
				"Quake connection code by [NDC]Maria and [NDC]Sundancer.\n" .
				"Lilith by [NDC]Sundancer.\n" .
				"Source code is available. Contact ndccode\@ndc.sh or see http://www.ndc.sh/ndccode.\n" .
				"//-->";

### Var def ###
$CGIquery = new CGI;
$variables{server_address} = ($CGIquery->param("server")?$CGIquery->param("server"):"194.64.167.5");
$variables{server_port} = ($CGIquery->param("port")?$CGIquery->param("port"):"27910");
$sort = ($CGIquery->param("sort")?$CGIquery->param("sort"):0);
$template = ($CGIquery->param("template")?$CGIquery->param("template"):"ndc");

# Load map names
if (-e $mapnamefile) {
  open(MAPNAMES,$mapnamefile);
  while ($line=<MAPNAMES>) {
    ($maphandle,$mapn) = split(":",$line);
    chomp($mapn);
    $mapname{$maphandle} = $mapn;
  }
  close(MAPNAMES);
}

$quakeresponse = QueryQuakeServer("status");

### Ausgabeformatierung ###
## Abtrennen der ersten Zeile mit den Systeminformationen ###
@ausg = split (/\n/,$quakeresponse);

## Zuweisen der Ausgabevariablen zu $variable{wasausgegebenwerdensoll} ##
@config = split (/\\/,$ausg[1]);
for ( $i = 1; $i < $#config; $i= $i + 2) {
	$var = $config[$i];
	$variables{"server_${var}"} = $config[$i + 1];	
}

## Zaehlen der Onlinespieler ##
$anzplayer = scalar(@ausg) - 2;
$variables{server_actclients} = $anzplayer;

#### Umfomartieren der Spielernamen
foreach $i (2..($#ausg)) 
{
	
	@playerdata = ($ausg[$i] =~ /^(\d+)\s(\d+)\s"(.+)"$/);
	$name = $playerdata[2];
	$pings{$name} = $playerdata[1]; 
	$frags{$name} = $playerdata[0];
	$nicks{$name} = $name;
	$nicks{$name} =~ s/&/&amp;/g;
	$nicks{$name} =~ s/</&lt;/g;
	$nicks{$name} =~ s/>/&gt;/g;
	$nicks{$name} =~ s/"/&quot;/g;
}


## Mapnamen auf vollen Namen erweitern (wenn möglich)
if (defined($mapname{$variables{server_mapname}})) {
	$variables{server_map} = $mapname{$variables{server_mapname}} . " (". $variables{server_mapname} . ")";
} else {
	$variables{server_map} = $variables{server_mapname};
}

#### Ermittlung der Load falls moeglich #####
$load = "N/A";

$variables{server_load} = $load;
$variables{server_load_color} = "<FONT color=\"#000000\">" . $load. "</FONT>";
if ($load <= 0.7) {
  $variables{server_load_color} = "<FONT color=\"#00CC00\">$load</FONT>";
}
if (($load > 0.7) && ($load < 1)) {
  $variables{server_load_color} = "<FONT color=\"#CCCC00\">$load</FONT>";
}
if ($load >= 1) {
  $variables{server_load_color} = "<FONT color=\"#CC0000\">$load</FONT>";
}


###### Sortieren #####

# By default, sort by frags.
@sortkey = sort { $frags{$b} <=> $frags{$a} } (keys %frags);
$sortname = "Frags";

if ($sort eq "0") {
	@sortkey = sort { $frags{$b} <=> $frags{$a} } (keys %frags);
	$sortname = "Frags";
}

if ($sort eq "1") {
	@sortkey = sort { $pings{$a} <=> $pings{$b} } (keys %pings);
	$sortname = "Pings";
}

if ($sort eq "2") {
	@sortkey = sort { $nicks{$a} cmp $nicks{$b} } (keys %nicks);
	$sortname = "Nick";
}

$variables{parser_sortmode} = "Sortiert nach $sortname";
 
#### Ermittlung und formatierung des Datums #####
$date_command = "/bin/date";
$date = `$date_command +"%T Uhr \&nbsp\; %d.%m.%Y"`;
chop($date);
$variables{server_date} = $date;

#### Bild von Map? #####

if (-e "$mappath/$variables{server_mapname}/$variables{server_mapname}_1_thumb.jpg") {
	$variables{map_thumbnail} = "http://www.ndc.sh/maparchiv/$variables{server_mapname}/$variables{server_mapname}_1_thumb.jpg";
} else {
	$variables{map_thumbnail} = "http://www.ndc.sh/maparchiv/blank.gif";
}

## Variables for different sorting
$variables{parser_selfsortname} = $scriptpath . "?server=" . $variables{server_address} . "&amp;port=" . $variables{server_port} . "&amp;sort=2";
$variables{parser_selfsortfrags} = $scriptpath . "?server=" . $variables{server_address} . "&amp;port=" . $variables{server_port} . "&amp;sort=0";
$variables{parser_selfsortping} = $scriptpath . "?server=" . $variables{server_address} . "&amp;port=" . $variables{server_port} . "&amp;sort=1";


## Ausgabe ##

# Define variables used by if and loop statements
$in_if_clients = 0;
$in_if_noclients = 0;
$in_loop_players = 0;

# Check template file
if ($eingabe{template} =~ /\W/) {
	# template file contains illegal characters
	$template_file = $template_path . "/ndc.template";
} else {
	$template_file = $template_path . "/" . $eingabe{template} . ".template";
}

if ( ! -e $template_file ) {
	$template_file = $template_path . "/ndc.template";
}

# Start by printing content type
print "Content-Type: text/html\n\n";

open (TEMPLATE, $template_file) or die "Could not open template file: $!\n";
@main_source=<TEMPLATE>;
close(TEMPLATE);
parse(@main_source);
##### Subroutines ######


sub cantconnect {

# Start by printing content type
print "Content-Type: text/html\n\n";
print "<HTML><BODY>Can\'t connect to $server:$port\n<BR>$!\n</BODY></HTML>";
exit;
}

sub dmflag {
@dmflags_name = ("Health" , "Powerups" , "Weapon Stay" , "Falling Damage" , "Instant Powerups" , "Same Map" , "Teams by Skin" , "Teams by Model" , "Friendly Fire" , "Spawn Farthest" , "Force Respawn" , "Armor" , "Allow Exit" , "Infinite Ammo" , "Quad Drop" , "Fixed FOV");
@dmflags_neg = (1 , 2 , 0 , 8 , 0 , 0 , 0 , 0 , 256 , 0 , 0 , 2048 , 0 , 0 , 0 , 0);


print "<P>\&nbsp\;<P><UL><a name=\"dmflags\"><b>DMFLAGS f\&uuml\;r DUMMIES<\/b><\/a><BR>\n";
print "<TABLE BORDER = \"0\">\n";
print "<TR><td WIDTH=\"150\" ALIGN=\"CENTER\" BGCOLOR=\"\#FFFFCC\"><b>Flag<\/B><\/td>\n";
print "<td WIDTH=\"60\" ALIGN=\"CENTER\" BGCOLOR=\"\#FFFFCC\"><b>On<\/B><\/td>\n";
print "<td WIDTH=\"60\" ALIGN=\"CENTER\" BGCOLOR=\"\#FFFFCC\"><b>Off<\/b><\/td><\/TR>\n";
foreach $i (0..($#dmflags_name)) {
  if ( (($text{dmflags} & (2**$i)) ^ $dmflags_neg[$i]) == (2**$i)) {
    print "<TR><TD ALIGN=\"LEFT\" BGCOLOR=\"\#CCCCCC\">$dmflags_name[$i]<\/TD>\n";
    print "<TD ALIGN=\"CENTER\" BGCOLOR=\"\#EEEEEE\"><img src=\"http\:\/\/www.ndc.sh\/graphics\/haken.gif\"><\/TD>\n";
    print "<TD ALIGN=\"CENTER\" BGCOLOR=\"\#EEEEEE\">\&nbsp\;<\/TD><\/TR>\n";
  } else {
    print "<TR><TD ALIGN=\"LEFT\" BGCOLOR=\"\#CCCCCC\">$dmflags_name[$i]<\/TD>\n";
    print "<TD ALIGN=\"CENTER\" BGCOLOR=\"\#EEEEEE\">\&nbsp\;<\/TD>\n";
    print "<TD ALIGN=\"CENTER\" BGCOLOR=\"\#EEEEEE\"><img src=\"http\:\/\/www.ndc.sh\/graphics\/haken.gif\"><\/TD><\/TR>\n";
  }
}

print "<\/TABLE><\/UL>\n";

}


sub GetDBURL {

# Takes a player name from subroutine call, returns a URL if player is in
# database, undef else.

  $pl_sql_nick = shift;
  $pl_sql_nick_old = $pl_sql_nick;

  $pl_sql_nick =~ s/(\\)/\\$1/g;
  $pl_sql_nick =~ s/(')/\\$1/g;

  # SQL-Variables

  $sql_database = "stats";
  $sql_db_table = "PlayerStats";
  $sql_datasource = "DBI:mysql:$sql_database";
  $sql_username = "";
  $sql_password = "";
  $sql_db_handle = DBI->connect($sql_datasource, $sql_username, $sql_password) or return undef;

  $sql_query = $sql_db_handle->prepare("SELECT nick FROM $sql_db_table WHERE nick='$pl_sql_nick'");
  $sql_query->execute;
  $sql_result = $sql_query->fetchrow_hashref;
  $sql_query->finish;

  if (defined($sql_result)) {
    $returnvalue = "\"http\:\/\/www.ndc.sh\/cgi-bin\/quake\/playerstats.pl\?nick\=" . make_compatible($pl_sql_nick_old) . "\"";
  } else {
    $returnvalue = undef;
  }

  $sql_db_handle->disconnect;
  return $returnvalue;
}

sub parse {
# This routine takes an array as input, and parses it line by line,
# echoing results to the screen.
# BEWARE:
# Switches like if and loop are GLOBAL!

my $template_line;
my $if_variable;
my $loop_variable;
my @parser_comment;
my $comment;
my $fullcomment;
my $replacement;
my @looparray;
my $clients;
my $i;
my $dbURL;

LOOP: while ($template_line = shift) {
	# Catch special requests
	if ($template_line =~ /^\s*\<!--if [\w_]+--\>/) {
		($if_variable) = $template_line =~ /\<!--if ([\w_]+)--\>/;
		if ($if_variable eq "clients") {
			$in_if_clients = 1;
		}
		if ($if_variable eq "noclients") {
			$in_if_noclients = 1;
		}
		next LOOP;
	}
	if ($template_line =~ /^\s*\<!--endif [\w_]+--\>/) {
		($if_variable) = ($template_line =~ /\<!--endif ([\w_]+)--\>/);
		if ($if_variable eq "clients") {
			$in_if_clients = 0;
		}
		if ($if_variable eq "noclients") {
			$in_if_noclients = 0;
		}
		next LOOP;
	}

	if ($template_line =~ /^\s*\<!--loop [\w_]+--\>/) {
		($loop_variable) = ($template_line =~ /\<!--loop ([\w_]+)--\>/);
		if ($if_variable eq "clients") {
			$in_loop_clients = 1;
		}
		next LOOP;
	}

	if ($template_line =~ /^\s*\<!--endloop [\w_]+--\>/) {
		($loop_variable) = ($template_line =~ /\<!--endloop ([\w_]+)--\>/);
		if ($if_variable eq "clients") {
			$in_loop_clients = 0;
			# Now, loop through all clients and parse
			# the saved loop once for each.
			$i = 0;
			foreach $clients ( @sortkey) {
				$dbURL = GetDBURL($clients);
				$variables{parser_clientrank} = ++$i;
				$variables{parser_clientname} = $nicks{$clients};
				if (defined($dbURL)) {
					$variables{parser_clientlink} = "<a href=$dbURL>" . $nicks{$clients} . "</a>";
					$variables{parser_clientlink_color} = "<a href=$dbURL><font color=\"#000000\">" . $nicks{$clients} . "</font></a>";
				} else {
					$variables{parser_clientlink} =  $nicks{$clients};
					$variables{parser_clientlink_color} =  $nicks{$clients};
				}
				$variables{parser_clientping} = $pings{$clients};
				$variables{parser_clientfrags} = $frags{$clients};
				parse(@looparray);
			}

		}
		next LOOP;
	}

	# Check if we are to ignore these lines
	if (($in_if_clients == 1) && ($variables{server_actclients} == 0)) {
		next LOOP;
	}
	if (($in_if_noclients == 1) && ($variables{server_actclients} != 0)) {
		next LOOP;
	}

	# If we are in loop mode, copy lines into an array for
	# later parsing
	if ($in_loop_clients == 1) {
		push @looparray, $template_line;
		next LOOP;
	}

	@parser_comment = ($template_line =~ /\<!--\$([\w_]+)--\>/g);
	foreach $comment ( @parser_comment) {
		if (defined($variables{$comment})) {
			$fullcomment = "\\<!--\\\$" . $comment . "--\\>";
			$replacement = $variables{$comment};
			$template_line =~ s/$fullcomment/$replacement/g;
		}
	}
	print $template_line;
}
} # end of sub

sub make_compatible {

  $input = shift;
  $input =~ s/%/%25/g;
  $input =~ s/\+/%2B/g;
  $input =~ s/ /+/g;
  $input =~ s/,/%2C/g;
  $input =~ s/</%3C/g;
  $input =~ s/>/%3E/g;
  $input =~ s/#/%23/g;
  $input =~ s/\[/%5B/g;
  $input =~ s/\]/%5D/g;
  $input =~ s/\//%2F/g;
  $input =~ s/\|/%7C/g;
  $input =~ s/\?/%3F/g;
  $input =~ s/\x1c/%1C/g;

  return $input;
}

sub QueryQuakeServer {

# Takes a command from caller. Executes the command on the server defined by the
# global variables $variables{server_address} and $variables{server_port}
# Returns a literal containing the server's response.

my ($count, $hisiaddr, $host, $iaddr,$paddr, $port ,$proto, $hispaddr, $command, $query, $response);

$command = shift;

$iaddr = gethostbyname(hostname());
$proto = getprotobyname('udp');
$paddr =sockaddr_in(0 ,$iaddr);


### Netzwerk und auslesen der Daten ###

socket (SOCKET, PF_INET, SOCK_DGRAM, $proto) or &cantconnect;
bind(SOCKET, $paddr) or die "bind: $!";
$| = 1;


$hisiaddr = inet_aton($variables{server_address}) or &cantconnect;
$hispaddr = sockaddr_in($variables{server_port}, $hisiaddr);
$query = "\xff\xff\xff\xff$command\x00";
defined(send(SOCKET, $query, 0, $hispaddr)) or &cantconnect;

## Timeout nach 5 sec ##
$rin = "";
vec($rin, fileno(SOCKET), 1) = 1;
while (($response eq "" ) && select($rout = $rin, undef ,undef ,5.0))
{
	($hispaddr = recv(SOCKET, $response, 1000, 0)) || &cantconnect; 
}

if ($response eq "")
{
	&cantconnect;
}

close(SOCKET);

return $response;

}
