3 # no warranty for this script
9 use FindBin; use lib $FindBin::Bin;
12 use sigtrap qw(die normal-signals);
13 use WeaponEncounterProfile;
24 9 => "Rocket Launcher",
25 10 => "Port-O-Launch",
27 12 => "Grappling Hook",
28 13 => "Heavy Laser Assault Cannon",
29 14 => "T.A.G. Seeker",
30 15 => "Camping Rifle",
34 my ($statsfile) = @ARGV;
35 my $password = $ENV{rcon_password};
36 my $server = $ENV{rcon_address};
37 my $bind = $ENV{rcon_bindaddress};
43 my ($addr, $map, $attackerweapon, $targweapon, $type) = @_;
44 $stats->event($addr, $map, $attackerweapon, $targweapon, $type);
54 $stats = WeaponEncounterProfile->new($statsfile);
59 print STDERR "Operation timed out.\n";
63 our @discosockets = ();
66 # connects to a DP server using rcon with log_dest_udp
68 my $value = sprintf "%s:%d", $sock->sockhost(), $sock->sockport();
69 $sock->send("\377\377\377\377rcon $password log_dest_udp", 0)
70 or die "send rcon: $!";
74 $sock->recv(my $response, 2048, 0)
76 if($response =~ /^\377\377\377\377n"log_dest_udp" is "(.*)" \[".*"\]\n$/s)
79 my @dests = split /\s+/, $1;
81 if grep { $_ eq $value } @dests;
83 $sock->send("\377\377\377\377rcon $password log_dest_udp \"@dests\"");
88 push @discosockets, [$sock, $value];
95 # disconnects (makes the server stop send the data to us)
96 $s->send("\377\377\377\377rcon $password log_dest_udp", 0)
97 or die "send rcon: $!";
101 $s->recv(my $response, 2048, 0)
103 if($response =~ /^\377\377\377\377n"log_dest_udp" is "(.*)" \[".*"\]\n$/s)
106 my @dests = split /\s+/, $1;
108 if not grep { $_ eq $v } @dests;
109 @dests = grep { $_ ne $v } @dests;
110 $s->send("\377\377\377\377rcon $password log_dest_udp \"@dests\"");
119 sub sockaddr_readable($)
122 my ($port, $addr) = sockaddr_in $binary;
123 return sprintf "%s:%d", inet_ntoa($addr), $port;
129 # bind to a port and wait for any packets
130 $sock = IO::Socket::INET->new(Proto => 'udp', LocalAddr => $bind, LocalPort => 26000)
135 # connect to a DP server
136 $sock = IO::Socket::INET->new(Proto => 'udp', PeerAddr => $server, PeerPort => 26000)
145 while(my $addr = sockaddr_readable $sock->recv($_, 2048, 0))
148 if not defined $bind;
149 s/^\377\377\377\377n//
151 for(split /\r?\n/, $_)
153 if(/^:gamestart:([^:]+):/)
156 $currentmap{$addr} = $1;
158 print "($addr) switching to $1\n";
163 unless defined $currentmap{$addr};
164 if(/^:join:(\d+):bot:/)
166 $bots{$addr}{$1} = 1;
168 elsif(/^:kill:frag:(\d+):(\d+):type=(\d+):items=(\d+)([A-Z]*)(?:|(\d+)):victimitems=(\d+)([A-Z]*)(?:|(\d+))$/)
170 my ($a, $b, $type, $killweapon, $killflags, $killrunes, $victimweapon, $victimflags, $victimrules) = ($1, $2, $3, $4, $5, $6, $7, $8, $9);
172 if exists $bots{$addr}{$a} or exists $bots{$addr}{$b}; # only count REAL kills
176 if defined $weaponmap{$type}; # if $type is not a weapon deathtype, count the weapon of the killer
178 if not defined $weaponmap{$killweapon}; # invalid weapon? that's 0 then
180 if not defined $weaponmap{$victimweapon}; # dito
181 $killweapon = $weaponmap{$killweapon};
182 $victimweapon = $weaponmap{$victimweapon};
184 if $killflags =~ /S|I/ or $victimflags =~ /T/; # no strength, shield or typekills (these skew the statistics)
185 AddKill($addr, $currentmap{$addr}, $killweapon, $victimweapon, +1);
187 elsif(/^:kill:suicide:\d+:\d+:type=(\d+):items=(\d+)([A-Z]*)(?:|(\d+))$/)
189 my ($type, $killweapon, $killflags, $killrunes) = ($1, $2, $3, $4, $5, $6, $7);
193 if defined $weaponmap{$type};
195 if not defined $weaponmap{$killweapon};
196 $killweapon = $weaponmap{$killweapon};
198 if $killflags =~ /S/; # no strength suicides (happen too easily accidentally)
199 AddKill($addr, $currentmap{$addr}, $killweapon, $killweapon, +1);