server/quakec5.pl

   1 #!/usr/bin/perl
   2
   3 # quakec5.pl
   4 # NDC Code Release 1
   5 #
   6 # Connects to a Quake2 server, queries current map, players, mod
   7 # and various other stuff, and builds a web page from that.
   8 # Templates are supported.
   9 # CGI-Parameters:
  10 #       server:         IP or FQDN of server. Defaults to 194.64.167.5
  11 #       port:           Port. Defaults to 27910
  12 #       template:       Template file. Defaults to ndc
  13 #
  14 #   Copyright (C) 2001 Andreas Ulbrich, Ralf Ertzinger (ndccode@ndc.sh)
  15 #
  16 #   This program is free software; you can redistribute it and/or modify
  17 #   it under the terms of the GNU General Public License as published by
  18 #   the Free Software Foundation; either version 2 of the License, or
  19 #   (at your option) any later version.
  20 #
  21 #   This program is distributed in the hope that it will be useful,
  22 #   but WITHOUT ANY WARRANTY; without even the implied warranty of
  23 #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24 #   GNU General Public License for more details.
  25 #
  26 #   You should have received a copy of the GNU General Public License
  27 #   along with this program; if not, write to the Free Software
  28 #   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  29
  30 #use strict;
  31 require 5.002;
  32 use Socket;
  33 use Sys::Hostname;
  34 use DBI;
  35 use CGI;
  36
  37 # Define some variables
  38 my %eingabe;
  39 my %variables;
  40 my %mapnames;
  41 my $mappath = "/maparchiv"; # Path to map thumbnails
  42 my $template_path = "."; # Path to templates.
  43 my $mapnamefile = "mapnames.txt";
  44 my $scriptpath = "http://www.ndc.sh/cgi-bin/quake/quakec5.pl"; # The script itself when called by HTTP
  45 my $quakeresponse;
  46 my $template;
  47 my $template_file;
  48 my $CGIquery;
  49
  50 # Info about the script
  51 $variables{parser_selfinfo} =   "<!--\nThis is the [NDC] serverinfo script, Release 5.\n" .
  52                                 "Featuring support for Quake2, HTML templatefiles and SQL-Queries.\n" .
  53                                 "Parsing-Engine: Lilith, Version 1.1.\n" .
  54                                 "Output is HTML 4.01 strict compliant.\n\n" .
  55                                 "Original Release by [NDC]Maria.\n" .
  56                                 "Quake connection code by [NDC]Maria and [NDC]Sundancer.\n" .
  57                                 "Lilith by [NDC]Sundancer.\n" .
  58                                 "Source code is available. Contact ndccode\@ndc.sh or see http://www.ndc.sh/ndccode.\n" .
  59                                 "//-->";
  60
  61 ### Var def ###
  62 $CGIquery = new CGI;
  63 $variables{server_address} = ($CGIquery->param("server")?$CGIquery->param("server"):"194.64.167.5");
  64 $variables{server_port} = ($CGIquery->param("port")?$CGIquery->param("port"):"27910");
  65 $sort = ($CGIquery->param("sort")?$CGIquery->param("sort"):0);
  66 $template = ($CGIquery->param("template")?$CGIquery->param("template"):"ndc");
  67
  68 # Load map names
  69 if (-e $mapnamefile) {
  70   open(MAPNAMES,$mapnamefile);
  71   while ($line=<MAPNAMES>) {
  72     ($maphandle,$mapn) = split(":",$line);
  73     chomp($mapn);
  74     $mapname{$maphandle} = $mapn;
  75   }
  76   close(MAPNAMES);
  77 }
  78
  79 $quakeresponse = QueryQuakeServer("status");
  80
  81 ### Ausgabeformatierung ###
  82 ## Abtrennen der ersten Zeile mit den Systeminformationen ###
  83 @ausg = split (/\n/,$quakeresponse);
  84
  85 ## Zuweisen der Ausgabevariablen zu $variable{wasausgegebenwerdensoll} ##
  86 @config = split (/\\/,$ausg[1]);
  87 for ( $i = 1; $i < $#config; $i= $i + 2) {
  88         $var = $config[$i];
  89         $variables{"server_${var}"} = $config[$i + 1];
  90 }
  91
  92 ## Zaehlen der Onlinespieler ##
  93 $anzplayer = scalar(@ausg) - 2;
  94 $variables{server_actclients} = $anzplayer;
  95
  96 #### Umfomartieren der Spielernamen
  97 foreach $i (2..($#ausg))
  98 {
  99
 100         @playerdata = ($ausg[$i] =~ /^(\d+)\s(\d+)\s"(.+)"$/);
 101         $name = $playerdata[2];
 102         $pings{$name} = $playerdata[1];
 103         $frags{$name} = $playerdata[0];
 104         $nicks{$name} = $name;
 105         $nicks{$name} =~ s/&/&amp;/g;
 106         $nicks{$name} =~ s/</&lt;/g;
 107         $nicks{$name} =~ s/>/&gt;/g;
 108         $nicks{$name} =~ s/"/&quot;/g;
 109 }
 110
 111
 112 ## Mapnamen auf vollen Namen erweitern (wenn möglich)
 113 if (defined($mapname{$variables{server_mapname}})) {
 114         $variables{server_map} = $mapname{$variables{server_mapname}} . " (". $variables{server_mapname} . ")";
 115 } else {
 116         $variables{server_map} = $variables{server_mapname};
 117 }
 118
 119 #### Ermittlung der Load falls moeglich #####
 120 $load = "N/A";
 121
 122 $variables{server_load} = $load;
 123 $variables{server_load_color} = "<FONT color=\"#000000\">" . $load. "</FONT>";
 124 if ($load <= 0.7) {
 125   $variables{server_load_color} = "<FONT color=\"#00CC00\">$load</FONT>";
 126 }
 127 if (($load > 0.7) && ($load < 1)) {
 128   $variables{server_load_color} = "<FONT color=\"#CCCC00\">$load</FONT>";
 129 }
 130 if ($load >= 1) {
 131   $variables{server_load_color} = "<FONT color=\"#CC0000\">$load</FONT>";
 132 }
 133
 134
 135 ###### Sortieren #####
 136
 137 # By default, sort by frags.
 138 @sortkey = sort { $frags{$b} <=> $frags{$a} } (keys %frags);
 139 $sortname = "Frags";
 140
 141 if ($sort eq "0") {
 142         @sortkey = sort { $frags{$b} <=> $frags{$a} } (keys %frags);
 143         $sortname = "Frags";
 144 }
 145
 146 if ($sort eq "1") {
 147         @sortkey = sort { $pings{$a} <=> $pings{$b} } (keys %pings);
 148         $sortname = "Pings";
 149 }
 150
 151 if ($sort eq "2") {
 152         @sortkey = sort { $nicks{$a} cmp $nicks{$b} } (keys %nicks);
 153         $sortname = "Nick";
 154 }
 155
 156 $variables{parser_sortmode} = "Sortiert nach $sortname";
 157
 158 #### Ermittlung und formatierung des Datums #####
 159 $date_command = "/bin/date";
 160 $date = `$date_command +"%T Uhr \&nbsp\; %d.%m.%Y"`;
 161 chop($date);
 162 $variables{server_date} = $date;
 163
 164 #### Bild von Map? #####
 165
 166 if (-e "$mappath/$variables{server_mapname}/$variables{server_mapname}_1_thumb.jpg") {
 167         $variables{map_thumbnail} = "http://www.ndc.sh/maparchiv/$variables{server_mapname}/$variables{server_mapname}_1_thumb.jpg";
 168 } else {
 169         $variables{map_thumbnail} = "http://www.ndc.sh/maparchiv/blank.gif";
 170 }
 171
 172 ## Variables for different sorting
 173 $variables{parser_selfsortname} = $scriptpath . "?server=" . $variables{server_address} . "&amp;port=" . $variables{server_port} . "&amp;sort=2";
 174 $variables{parser_selfsortfrags} = $scriptpath . "?server=" . $variables{server_address} . "&amp;port=" . $variables{server_port} . "&amp;sort=0";
 175 $variables{parser_selfsortping} = $scriptpath . "?server=" . $variables{server_address} . "&amp;port=" . $variables{server_port} . "&amp;sort=1";
 176
 177
 178 ## Ausgabe ##
 179
 180 # Define variables used by if and loop statements
 181 $in_if_clients = 0;
 182 $in_if_noclients = 0;
 183 $in_loop_players = 0;
 184
 185 # Check template file
 186 if ($eingabe{template} =~ /\W/) {
 187         # template file contains illegal characters
 188         $template_file = $template_path . "/ndc.template";
 189 } else {
 190         $template_file = $template_path . "/" . $eingabe{template} . ".template";
 191 }
 192
 193 if ( ! -e $template_file ) {
 194         $template_file = $template_path . "/ndc.template";
 195 }
 196
 197 # Start by printing content type
 198 print "Content-Type: text/html\n\n";
 199
 200 open (TEMPLATE, $template_file) or die "Could not open template file: $!\n";
 201 @main_source=<TEMPLATE>;
 202 close(TEMPLATE);
 203 parse(@main_source);
 204 ##### Subroutines ######
 205
 206
 207 sub cantconnect {
 208
 209 # Start by printing content type
 210 print "Content-Type: text/html\n\n";
 211 print "<HTML><BODY>Can\'t connect to $server:$port\n<BR>$!\n</BODY></HTML>";
 212 exit;
 213 }
 214
 215 sub dmflag {
 216 @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");
 217 @dmflags_neg = (1 , 2 , 0 , 8 , 0 , 0 , 0 , 0 , 256 , 0 , 0 , 2048 , 0 , 0 , 0 , 0);
 218
 219
 220 print "<P>\&nbsp\;<P><UL><a name=\"dmflags\"><b>DMFLAGS f\&uuml\;r DUMMIES<\/b><\/a><BR>\n";
 221 print "<TABLE BORDER = \"0\">\n";
 222 print "<TR><td WIDTH=\"150\" ALIGN=\"CENTER\" BGCOLOR=\"\#FFFFCC\"><b>Flag<\/B><\/td>\n";
 223 print "<td WIDTH=\"60\" ALIGN=\"CENTER\" BGCOLOR=\"\#FFFFCC\"><b>On<\/B><\/td>\n";
 224 print "<td WIDTH=\"60\" ALIGN=\"CENTER\" BGCOLOR=\"\#FFFFCC\"><b>Off<\/b><\/td><\/TR>\n";
 225 foreach $i (0..($#dmflags_name)) {
 226   if ( (($text{dmflags} & (2**$i)) ^ $dmflags_neg[$i]) == (2**$i)) {
 227     print "<TR><TD ALIGN=\"LEFT\" BGCOLOR=\"\#CCCCCC\">$dmflags_name[$i]<\/TD>\n";
 228     print "<TD ALIGN=\"CENTER\" BGCOLOR=\"\#EEEEEE\"><img src=\"http\:\/\/www.ndc.sh\/graphics\/haken.gif\"><\/TD>\n";
 229     print "<TD ALIGN=\"CENTER\" BGCOLOR=\"\#EEEEEE\">\&nbsp\;<\/TD><\/TR>\n";
 230   } else {
 231     print "<TR><TD ALIGN=\"LEFT\" BGCOLOR=\"\#CCCCCC\">$dmflags_name[$i]<\/TD>\n";
 232     print "<TD ALIGN=\"CENTER\" BGCOLOR=\"\#EEEEEE\">\&nbsp\;<\/TD>\n";
 233     print "<TD ALIGN=\"CENTER\" BGCOLOR=\"\#EEEEEE\"><img src=\"http\:\/\/www.ndc.sh\/graphics\/haken.gif\"><\/TD><\/TR>\n";
 234   }
 235 }
 236
 237 print "<\/TABLE><\/UL>\n";
 238
 239 }
 240
 241
 242 sub GetDBURL {
 243
 244 # Takes a player name from subroutine call, returns a URL if player is in
 245 # database, undef else.
 246
 247   $pl_sql_nick = shift;
 248   $pl_sql_nick_old = $pl_sql_nick;
 249
 250   $pl_sql_nick =~ s/(\\)/\\$1/g;
 251   $pl_sql_nick =~ s/(')/\\$1/g;
 252
 253   # SQL-Variables
 254
 255   $sql_database = "stats";
 256   $sql_db_table = "PlayerStats";
 257   $sql_datasource = "DBI:mysql:$sql_database";
 258   $sql_username = "";
 259   $sql_password = "";
 260   $sql_db_handle = DBI->connect($sql_datasource, $sql_username, $sql_password) or return undef;
 261
 262   $sql_query = $sql_db_handle->prepare("SELECT nick FROM $sql_db_table WHERE nick='$pl_sql_nick'");
 263   $sql_query->execute;
 264   $sql_result = $sql_query->fetchrow_hashref;
 265   $sql_query->finish;
 266
 267   if (defined($sql_result)) {
 268     $returnvalue = "\"http\:\/\/www.ndc.sh\/cgi-bin\/quake\/playerstats.pl\?nick\=" . make_compatible($pl_sql_nick_old) . "\"";
 269   } else {
 270     $returnvalue = undef;
 271   }
 272
 273   $sql_db_handle->disconnect;
 274   return $returnvalue;
 275 }
 276
 277 sub parse {
 278 # This routine takes an array as input, and parses it line by line,
 279 # echoing results to the screen.
 280 # BEWARE:
 281 # Switches like if and loop are GLOBAL!
 282
 283 my $template_line;
 284 my $if_variable;
 285 my $loop_variable;
 286 my @parser_comment;
 287 my $comment;
 288 my $fullcomment;
 289 my $replacement;
 290 my @looparray;
 291 my $clients;
 292 my $i;
 293 my $dbURL;
 294
 295 LOOP: while ($template_line = shift) {
 296         # Catch special requests
 297         if ($template_line =~ /^\s*\<!--if [\w_]+--\>/) {
 298                 ($if_variable) = $template_line =~ /\<!--if ([\w_]+)--\>/;
 299                 if ($if_variable eq "clients") {
 300                         $in_if_clients = 1;
 301                 }
 302                 if ($if_variable eq "noclients") {
 303                         $in_if_noclients = 1;
 304                 }
 305                 next LOOP;
 306         }
 307         if ($template_line =~ /^\s*\<!--endif [\w_]+--\>/) {
 308                 ($if_variable) = ($template_line =~ /\<!--endif ([\w_]+)--\>/);
 309                 if ($if_variable eq "clients") {
 310                         $in_if_clients = 0;
 311                 }
 312                 if ($if_variable eq "noclients") {
 313                         $in_if_noclients = 0;
 314                 }
 315                 next LOOP;
 316         }
 317
 318         if ($template_line =~ /^\s*\<!--loop [\w_]+--\>/) {
 319                 ($loop_variable) = ($template_line =~ /\<!--loop ([\w_]+)--\>/);
 320                 if ($if_variable eq "clients") {
 321                         $in_loop_clients = 1;
 322                 }
 323                 next LOOP;
 324         }
 325
 326         if ($template_line =~ /^\s*\<!--endloop [\w_]+--\>/) {
 327                 ($loop_variable) = ($template_line =~ /\<!--endloop ([\w_]+)--\>/);
 328                 if ($if_variable eq "clients") {
 329                         $in_loop_clients = 0;
 330                         # Now, loop through all clients and parse
 331                         # the saved loop once for each.
 332                         $i = 0;
 333                         foreach $clients ( @sortkey) {
 334                                 $dbURL = GetDBURL($clients);
 335                                 $variables{parser_clientrank} = ++$i;
 336                                 $variables{parser_clientname} = $nicks{$clients};
 337                                 if (defined($dbURL)) {
 338                                         $variables{parser_clientlink} = "<a href=$dbURL>" . $nicks{$clients} . "</a>";
 339                                         $variables{parser_clientlink_color} = "<a href=$dbURL><font color=\"#000000\">" . $nicks{$clients} . "</font></a>";
 340                                 } else {
 341                                         $variables{parser_clientlink} =  $nicks{$clients};
 342                                         $variables{parser_clientlink_color} =  $nicks{$clients};
 343                                 }
 344                                 $variables{parser_clientping} = $pings{$clients};
 345                                 $variables{parser_clientfrags} = $frags{$clients};
 346                                 parse(@looparray);
 347                         }
 348
 349                 }
 350                 next LOOP;
 351         }
 352
 353         # Check if we are to ignore these lines
 354         if (($in_if_clients == 1) && ($variables{server_actclients} == 0)) {
 355                 next LOOP;
 356         }
 357         if (($in_if_noclients == 1) && ($variables{server_actclients} != 0)) {
 358                 next LOOP;
 359         }
 360
 361         # If we are in loop mode, copy lines into an array for
 362         # later parsing
 363         if ($in_loop_clients == 1) {
 364                 push @looparray, $template_line;
 365                 next LOOP;
 366         }
 367
 368         @parser_comment = ($template_line =~ /\<!--\$([\w_]+)--\>/g);
 369         foreach $comment ( @parser_comment) {
 370                 if (defined($variables{$comment})) {
 371                         $fullcomment = "\\<!--\\\$" . $comment . "--\\>";
 372                         $replacement = $variables{$comment};
 373                         $template_line =~ s/$fullcomment/$replacement/g;
 374                 }
 375         }
 376         print $template_line;
 377 }
 378 } # end of sub
 379
 380 sub make_compatible {
 381
 382   $input = shift;
 383   $input =~ s/%/%25/g;
 384   $input =~ s/\+/%2B/g;
 385   $input =~ s/ /+/g;
 386   $input =~ s/,/%2C/g;
 387   $input =~ s/</%3C/g;
 388   $input =~ s/>/%3E/g;
 389   $input =~ s/#/%23/g;
 390   $input =~ s/\[/%5B/g;
 391   $input =~ s/\]/%5D/g;
 392   $input =~ s/\//%2F/g;
 393   $input =~ s/\|/%7C/g;
 394   $input =~ s/\?/%3F/g;
 395   $input =~ s/\x1c/%1C/g;
 396
 397   return $input;
 398 }
 399
 400 sub QueryQuakeServer {
 401
 402 # Takes a command from caller. Executes the command on the server defined by the
 403 # global variables $variables{server_address} and $variables{server_port}
 404 # Returns a literal containing the server's response.
 405
 406 my ($count, $hisiaddr, $host, $iaddr,$paddr, $port ,$proto, $hispaddr, $command, $query, $response);
 407
 408 $command = shift;
 409
 410 $iaddr = gethostbyname(hostname());
 411 $proto = getprotobyname('udp');
 412 $paddr =sockaddr_in(0 ,$iaddr);
 413
 414
 415 ### Netzwerk und auslesen der Daten ###
 416
 417 socket (SOCKET, PF_INET, SOCK_DGRAM, $proto) or &cantconnect;
 418 bind(SOCKET, $paddr) or die "bind: $!";
 419 $| = 1;
 420
 421
 422 $hisiaddr = inet_aton($variables{server_address}) or &cantconnect;
 423 $hispaddr = sockaddr_in($variables{server_port}, $hisiaddr);
 424 $query = "\xff\xff\xff\xff$command\x00";
 425 defined(send(SOCKET, $query, 0, $hispaddr)) or &cantconnect;
 426
 427 ## Timeout nach 5 sec ##
 428 $rin = "";
 429 vec($rin, fileno(SOCKET), 1) = 1;
 430 while (($response eq "" ) && select($rout = $rin, undef ,undef ,5.0))
 431 {
 432         ($hispaddr = recv(SOCKET, $response, 1000, 0)) || &cantconnect;
 433 }
 434
 435 if ($response eq "")
 436 {
 437         &cantconnect;
 438 }
 439
 440 close(SOCKET);
 441
 442 return $response;
 443
 444 }