X-Git-Url: https://git.donarmstrong.com/?p=infobot.git;a=blobdiff_plain;f=src%2FModules%2FBZFlag.pl;h=083173f0cb4f4552a382ee6e355410938482cf78;hp=c52d07e7ba30ac705f503586d32e6aac6394265c;hb=HEAD;hpb=ab62f29264dd979b7084e9092658287f14801c99

diff --git a/src/Modules/BZFlag.pl b/src/Modules/BZFlag.pl
old mode 100755
new mode 100644
index c52d07e..083173f
--- a/src/Modules/BZFlag.pl
+++ b/src/Modules/BZFlag.pl
@@ -18,273 +18,409 @@ use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
 my $no_BZFlag;
 
 BEGIN {
-	$no_BZFlag = 0;
-	eval "use Socket";
-	eval "use LWP::UserAgent";
-	$no_BZFlag++ if ($@);
+    $no_BZFlag = 0;
+    eval "use Socket";
+    eval "use LWP::UserAgent";
+    $no_BZFlag++ if ($@);
 }
 
-sub BZFlag::BZFlag {
-	my ($message) = @_;
-	my ($retval);
-	if ($no_BZFlag) {
-		&main::status("BZFlag module requires Socket.");
-		return 'BZFlag module not active';
-	}
-	if ($message =~ /^bzfquery\s+([^:]*)(?::([0-9]*))?$/xi) {
-		$retval = &query($1,$2);
-	} elsif ($message =~ /^bzflist$/xi) {
-		$retval = &list();
-	} else {
-		$retval = "BZFlag: unhandled command \"$message\"";
-	}
-	&::performStrictReply($retval);
+sub BZFlag {
+    my ($message) = @_;
+    my ($retval);
+    if ($no_BZFlag) {
+        &::status("BZFlag module requires Socket.");
+        return 'BZFlag module not active';
+    }
+    if ( $message =~ /^bzfquery\s+([^:]*)(?::([0-9]*))?$/xi ) {
+        $retval = &query( $1, $2 );
+    }
+    elsif ( $message =~ /^bzflist$/xi ) {
+        $retval = &list();
+    }
+    else {
+        $retval = "BZFlag: unhandled command \"$message\"";
+    }
+    &::performStrictReply($retval);
 }
 
-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://db.bzflag.org/db/?action=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
-		my ($style, $maxShots, $shakeWins, $shakeTimeout, $maxPlayerScore, $maxTeamScore, $maxTime,
-				$maxPlayers, $rogueSize, $rogueMax, $redSize, $redMax, $greenSize, $greenMax,
-				$blueSize, $blueMax, $purpleSize, $purpleMax, $observerSize, $observerMax) =
-				unpack("A4A4A4A4A4A4A4A2A2A2A2A2A2A2A2A2A2A2A2A2", $flags);
-		my $playerSize = hex($rogueSize) + hex($redSize) + hex($greenSize)
-				+ hex($blueSize) + hex($purpleSize) + hex($observerSize);
-		$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})";
-		}
+sub 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://my.bzflag.org/db/?action=LIST' );
+    my $res = $ua->request($req);
+    my %servers;
+    my $totalServers = 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
+	my ($style, $type, $maxShots, $shakeWins, $shakeTimeout, $maxPlayerScore, $maxTeamScore, $maxTime,
+	    $maxPlayers, $rogueSize, $rogueMax, $redSize, $redMax, $greenSize, $greenMax,
+	    $blueSize, $blueMax, $purpleSize, $purpleMax, $observerSize, $observerMax);
+	if (length($flags) == 54) {
+	  ($style, $maxShots, $shakeWins, $shakeTimeout, $maxPlayerScore, $maxTeamScore, $maxTime,
+	      $maxPlayers, $rogueSize, $rogueMax, $redSize, $redMax, $greenSize, $greenMax,
+	      $blueSize, $blueMax, $purpleSize, $purpleMax, $observerSize, $observerMax) =
+	      unpack("A4A4A4A4A4A4A4A2A2A2A2A2A2A2A2A2A2A2A2A2", $flags);
+	} elsif (length($flags) == 58) {
+	  ($style, $type, $maxShots, $shakeWins, $shakeTimeout, $maxPlayerScore, $maxTeamScore, $maxTime,
+	      $maxPlayers, $rogueSize, $rogueMax, $redSize, $redMax, $greenSize, $greenMax,
+	      $blueSize, $blueMax, $purpleSize, $purpleMax, $observerSize, $observerMax) =
+	      unpack("A4A4A4A4A4A4A4A4A2A2A2A2A2A2A2A2A2A2A2A2A2", $flags);
+	} else {
+	  next;
 	}
-	&::performStrictReply($response);
-	return;
+        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;
+    }
+    $response .= "s=$totalServers";
+    foreach
+      my $key ( sort { $servers{$b} <=> $servers{$a} } ( keys(%servers) ) )
+    {
+        if ( $servers{$key} > 0 ) {
+            $response .= " $key($servers{$key})";
+        }
+    }
+    &::performStrictReply($response);
+    return;
 }
 
-sub BZFlag::list17 {
-	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
-		my ($style,$maxPlayers,$maxShots,
-				$rogueSize,$redSize,$greenSize,$blueSize,$purpleSize,
-				$rogueMax,$redMax,$greenMax,$blueMax,$purpleMax,
-				$shakeWins,$shakeTimeout,
-				$maxPlayerScore,$maxTeamScore,$maxTime) =
-				unpack("A4A4A4A4A4A4A4A4A4A4A4A4A4A4A4A4A4A4", $flags);
-		my $playerSize = hex($rogueSize) + hex($redSize) + hex($greenSize)
-				+ hex($blueSize) + hex($purpleSize);
-		$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;
+sub list17 {
+    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
+        my (
+            $style,        $maxPlayers, $maxShots,     $rogueSize,
+            $redSize,      $greenSize,  $blueSize,     $purpleSize,
+            $rogueMax,     $redMax,     $greenMax,     $blueMax,
+            $purpleMax,    $shakeWins,  $shakeTimeout, $maxPlayerScore,
+            $maxTeamScore, $maxTime
+        ) = unpack( 'A4A4A4A4A4A4A4A4A4A4A4A4A4A4A4A4A4A4', $flags );
+        my $playerSize =
+          hex($rogueSize) + hex($redSize) + hex($greenSize) + hex($blueSize) +
+          hex($purpleSize);
+        $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;
 }
 
-sub BZFlag::querytext {
-	my ($servernameport) = @_;
-	my ($servername,$port) = split(":",$servernameport);
-	if ($no_BZFlag) {
-		&main::status("BZFlag module requires Socket.");
-		return 'BZFlag module not active';
-	}
-	#my @teamName = ("Rogue", "Red", "Green", "Blue", "Purple", "Observer", "Rabbit");
-	my @teamName = ("X", "R", "G", "B", "P", "O", "K");
-	my ($message, $server, $response);
-	$port = 5154 unless $port;
-
-	# socket define
-	my $sockaddr = 'S n a4 x8';
-
-	# port to port number
-	my ($name,$aliases,$proto) = getprotobyname('tcp');
-	($name,$aliases,$port)  = getservbyname($port,'tcp') unless $port =~ /^\d+$/;
-
-	# get server address
-	my ($type,$len,$serveraddr);
-	($name,$aliases,$type,$len,$serveraddr) = gethostbyname($servername);
-	$server = pack($sockaddr, AF_INET, $port, $serveraddr);
-
-	# connect
-	# TODO wrap this with a 5 second alarm()
-	return 'socket() error' unless socket(S1, AF_INET, SOCK_STREAM, $proto);
-	return "could not connect to $servername:$port" unless connect(S1, $server);
-
-	# don't buffer
-	select(S1); $| = 1; select(STDOUT);
-
-	# get hello
-	my $buffer;
-	return 'read error' unless read(S1, $buffer, 8) == 8;
-
-	# parse reply
-	my ($magic,$major,$minor,$something,$revision) = unpack("a4 a1 a1 a1 a1", $buffer);
-
-	# quit if version isn't valid
-	return 'not a bzflag server' if ($magic ne "BZFS");
-	# check version
-	if ($major == 1 && $minor == 9) {
-		$revision = $something * 10 + $revision;
-		return 'read error' unless read(S1, $buffer, 1) == 1;
-		my ($id) = unpack("C", $buffer);
-
-		# 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, 40) == 40;
-		my ($infolen,$infocode,$style,$maxPlayers,$maxShots,
-			$rogueSize,$redSize,$greenSize,$blueSize,$purpleSize,
-			$rogueMax,$redMax,$greenMax,$blueMax,$purpleMax,
-			$shakeWins,$shakeTimeout,
-			$maxPlayerScore,$maxTeamScore,$maxTime) = unpack("n20", $buffer);
-		return 'bad server data' unless $infocode == 0x7167;
-
-		# send players request
-		print S1 pack("n2", 0, 0x7170);
-
-		# get number of teams and players we'll be receiving
-		return 'count read error' unless read(S1, $buffer, 8) == 8;
-		my ($countlen,$countcode,$numTeams,$numPlayers) = unpack("n4", $buffer);
-
-		# get the teams
-		return 'bad count data' unless $countcode == 0x7170;
-		return 'count read error' unless read(S1, $buffer, 5) == 5;
-		($countlen,$countcode,$numTeams) = unpack("n n C", $buffer);
-		for (1..$numTeams) {
-			return 'team read error' unless read(S1, $buffer, 8) == 8;
-			my ($team,$size,$won,$lost) = unpack("n4", $buffer);
-			if ($size > 0) {
-				my $score = $won - $lost;
-				$response .= "$teamName[$team]:$score($won-$lost) ";
-			}
-		}
-
-		# get the players
-		for (1..$numPlayers) {
-			last unless read(S1, $buffer, 175) == 175;
-			my ($playerlen,$playercode,$pID,$type,$team,$won,$lost,$tks,$sign,$email) =
-					unpack("n2Cn5A32A128", $buffer);
-			#my ($playerlen,$playercode,$pAddr,$pPort,$pNum,$type,$team,$won,$lost,$sign,$email) =
-			#		unpack("n2Nn2 n4A32A128", $buffer);
-			return 'bad player data' unless $playercode == 0x6170;
-			my $score = $won - $lost;
-			$response .= " $sign($teamName[$team]";
-			$response .= ":$email" if ($email);
-			$response .= ")$score($won-$lost)";
-		}
-		$response .= "No Players" if ($numPlayers < 1);
-
-		# close socket
-		close(S1);
-	} elsif ($major == 1 && $minor == 0 && $something == 7) {
-		# old servers send a reconnect port number
-		return 'read error' unless read(S1, $buffer, 2) == 2;
-		my ($reconnect) = unpack("n", $buffer);
-		$minor = $minor * 10 + $something;
-		# quit if rejected
-		return 'rejected by server' if ($reconnect == 0);
-
-		# reconnect on new port
-		$server = pack($sockaddr, AF_INET, $reconnect, $serveraddr);
-		return 'socket() error on reconnect' unless socket(S, AF_INET, SOCK_STREAM, $proto);
-		return "could not reconnect to $servername:$reconnect" unless connect(S, $server);
-		select(S); $| = 1; select(STDOUT);
-
-		# close first socket
-		close(S1);
-
-		# send game request
-		print S pack("n2", 0, 0x7167);
-
-		# get reply
-		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,
-			$shakeWins,$shakeTimeout,
-			$maxPlayerScore,$maxTeamScore,$maxTime) = unpack("n20", $buffer);
-		return 'bad server data' unless $infocode == 0x7167;
-
-		# send players request
-		print S pack("n2", 0, 0x7170);
-
-		# get number of teams and players we'll be receiving
-		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 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) {
-				my $score = $won - $lost;
-				$response .= "$teamName[$team]:$score($won-$lost) ";
-			}
-		}
-
-		# get the players
-		for (1..$numPlayers) {
-			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;
-			my $score = $won - $lost;
-			$response .= " $sign($teamName[$team]";
-			$response .= ":$email" if ($email);
-			$response .= ")$score($won-$lost)";
-		}
-		$response .= "No Players" if ($numPlayers <= 1);
-
-		# close socket
-		close(S);
-	} else {
-		$response = 'incompatible version';
-	}
-
-	return $response;
+sub querytext {
+    my ($servernameport) = @_;
+    my ( $servername, $port ) = split( ":", $servernameport );
+    if ($no_BZFlag) {
+        &::status("BZFlag module requires Socket.");
+        return 'BZFlag module not active';
+    }
+
+#my @teamName = ('Rogue', 'Red', 'Green', 'Blue', 'Purple', 'Observer', 'Rabbit');
+    my @teamName = ( 'X', 'R', 'G', 'B', 'P', 'O', 'K' );
+    my ( $message, $server, $response );
+    $port = 5154 unless $port;
+
+    # socket define
+    my $sockaddr = 'S n a4 x8';
+
+    # port to port number
+    my ( $name, $aliases, $proto ) = getprotobyname('tcp');
+    ( $name, $aliases, $port ) = getservbyname( $port, 'tcp' )
+      unless $port =~ /^\d+$/;
+
+    # get server address
+    my ( $type, $len, $serveraddr );
+    ( $name, $aliases, $type, $len, $serveraddr ) = gethostbyname($servername);
+    $server = pack( $sockaddr, AF_INET, $port, $serveraddr );
+
+    # connect
+    # TODO wrap this with a 5 second alarm()
+    return 'socket() error' unless socket( S1, AF_INET, SOCK_STREAM, $proto );
+    return "could not connect to $servername:$port"
+      unless connect( S1, $server );
+
+    # don't buffer
+    select(S1);
+    $| = 1;
+    select(STDOUT);
+
+    # get hello
+    my $buffer;
+    return 'read error' unless read( S1, $buffer, 8 ) == 8;
+
+    # parse reply
+    my ( $magic, $major, $minor, $something, $revision ) =
+      unpack( "a4 a1 a1 a1 a1", $buffer );
+    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 '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 );
+
+        # send game request
+        print S1 pack( 'n2', 0, 0x7167 );
+
+        # get reply
+        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, $maxPlayerScore, $maxTeamScore, $maxTime,
+            $timeElapsed
+        ) = unpack( 'n23', $buffer );
+        return "bad server data $infocode" unless $infocode == 0x7167;
+
+        # send players request
+        print S1 pack( 'n2', 0, 0x7170 );
+
+        # get number of teams and players we'll be receiving
+        return 'count read error' unless read( S1, $buffer, 8 ) == 8;
+        my ( $countlen, $countcode, $numTeams, $numPlayers ) =
+          unpack( 'n4', $buffer );
+
+        # get the teams
+        return 'bad count data' unless $countcode == 0x7170;
+        return 'count read error' unless read( S1, $buffer, 5 ) == 5;
+        ( $countlen, $countcode, $numTeams ) = unpack( "n n C", $buffer );
+        for ( 1 .. $numTeams ) {
+            return 'team read error' unless read( S1, $buffer, 8 ) == 8;
+            my ( $team, $size, $won, $lost ) = unpack( 'n4', $buffer );
+            if ( $size > 0 ) {
+                my $score = $won - $lost;
+                $response .= "$teamName[$team]:$score($won-$lost) ";
+            }
+        }
+
+        # get the players
+        for ( 1 .. $numPlayers ) {
+            last unless read( S1, $buffer, 175 ) == 175;
+            my (
+                $playerlen, $playercode, $pID, $type, $team,
+                $won,       $lost,       $tks, $sign, $email
+            ) = unpack( 'n2Cn5A32A128', $buffer );
+
+#my ($playerlen,$playercode,$pAddr,$pPort,$pNum,$type,$team,$won,$lost,$sign,$email) =
+#		unpack("n2Nn2 n4A32A128", $buffer);
+            return 'bad player data' unless $playercode == 0x6170;
+            my $score = $won - $lost;
+            $response .= " $sign($teamName[$team]";
+            $response .= ":$email" if ($email);
+            $response .= ")$score($won-$lost)";
+        }
+        $response .= "No Players" if ( $numPlayers < 1 );
+
+        # close socket
+    }
+    elsif ( $major == 1 && $minor == 9 ) {
+
+        # 1.10.x handled here
+        $revision = $something * 10 + $revision;
+        return 'read error' unless read( S1, $buffer, 1 ) == 1;
+        my ($id) = unpack( 'C', $buffer );
+
+        # 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, 40 ) == 40;
+        my (
+            $infolen,      $infocode,       $style,        $maxPlayers,
+            $maxShots,     $rogueSize,      $redSize,      $greenSize,
+            $blueSize,     $purpleSize,     $rogueMax,     $redMax,
+            $greenMax,     $blueMax,        $purpleMax,    $shakeWins,
+            $shakeTimeout, $maxPlayerScore, $maxTeamScore, $maxTime
+        ) = unpack( 'n20', $buffer );
+        return 'bad server data' unless $infocode == 0x7167;
+
+        # send players request
+        print S1 pack( 'n2', 0, 0x7170 );
+
+        # get number of teams and players we'll be receiving
+        return 'count read error' unless read( S1, $buffer, 8 ) == 8;
+        my ( $countlen, $countcode, $numTeams, $numPlayers ) =
+          unpack( 'n4', $buffer );
+
+        # get the teams
+        return 'bad count data' unless $countcode == 0x7170;
+        return 'count read error' unless read( S1, $buffer, 5 ) == 5;
+        ( $countlen, $countcode, $numTeams ) = unpack( "n n C", $buffer );
+        for ( 1 .. $numTeams ) {
+            return 'team read error' unless read( S1, $buffer, 8 ) == 8;
+            my ( $team, $size, $won, $lost ) = unpack( 'n4', $buffer );
+            if ( $size > 0 ) {
+                my $score = $won - $lost;
+                $response .= "$teamName[$team]:$score($won-$lost) ";
+            }
+        }
+
+        # get the players
+        for ( 1 .. $numPlayers ) {
+            last unless read( S1, $buffer, 175 ) == 175;
+            my (
+                $playerlen, $playercode, $pID, $type, $team,
+                $won,       $lost,       $tks, $sign, $email
+            ) = unpack( 'n2Cn5A32A128', $buffer );
+
+#my ($playerlen,$playercode,$pAddr,$pPort,$pNum,$type,$team,$won,$lost,$sign,$email) =
+#		unpack("n2Nn2 n4A32A128", $buffer);
+            return 'bad player data' unless $playercode == 0x6170;
+            my $score = $won - $lost;
+            $response .= " $sign($teamName[$team]";
+            $response .= ":$email" if ($email);
+            $response .= ")$score($won-$lost)";
+        }
+        $response .= "No Players" if ( $numPlayers < 1 );
+
+        # close socket
+        close(S1);
+    }
+    elsif ( $major == 1 && $minor == 0 && $something == 7 ) {
+
+        # 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 );
+        $minor = $minor * 10 + $something;
+
+        # quit if rejected
+        return 'rejected by server' if ( $reconnect == 0 );
+
+        # reconnect on new port
+        $server = pack( $sockaddr, AF_INET, $reconnect, $serveraddr );
+        return 'socket() error on reconnect'
+          unless socket( S, AF_INET, SOCK_STREAM, $proto );
+        return "could not reconnect to $servername:$reconnect"
+          unless connect( S, $server );
+        select(S);
+        $| = 1;
+        select(STDOUT);
+
+        # close first socket
+        close(S1);
+
+        # send game request
+        print S pack( 'n2', 0, 0x7167 );
+
+        # get reply
+        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,    $shakeWins,
+            $shakeTimeout, $maxPlayerScore, $maxTeamScore, $maxTime
+        ) = unpack( 'n20', $buffer );
+        return 'bad server data' unless $infocode == 0x7167;
+
+        # send players request
+        print S pack( 'n2', 0, 0x7170 );
+
+        # get number of teams and players we'll be receiving
+        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 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 ) {
+                my $score = $won - $lost;
+                $response .= "$teamName[$team]:$score($won-$lost) ";
+            }
+        }
+
+        # get the players
+        for ( 1 .. $numPlayers ) {
+            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;
+            my $score = $won - $lost;
+            $response .= " $sign($teamName[$team]";
+            $response .= ":$email" if ($email);
+            $response .= ")$score($won-$lost)";
+        }
+        $response .= "No Players" if ( $numPlayers <= 1 );
+
+        # close socket
+        close(S);
+    }
+    else {
+        $response = "incompatible version: $version";
+    }
+
+    return $response;
 }
 
-sub BZFlag::query {
-	my ($servernameport) = @_;
-	&::performStrictReply(&querytext($servernameport));
-	return;
+sub query {
+    my ($servernameport) = @_;
+    &::performStrictReply( &querytext($servernameport) );
+    return;
 }
 
 1;
-# vim: ts=2 sw=2
+
+# vim:ts=4:sw=4:expandtab:tw=80