Народ, помогите, пожалуйста!
Хочу понять, как работают проги мониторинга игровых серверов (статистика сервера: ping, frag, etc.)
Нашёл скрипт на перле, но специально учить перл для того, чтобы понять как работает, сами понимате…
Я единственное понял из этого скрипта, что он принимает массив с данными...
Вот сам скрипт:
package pq;
use Carp;
use IO::Socket;
use IO::Select;
use Sys::Hostname;
my $VERSION = '1.2';
use strict;
use vars qw($AUTOLOAD %validvars);
# valid accessor field/methods used in AUTOLOAD
for my $var (qw(delayconnect maxretries retrywait maxwait timedout err port rconpass gametype)) { $validvars{$var}++; }
### Language strings ...
my %lang = (
dedicated => 'dedicated',
listen => 'listen',
linux => 'Linux',
windows => 'Windows'
);
my $packedint = pack('l',-1); # 0xFFFFFFFF
my $null = pack('x'); # 0x00
my $null32 = $null.$null.$null.$null; # 0x00000000
my %servers = (
halflife => {
id => 'halflife', # above name duplicated for easy access
gamename => 'Half-Life',
server_protocol => '45',
default_server_port => 27015,
valid_queries => [ qw(info players) ], # list of valid queries defined below. 1st one is the default
query => {
'info' => {
command => $packedint . 'details', # could of used 'infoString' (not the same as 'info') but 'details' returns a bit more info
response => '....m',
packet_handler => \&get_halflife_packets,
data_parser => \&parse_halflife_data
},
'players' => {
command => $packedint . 'players',
response => '....D',
packet_handler => \&get_halflife_packets,
data_parser => \&parse_halflife_data
}
}
}
);
## ----------------------------------------------------------------------------------------
sub new {
my ($proto,%opt) = @_;
my $class = ref($proto) || $proto;
my $self = {};
bless($self, $class);
%$self = %opt if %opt; # assign any options that were passed to new()
$self->server($$self{server}); # assures that IP:port is assigned correctly
if (!$self->gametype) { # auto-guess the gametype based on port, if no gametype is specified
foreach my $gt (keys %servers) {
if ($servers{$gt}{default_server_port} == $self->port or $servers{$gt}{default_master_port} == $self->port) {
$self->gametype($gt);
last;
}
}
}
$$self{socket} = undef;
$$self{socket} = $self->connectsocket() unless $$self{delayconnect};
return $self;
}
## ----------------------------------------------------------------------------------------
sub queryserver() {
my ($self,$query,$info) = @_;
$query ||= $servers{$$self{gametype}}{valid_queries}[0]; # default to 1st query type if none given
croak("Invalid query '$query' given to queryserver()")
unless $servers{$$self{gametype}}{query}{$query};
my $cmd = $servers{$$self{gametype}}{query}{$query}{command}; # actual command string to send
my $packet_handler = $servers{$$self{gametype}}{query}{$query}{packet_handler}; # function to handle response packet(s)
my $data_parser = $servers{$$self{gametype}}{query}{$query}{data_parser}; # function to parse out returned data
my $result = '';
$self->sendcommand($cmd) or return 0;
$result = &$packet_handler($self);
if (defined $info) { # $info reference == parsed data
%$info = (%$info, &$data_parser($self,$query,$result)); # append new data to current %info hash
}
return unless defined wantarray; # VOID context, return nothing
return wantarray ? &$data_parser($self,$query,$result) : $result; # return the hash or the raw result depending on context
}
## ----------------------------------------------------------------------------------------
sub connectsocket {
my ($self) = @_;
croak("Server gametype must be specified before connecting!") unless $$self{gametype};
croak("Server must be specified before connecting!") unless $$self{server};
croak("Server port must be specified before connecting!") unless $$self{port};
return IO::Socket::INET->new(Proto=>'udp', PeerAddr=>$$self{server}, PeerPort=>$$self{port});
}
## ----------------------------------------------------------------------------------------
sub server {
my $self = shift;
if (@_) {
my $srv = shift;
if ($srv =~ /^([^:]+)
\d+)/) {$$self{server} = $1;
$$self{port} = $2;
} else {
$$self{server} = $srv;
$$self{port} ||= $servers{$$self{gametype}}{default_server_port} if $$self{gametype};
}
return 1;
} else {
return $$self{server};
}
}
## ----------------------------------------------------------------------------------------
sub get_halflife_packets() {
my ($self) = @_;
my $sock = $$self{socket};
my $sel = new IO::Select($sock);
my @packets = ('');
my ($head, $inhead, $size, $first, $last, $seq);
my $buff = '';
my $morepackets = 1;
$seq = '';
$first = 0;
$last = 0;
$self->timedout(0);
while (!$self->timedout and $morepackets) {
if ($sel->can_read($$self{maxwait})) {
$sock->recv($buff, 1500);
$size = length($buff); # must keep track of original size of buffer
# print "=== ($size) " . $buff . "\n"; # debug
$head = substr($buff,0,4); # get first 4 bytes (32bit int)
last unless $head;
my $packettype = int(unpack('l',$head) || 0); #
if ($packettype == -1) { # single packet, no more will be sent from server
$packets[0] = $buff; # leave the 5 byte header intact
$morepackets = 0;
} elsif ($packettype == -2) { # -2 header signifies a multi-packet sequence is being sent
$buff = substr($buff, 4); # remove "-2" header, its useless
$seq = unpack('l',substr($buff,0,4)); # we're ignoring the sequence for the time being, so its not actually used
$inhead = unpack('c',substr($buff,4,1)); # get 9th (4th since we've trimmed the headers already) byte (partial packet 0x02 or last packet 0x12?)
$buff = substr($buff,5); # strip off the sequence# and 'inhead' byte
if ($inhead == 0x02) { # 0x02 is the 'first' packet in the sequence
unshift(@packets, $buff); # add packet to front of array (unshifted incase we already received packets)
$first++;
$morepackets = !$last; # if we've received the 'last' packet already then we're done
} elsif ($inhead == 0x12) { # 0x12 is a 'partial' packet
## there isn't much we can do to make sure multiple 'partial' packets are received in the correct order
## so we'll just append each 'partial' we get onto the @packets array and hope for the best
## All we CAN tell is, if the 'partial' packet is less then 1400 then its the last packet, otherwise it goes
## 'in the middle'
push(@packets, $buff);
$morepackets = (($size == 1400) or !$first); # more, if this packet is 1400 or we haven't gotten the 'first' packet yet
$last++ if $size < 1400; # is this the last packet?
} else {
## invalid packet?
}
} else {
$morepackets = 0; # ignore anything else, since the header is unknown/invalid
}
} else {
$self->timedout(1);
}
}
# print "------\nbuff = " . join('',@packets) . "\n";
return join('',@packets);
}
## ----------------------------------------------------------------------------------------
sub parse_halflife_data() {
my ($self,$query,$result) = @_;
my $header = $servers{$$self{gametype}}{query}{$query}{response};
my ($i1,$i2,$i3,$i4);
my %info = ();
if ($query eq 'info') {
if ($result =~ s/^$header//s) {
$info{name} = &getnullstr(\$result);
} else {
$self->err("Invalid packet header returned for '$query' query.");
}
} elsif ($query eq 'players') {
if ($result =~ s/^$header//s) {
$info{activeplayers} = &getbyte(\$result);
for (my $i=1; $i <= $info{activeplayers}; $i++) {
my $idx = &getbyte(\$result);
my $name = &getnullstr(\$result);
$info{players}{$name}{name} = $name;
my ($i1,$i2,$i3,$i4) = (&getbyte(\$result), &getbyte(\$result), &getbyte(\$result), &getbyte(\$result));
$result = substr($result, 4); # strip out time value
}
} else {
$self->err("Invalid packet header returned for '$query' query.");
}
}
return %info;
}
# -[[ INTERNAL FUNCTIONS ]]---------------------------------------------------------
#
## ----------------------------------------------------------------------------------------
sub sendcommand {
my ($self, $cmd) = @_;
my $sock = $$self{socket};
my $sel = new IO::Select($sock);
$self->timedout(0);
if ($sel->can_write($$self{maxwait})) {
$sock->send($cmd);
} else {
$self->timedout(1);
}
return !$self->timedout;
}
## ----------------------------------------------------------------------------------------
sub getchar {
my $str = shift;
my $byte = &getbyte($str); # pass by reference (it already is a ref at this point)
return sprintf("%c", $byte);
}
## ----------------------------------------------------------------------------------------
sub getbyte {
my $str = shift; # $str by reference ($$str)
my $val = 0;
# $val = ord($1) if ($$str =~ s/^(.)//s);
$val = ord(substr($$str,0,1,'')); # this is at least 2x faster then the regexp above.
return $val;
}
## ----------------------------------------------------------------------------------------
sub getnullstr {
my $str = shift; # $str by reference ($$str)
if ($$str =~ s/^\x00//s) { # string is empty
return '';
} elsif ($$str =~ s/^(.+?)\x00//s) { # read upto the null byte at the end.
return $1;
} else {
$$str =~ s/^.//s;
}
return '';
}
## ----------------------------------------------------------------------------------------
sub AUTOLOAD {
my $self = shift;
my $var = $AUTOLOAD;
$var =~ s/.*:://;
return if $var eq 'DESTROY';
if ($validvars{$var}) { # set or return the variable.
return (@_) ? $$self{$var} = shift : $$self{$var};
} else { # just in case this class ever inherits anything
# my $super = "SUPER::$var";
# $self->$super(@_);
croak("Fatal Error: Method '$var' does not exist");
}
}
Если знаете, то помогите plz.
Заранее благодарен!!!