* support more dictionaries [dpkg specific]

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

diff --git a/src/Modules/BZFlag.pl b/src/Modules/BZFlag.pl
index f8d51f999541e363da15501f07548d6249206bdb..518efbe8d500d98613e2546225d61ba8bdad6007 100755 (executable)
--- a/src/Modules/BZFlag.pl
+++ b/src/Modules/BZFlag.pl
@@ -28,7 +28,7 @@ sub BZFlag {
        my ($message) = @_;
        my ($retval);
        if ($no_BZFlag) {
-               &main::status("BZFlag module requires Socket.");
+               &::status("BZFlag module requires Socket.");
                return 'BZFlag module not active';
        }
        if ($message =~ /^bzfquery\s+([^:]*)(?::([0-9]*))?$/xi) {
@@ -52,7 +52,6 @@ sub list {
        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
@@ -63,10 +62,11 @@ sub list {
                my $playerSize = hex($rogueSize) + hex($redSize) + hex($greenSize)
                                + hex($blueSize) + hex($purpleSize) + hex($observerSize);
                $servers{$serverport} = $playerSize;
+               $servers{$version} += $playerSize;
+               $servers{'PLAYERS'} += $playerSize;
                $totalServers += 1;
-               $totalPlayers += $playerSize;
        }
-       $response .= "s=$totalServers p=$totalPlayers";
+       $response .= "s=$totalServers";
        foreach my $key (sort {$servers{$b} <=> $servers{$a}} (keys(%servers))) {
                if ($servers{$key} > 0) {
                        $response .= " $key($servers{$key})";
@@ -117,7 +117,7 @@ sub querytext {
        my ($servernameport) = @_;
        my ($servername,$port) = split(":",$servernameport);
        if ($no_BZFlag) {
-               &main::status("BZFlag module requires Socket.");
+               &::status("BZFlag module requires Socket.");
                return 'BZFlag module not active';
        }
        #my @teamName = ("Rogue", "Red", "Green", "Blue", "Purple", "Observer", "Rabbit");
@@ -130,7 +130,7 @@ sub querytext {
 
        # port to port number
        my ($name,$aliases,$proto) = getprotobyname('tcp');
-       ($name,$aliases,$port)  = getservbyname($port,'tcp') unless $port =~ /^\d+$/;
+       ($name,$aliases,$port) = getservbyname($port,'tcp') unless $port =~ /^\d+$/;
 
        # get server address
        my ($type,$len,$serveraddr);
@@ -151,24 +151,36 @@ sub querytext {
 
        # parse reply
        my ($magic,$major,$minor,$something,$revision) = unpack("a4 a1 a1 a1 a1", $buffer);
-  my ($version) = $magic . $major . $minor . $something . $revision;
+       my ($version) = $magic . $major . $minor . $something . $revision;
 
        # quit if version isn't valid
        return 'not a bzflag server' if ($magic ne "BZFS");
+       $response .= "$major$minor$something$revision ";
        # check version
-       if ($version eq "BZFS0025") {
+       if ($version eq "BZFS0026") {
                # 1.11.x handled here
                return 'read error' unless read(S1, $buffer, 1) == 1;
                my ($id) = unpack("C", $buffer);
-    return "rejected by server" if ($id == 255);
+               return "rejected by server" if ($id == 255);
 
                # send game request
                print S1 pack("n2", 0, 0x7167);
 
-               # FIXME the packets are wrong from here down
                # get reply
-               return 'server read error' unless read(S1, $buffer, 46) == 46;
-    my ($infolen,$infocode,$style,$maxPlayers,$maxShots,
+               my $nbytes = read(S1, $buffer, 4);
+               my ($infolen, $infocode) = unpack("n2", $buffer);
+               if ($infocode == 0x6774) {
+                       # read and ignore MsgGameTime from new servers
+                       $nbytes = read(S1, $buffer, 8);
+                       $nbytes = read(S1, $buffer, 4);
+                 ($infolen, $infocode) = unpack("n2", $buffer);
+               }
+               $nbytes = read(S1, $buffer, 42);
+               if ($nbytes != 42) {
+                       return "Error: read $nbytes bytes, expecting 46: $^E\n";
+               }
+
+               my ($style,$maxPlayers,$maxShots,
                        $rogueSize,$redSize,$greenSize,$blueSize,$purpleSize,$observerSize,
                        $rogueMax,$redMax,$greenMax,$blueMax,$purpleMax,$observerMax,
                        $shakeWins,$shakeTimeout,
@@ -268,7 +280,7 @@ sub querytext {
                # close socket
                close(S1);
        } elsif ($major == 1 && $minor == 0 && $something == 7) {
-    # 1.7* versions handled here
+               # 1.7* versions handled here
                # old servers send a reconnect port number
                return 'read error' unless read(S1, $buffer, 2) == 2;
                my ($reconnect) = unpack("n", $buffer);