X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=src%2FModules%2FBZFlag.pl;h=26ce457e3cccaed6a4d60d3110ac997333f1164e;hb=b229ae39da80543887f9fd0ae46591070146d31f;hp=1ef0887d92b573c923e48abbc3534057d2dc01b3;hpb=30ddea7c378b266806ca5684e4853961d96f935a;p=infobot.git

diff --git a/src/Modules/BZFlag.pl b/src/Modules/BZFlag.pl
index 1ef0887..26ce457 100755
--- a/src/Modules/BZFlag.pl
+++ b/src/Modules/BZFlag.pl
@@ -13,6 +13,7 @@
 
 package BZFlag;
 use strict;
+use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
 
 my $no_BZFlag;
 
@@ -23,9 +24,9 @@ BEGIN {
 	$no_BZFlag++ if ($@);
 }
 
-sub BZFlag::BZFlag {
+sub BZFlag {
 	my ($message) = @_;
-  my ($retval);
+	my ($retval);
 	if ($no_BZFlag) {
 		&main::status("BZFlag module requires Socket.");
 		return 'BZFlag module not active';
@@ -34,13 +35,48 @@ sub BZFlag::BZFlag {
 		$retval = &query($1,$2);
 	} elsif ($message =~ /^bzflist$/xi) {
 		$retval = &list();
-  } else {
+	} else {
 		$retval = "BZFlag: unhandled command \"$message\"";
 	}
 	&::performStrictReply($retval);
 }
 
-sub BZFlag::list {
+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://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})";
+		}
+	}
+	&::performStrictReply($response);
+	return;
+}
+
+sub list17 {
 	my ($response);
 	my $ua = new LWP::UserAgent;
 	$ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam("httpProxy"));
@@ -49,9 +85,9 @@ sub BZFlag::list {
 
 	my $req = HTTP::Request->new('GET', 'http://list.bzflag.org:5156/');
 	my $res = $ua->request($req);
-  my %servers;
-  my $totalServers = 0;
-  my $totalPlayers = 0;
+	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,31 +99,31 @@ sub BZFlag::list {
 				unpack("A4A4A4A4A4A4A4A4A4A4A4A4A4A4A4A4A4A4", $flags);
 		my $playerSize = hex($rogueSize) + hex($redSize) + hex($greenSize)
 				+ hex($blueSize) + hex($purpleSize);
-	  $servers{$serverport} = $playerSize;
-	  $totalServers += 1;
-	  $totalPlayers += $playerSize;
+		$servers{$serverport} = $playerSize;
+		$totalServers += 1;
+		$totalPlayers += $playerSize;
 	}
-  $response .= "s=$totalServers p=$totalPlayers";
-  foreach my $key (sort {$servers{$b} <=> $servers{$a}} (keys(%servers))) {
+	$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 {
+sub 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");
-	my @teamName = ("X", "R", "G", "B", "P");
+	#my @teamName = ("Rogue", "Red", "Green", "Blue", "Purple", "Observer", "Rabbit");
+	my @teamName = ("X", "R", "G", "B", "P", "O", "K");
 	my ($message, $server, $response);
-	$port = 5155 unless $port;
+	$port = 5154 unless $port;
 
 	# socket define
 	my $sockaddr = 'S n a4 x8';
@@ -102,6 +138,7 @@ sub BZFlag::querytext {
 	$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);
 
@@ -110,85 +147,143 @@ sub BZFlag::querytext {
 
 	# get hello
 	my $buffer;
-	return 'read error' unless read(S1, $buffer, 10) == 10;
+	return 'read error' unless read(S1, $buffer, 8) == 8;
 
 	# parse reply
-	my ($magic,$major,$minor,$revision);
-	($magic,$major,$minor,$revision,$port) = unpack("a4 a1 a2 a1 n", $buffer);
+	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");
-  # 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");
+	# 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);
 
-	# quit if rejected
-	return 'rejected by server' if ($port == 0);
+		# send game request
+		print S1 pack("n2", 0, 0x7167);
 
-	# reconnect on new port
-	$server = pack($sockaddr, AF_INET, $port, $serveraddr);
-	return 'socket() error on reconnect' unless socket(S, AF_INET, SOCK_STREAM, $proto);
-	return "could not reconnect to $servername:$port" 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) {
+		# 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 .= "$teamName[$team]:$score($won-$lost) ";
+			$response .= " $sign($teamName[$team]";
+			$response .= ":$email" if ($email);
+			$response .= ")$score($won-$lost)";
 		}
-	}
+		$response .= "No Players" if ($numPlayers < 1);
 
-	# 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(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);
 
-	# close socket
-	close(S);
+		# 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 BZFlag::query {
+sub query {
 	my ($servernameport) = @_;
 	&::performStrictReply(&querytext($servernameport));
-  return;
+	return;
 }
 
 1;