001 #!/usr/local/bin/perl 002 003 004 # 005 # game_server - collect and display server-stats... 006 # nostromo, Wed Apr 20 16:45:04 2005 007 # 008 009 use LWP::Simple; 010 use IO::Socket; 011 use HTML::TableExtract; 012 013 if($ENV{'QUERY_STRING'} eq "source") 014 { 015 $line_counter = 1; 016 print "Document-Type: text/html\n\n"; 017 $format = "^>> "; 018 019 open(SRC, "< $0"); 020 while() 021 { 022 formline($format, (sprintf("%03i", $line_counter++))); 023 print("$^A $_"); 024 $^A = ""; 025 } 026 exit; 027 } 028 029 %links_q3 = ("1http://www.quake3arena.com" 030 => "main site", 031 "2http://www.slackshack.org/files/PointRelease/linux/linuxq3apoint-1.32b-3.x86.run" 032 => "lnx pr1.32b-3", 033 "3http://www.slackshack.org/files/PointRelease/win/q3pointrelease_132.exe" 034 => "win pr1.32"); 035 036 %links_ra = ("1http://www.planetquake.com/arena" 037 => "main site", 038 "2ftp://ftp.clanbase.com/pub/ra3176.zip" 039 => "lnx mod-dl", 040 "3ftp://ftp.edome.net/online/clientit/ra3176.exe" 041 => "win mod-dl"); 042 043 %links_df = ("1http://www.planetquake.com/defrag" 044 => "main site", 045 "2http://defrag.own-age.com/defrag/defrag_1.91.02.zip" 046 => "lnx mod-dl", 047 "3http://defrag.own-age.com/defrag/defrag_1.91.02.zip" 048 => "win mod-dl", 049 "4http://www.defrag-france.net/fichiers/defragpak3.zip" 050 => "map pack3"); 051 052 %links_et = ("1http://enemy-territory.com" 053 => "main site", 054 "2http://www.nofrag.com/fichiers/rtcw/et/976/et-linux-2.60.x86.run" 055 => "lnx v2.60", 056 "3http://dl.mrbass.org/et/wolfet.exe" 057 => "win v2.60"); 058 059 %links_etp = ("1http://etpro.anime.net/publicbeta" 060 => "main site", 061 "2http://etpro.anime.net/publicbeta/etpro-3_1_12.zip" 062 => "lnx/win dl"); 063 064 &print_header; 065 &print_hr("100"); 066 &print_heading("game server"); 067 &print_hr("100"); 068 # &stats_netpanzer; 069 # &print_hr("50"); 070 # &stats_mangband; 071 &print_hr("50"); 072 &stats_crossfire; 073 &print_hr("50"); 074 &stats_quake3("ffa", 27960); 075 &print_hr("50"); 076 &stats_quake3("ra", 27961); 077 &print_hr("50"); 078 # &stats_quake3("defrag", 27962); 079 #&print_hr("50"); 080 &stats_quake3("osp", 27962); 081 &print_hr("50"); 082 # &stats_et( 27963); 083 &print_hr("100"); 084 &print_heading("files"); 085 &print_hr("100"); 086 &print_links("ffa", %links_q3); 087 &print_hr("50"); 088 &print_links("ra", %links_ra); 089 &print_hr("50"); 090 # &print_links("defrag", %links_df); 091 #&print_hr("50"); 092 # &print_links("et", %links_et); 093 # &print_hr("50"); 094 # &print_links("et-pro", %links_etp); 095 #&print_hr("50"); 096 &print_pb; 097 &print_hr("100"); 098 &print_footer; 099 100 sub print_header 101 { 102 print < 107 108 game_server 109 110 111 112 113 114
115
116 
117 118 EO_HEADER 119 } 120 121 sub print_heading 122 { 123 my($heading) = @_; 124 125 print < 127 130 131 EO_HEADING 132 } 133 134 sub print_footer 135 { 136 print < 138 139 140 back 141 142 143 144 EO_FOOTER 145 } 146 147 sub stats_netpanzer 148 { 149 $message = 0; 150 $sock = new IO::Socket::INET (PeerAddr => '127.0.0.1', 151 PeerPort => '3030', 152 Proto => 'udp', 153 ); 154 die "Socket could not be created. Reason: $!\n" unless $sock; 155 156 while($message == 0) 157 { 158 $sock->send("\\\\status\\\\final\\\\"); 159 $sock->recv($text, 256); 160 if($text =~ /^gamename/) 161 { 162 $message = 1; 163 } 164 else 165 { 166 $sock->send("\\\\status\\\\final\\\\"); 167 } 168 } 169 170 print < 172 175 200 226 EO_TABLEE 227 } 228 229 sub stats_crossfire 230 { 231 my $players = ""; 232 my $version = ""; 233 my $remote = ""; 234 my $url = "http://crossfire.real-time.com/metaserver/"; 235 236 print < 238 241 265 EO_TABLEE 266 } 267 268 sub stats_quake3 269 { 270 my($gtype, $port) = @_; 271 my %qstat_in = (); 272 my $qcmd = "/usr/local/bin/qstat -sort F -P -q3s 193.170.32.26:$port"; 273 274 open(CMD_IN, "$qcmd |") or die "$!"; 275 276 while() 277 { 278 next if (/^A/); 279 m/^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})(:\d{5})\s*(\d+\/\ *\d+)\s*(.*)\s*(\d+)\ *\/\ *(\d+)\s*(.*)/; 280 # 193.170.32.26:27964 0/ 2 q3dm6 3 / 0 osp nostromos OSP Q3 server 281 # 193.170.32.26:27961 0/10 ra3map7 1 / 0 arena nostromos rocketarena 282 $qstat_in{address} = $1; 283 $qstat_in{players} = $3; 284 $qstat_in{map} = $4; 285 $qstat_in{time} = $5; 286 $qstat_in{name} = $6; 287 288 } 289 290 print < 292 293 294 297 \n" . 308 ""; 309 } 310 311 sub stats_et 312 { 313 my $port = shift; 314 my %qstat_in = (); 315 my $qcmd = "/usr/local/bin/qstat -sort F -P -q3s 193.170.32.26:$port"; 316 317 open(CMD_IN, "$qcmd |") or die "$!"; 318 319 while() 320 { 321 next if (/^A/); 322 m/^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}).*(\d+\/\d+)\s*(\w+)\s*(\d+)\ *\/\ *(\d+)\s*(.*)/; 323 $qstat_in{address} = $1; 324 $qstat_in{players} = $2; 325 $qstat_in{map} = $3; 326 $qstat_in{time} = $5; 327 $qstat_in{name} = $6; 328 } 329 330 print < 332 333 334 337 \n" . 348 ""; 349 } 350 351 sub print_links 352 { 353 my($g_type, %links) = @_; 354 my($spacer) = " "x6; 355 356 print ""; 365 } 366 367 sub print_pb 368 { 369 print < 371 374 377 378 EO_TABLE 379 # et-pbsec (put this into "\$ET_HOME/pb/htm") 380 } 381 382 sub print_hr 383 { 384 my($percent) = @_; 385 print < 387 390 391 EO_HR 392 }
128
\U$heading\E:
129
173
netpanzer:
174
176 EO_TABLE 177 178 ($protocol, $hostname, $mapname, $numplayers, $maxplayers, 179 $timelimit, $fraglimit) = (split(/\\/, $text))[3,5,7,11,13,21,23]; 180 print "
players:   $numplayers/$maxplayers\n"      .
181                        "procotol:  $protocol\n"                                 .
182                        "mapname:   $mapname\n"                                  .
183                        "timelimit: $timelimit\n"                                .
184                        "fraglimit: $fraglimit\n"                                ;
185     close($sock);
186 }
187 
188 sub stats_mangband
189 {
190     my $players = "";
191     my $version = "";
192     my $remote  = "";
193     my $url     = "http://www.mangband.org/cgi-bin/meta.pl";
194 
195     print <
197     
198
mangband:
199
201 EO_TABLE 202 203 my $data = LWP::Simple::get($url) or die "master-site down\n"; 204 my $te = new HTML::TableExtract; 205 $te->parse($data); 206 207 $te->tables_report(); 208 209 foreach my $row ($te->rows) 210 { 211 foreach my $col (@$row) 212 { 213 next unless ($col =~ /leo.risc.uni-linz.ac.at/); 214 $players = $row->[1]; 215 $version = $row->[3]; 216 217 print "
players:   $players\nversion:   "    .
218                   "$version
\n" ; 219 last; 220 } 221 } 222 223 print < 225
239
crossfire:
240
242 EO_TABLE 243 244 my $data = LWP::Simple::get($url) or die "master-site down\n"; 245 my $te = new HTML::TableExtract; 246 $te->parse($data); 247 248 foreach my $row ($te->rows) 249 { 250 foreach my $col (@$row) 251 { 252 next unless ($col =~ /nostromo.joeh.org/); 253 $players = $row->[4]; 254 $version = $row->[5]; 255 256 print "
players:   " .
257                   "$players\nversion:   $version
\n" ; 258 last; 259 } 260 } 261 262 print < 264
295
quake3: $gtype 
296
298 EO_TABLE 299 300 print "
address:   $qstat_in{address}\n" .
301           "players:   $qstat_in{players}\n"         .
303           "map:       $qstat_in{map}\n"          .
304           "time:      $qstat_in{time}\n"         .
305           "name:      $qstat_in{name}\n"         .
306           "game_type: $gtype\n"                  .
307           "port:      $port
\n
335
et: 
336
338 EO_TABLE 339 340 print "
address:   $qstat_in{address}\n" .
341           "players:   $qstat_in{players}\n"         .
343           "map:       $qstat_in{map}\n"          .
344           "time:      $qstat_in{time}\n"         .
345           "name:      $qstat_in{name}\n"         .
346 #         "game_type: $gtype\n"                  .
347           "port:      $port
\n
$g_type:
";
357 
358     foreach $i (sort keys %links)
359     {
360         print "$links{$i}\n";
363     }
364     print "
372
punkbuster:
373
375
q3-pbsec (put this into "\$Q3_HOME/pb/htm")
376     
388
389