rootwarn is borken

[infobot.git] / src / Modules / BZFlag.pl

diff --git a/src/Modules/BZFlag.pl b/src/Modules/BZFlag.pl
index b17e45df4e4684a0aaaa1a1b43308d9d321e586d..1ef0887d92b573c923e48abbc3534057d2dc01b3 100755 (executable)
--- a/src/Modules/BZFlag.pl
+++ b/src/Modules/BZFlag.pl
@@ -43,11 +43,15 @@ sub BZFlag::BZFlag {
 sub BZFlag::list {
        my ($response);
        my $ua = new LWP::UserAgent;
+       $ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam("httpProxy"));
 
        $ua->timeout(5);
 
        my $req = HTTP::Request->new('GET', 'http://list.bzflag.org:5156/');
        my $res = $ua->request($req);
+  my %servers;
+  my $totalServers = 0;
+  my $totalPlayers = 0;
        for my $line (split("\n",$res->content)) {
                my ($serverport, $version, $flags, $ip, $comments) = split(" ",$line,5);
                # not "(A4)18" to handle old dumb perl
@@ -59,10 +63,16 @@ sub BZFlag::list {
                                unpack("A4A4A4A4A4A4A4A4A4A4A4A4A4A4A4A4A4A4", $flags);
                my $playerSize = hex($rogueSize) + hex($redSize) + hex($greenSize)
                                + hex($blueSize) + hex($purpleSize);
-               if ($playerSize > 0) {
-                       $response .= "$serverport($playerSize) ";
-               }
+         $servers{$serverport} = $playerSize;
+         $totalServers += 1;
+         $totalPlayers += $playerSize;
        }
+  $response .= "s=$totalServers p=$totalPlayers";
+  foreach my $key (sort {$servers{$b} <=> $servers{$a}} (keys(%servers))) {
+               if ($servers{$key} > 0) {
+                       $response .= " $key($servers{$key})";
+               }
+  }
        &::performStrictReply($response);
        return;
 }
@@ -100,7 +110,7 @@ sub BZFlag::querytext {
 
        # get hello
        my $buffer;
-       return 'read error' unless sysread(S1, $buffer, 10) == 10;
+       return 'read error' unless read(S1, $buffer, 10) == 10;
 
        # parse reply
        my ($magic,$major,$minor,$revision);
@@ -108,9 +118,10 @@ sub BZFlag::querytext {
 
        # quit if version isn't valid
        return 'not a bzflag server' if ($magic ne "BZFS");
-       return 'incompatible version' if ($major < 1);
-       return 'incompatible version' if ($major == 1 && $minor < 7);
-       return 'incompatible version' if ($major == 1 && $minor == 7 && $revision eq "b");
+  # try incompatible for BZFlag:Zero etc.
+       $response = 'incompatible version: ' if ($major < 1);
+       $response = 'incompatible version: ' if ($major == 1 && $minor < 7);
+       $response = 'incompatible version: ' if ($major == 1 && $minor == 7 && $revision eq "b");
 
        # quit if rejected
        return 'rejected by server' if ($port == 0);
@@ -128,7 +139,7 @@ sub BZFlag::querytext {
        print S pack("n2", 0, 0x7167);
 
        # get reply
-       return 'server read error' unless sysread(S, $buffer, 40) == 40;
+       return 'server read error' unless read(S, $buffer, 40) == 40;
        my ($infolen,$infocode,$style,$maxPlayers,$maxShots,
                $rogueSize,$redSize,$greenSize,$blueSize,$purpleSize,
                $rogueMax,$redMax,$greenMax,$blueMax,$purpleMax,
@@ -140,13 +151,13 @@ sub BZFlag::querytext {
        print S pack("n2", 0, 0x7170);
 
        # get number of teams and players we'll be receiving
-       return 'count read error' unless sysread(S, $buffer, 8) == 8;
+       return 'count read error' unless read(S, $buffer, 8) == 8;
        my ($countlen,$countcode,$numTeams,$numPlayers) = unpack("n4", $buffer);
        return 'bad count data' unless $countcode == 0x7170;
 
        # get the teams
        for (1..$numTeams) {
-               return 'team read error' unless sysread(S, $buffer, 14) == 14;
+               return 'team read error' unless read(S, $buffer, 14) == 14;
                my ($teamlen,$teamcode,$team,$size,$aSize,$won,$lost) = unpack("n7", $buffer);
                return 'bad team data' unless $teamcode == 0x7475;
                if ($size > 0) {
@@ -157,7 +168,7 @@ sub BZFlag::querytext {
 
        # get the players
        for (1..$numPlayers) {
-               last unless sysread(S, $buffer, 180) == 180;
+               last unless read(S, $buffer, 180) == 180;
                my ($playerlen,$playercode,$pAddr,$pPort,$pNum,$type,$team,$won,$lost,$sign,$email) =
                                unpack("n2Nn2 n4A32A128", $buffer);
                return 'bad player data' unless $playercode == 0x6170;