$no_BZFlag++ if ($@);
}
-sub BZFlag::BZFlag {
+sub BZFlag {
my ($message) = @_;
- my ($retval);
+ 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) {
$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->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;
+ 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, $maxShots, $shakeWins, $shakeTimeout, $maxPlayerScore, $maxTeamScore, $maxTime,
$maxPlayers, $rogueSize, $rogueMax, $redSize, $redMax, $greenSize, $greenMax,
$blueSize, $blueMax, $purpleSize, $purpleMax, $observerSize, $observerMax) =
- unpack("A4A4A4A4A4A4A4A2A2A2A2A2A2A2A2A2A2A2A2A2", $flags);
+ unpack('A4A4A4A4A4A4A4A2A2A2A2A2A2A2A2A2A2A2A2A2', $flags);
my $playerSize = hex($rogueSize) + hex($redSize) + hex($greenSize)
+ hex($blueSize) + hex($purpleSize) + hex($observerSize);
- $servers{$serverport} = $playerSize;
- $totalServers += 1;
- $totalPlayers += $playerSize;
+ $servers{$serverport} = $playerSize;
+ $servers{$version} += $playerSize;
+ $servers{'PLAYERS'} += $playerSize;
+ $totalServers += 1;
}
- $response .= "s=$totalServers p=$totalPlayers";
- foreach my $key (sort {$servers{$b} <=> $servers{$a}} (keys(%servers))) {
+ $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 {
+sub list17 {
my ($response);
my $ua = new LWP::UserAgent;
- $ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam("httpProxy"));
+ $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;
+ 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
$rogueMax,$redMax,$greenMax,$blueMax,$purpleMax,
$shakeWins,$shakeTimeout,
$maxPlayerScore,$maxTeamScore,$maxTime) =
- unpack("A4A4A4A4A4A4A4A4A4A4A4A4A4A4A4A4A4A4", $flags);
+ 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.");
+ &::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 = 5154 unless $port;
# 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);
$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);
# 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");
- # check version
- if ($major == 1 && $minor == 9) {
- $revision = $something * 10 + $revision;
- $response = "version: $magic $major $minor $revision";
+ 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);
+ 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
$rogueSize,$redSize,$greenSize,$blueSize,$purpleSize,
$rogueMax,$redMax,$greenMax,$blueMax,$purpleMax,
$shakeWins,$shakeTimeout,
- $maxPlayerScore,$maxTeamScore,$maxTime) = unpack("n20", $buffer);
+ $maxPlayerScore,$maxTeamScore,$maxTime) = unpack('n20', $buffer);
return 'bad server data' unless $infocode == 0x7167;
# send players request
- print S1 pack("n2", 0, 0x7170);
+ 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);
- return 'bad count data' unless $countcode == 0x7170;
+ 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, 14) == 14;
- my ($teamlen,$teamcode,$team,$size,$aSize,$won,$lost) = unpack("n7", $buffer);
- return 'bad team data' unless $teamcode == 0x7475;
+ 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, 180) == 180;
- my ($playerlen,$playercode,$pAddr,$pPort,$pNum,$type,$team,$won,$lost,$sign,$email) =
- unpack("n2Nn2 n4A32A128", $buffer);
+ 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);
+ $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;
+ # 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);
close(S1);
# send game request
- print S pack("n2", 0, 0x7167);
+ print S pack('n2', 0, 0x7167);
# get reply
return 'server read error' unless read(S, $buffer, 40) == 40;
$rogueSize,$redSize,$greenSize,$blueSize,$purpleSize,
$rogueMax,$redMax,$greenMax,$blueMax,$purpleMax,
$shakeWins,$shakeTimeout,
- $maxPlayerScore,$maxTeamScore,$maxTime) = unpack("n20", $buffer);
+ $maxPlayerScore,$maxTeamScore,$maxTime) = unpack('n20', $buffer);
return 'bad server data' unless $infocode == 0x7167;
# send players request
- print S pack("n2", 0, 0x7170);
+ 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);
+ 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);
+ 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;
# close socket
close(S);
- } else {
- $response = 'incompatible version';
+ } else {
+ $response = "incompatible version: $version";
}
return $response;
}
-sub BZFlag::query {
+sub query {
my ($servernameport) = @_;
&::performStrictReply(&querytext($servernameport));
- return;
+ return;
}
1;