XUdp.pm

package XSTAB::Sensor::XUdp;
# This is a sensor designed for UDP rcon
# protocols.  This sensor will return data
# (as specified by the game module) from
# the UDP socket
# NOTE: The timeout on getting an answer is .5
# seconds.  This time is busy-wait, and CPU
# load will jump momentarily while the daemon
# sits waiting for a reply.  
# 
# $Id: XUdp.pm,v 1.6 2003/03/24 04:11:54 dranok Exp $
#
# This module distributed under the GPL
# Author: DranoK
# Email: dranok@users.sourceforge.net
# Documentation: xstab.sourceforge.net
############################################

NAME

XSTAB::Sensor::XUdp - UDP RCon Sensor Module

DESCRIPTION

This sensor is designed to work with UDP RCon protocols, such as is used in Quake3, RTCW, etc.

INITIALIZATION

use IO::Socket;
use IO::Select;
use XSTAB::XData;
use strict;

my $VERSION = 0.9;

PUBLIC METHODS

create ()

Constructor which will return the blessed object. The time at which the object is created is recorded as $self->{start_time}

sub create
{
  my $class = shift; 

  my $self = { };
  $self->{Magic} = "\377\377\377\377";
  $self->{start_time} = time;
  if (defined($self->{data_sock} = IO::Socket::INET->new("PeerAddr" => $Global{Udp_ip},
                                                "PeerPort" => $Global{Udp_port},
                                                "Proto" => 'udp',
                                                "Timeout" => '300')))
  {
    $self->{data_sock}->timeout(300);
  } else {
    return -2;
  }

  bless($self, $class);
  return $self;
}

do_log (string Message, int Priority)

This is the overloaded do_log function. Purpose is to identify which module is logging the message

sub do_log
{
  my $string = shift;
  my $prio = shift;
  XSTAB::XData::do_log("Sensor::XUdp: $string", $prio);
}

whoami ()

Method to identify what sensor type this is. Returns ``XUdp''

sub whoami
{
  return "XUdp";
}

gather_data (string CommandList)

This method will issue the commands listed in the string CommandList (separated by $Global{sp}) one at a time by sending the individual command to issue_command. The scalar $results (which should be treated as a string) has the returned string from issue_command appended to it for each command listed. This final string is then returned.

Although this method is called every loop by xstab, it will only run once every 10 seconds. This is done by checking if the current time minus $self->{start_time is less than 10, and if so returning before doing anything further. If the propper ammount of time has passed, $self->{start_time} will be reset to the current time.

sub gather_data
{
  my $self = shift;
  my $command_list = shift;

  my $end_time = time;
  # RCon sucks my fucking ass
  if (scalar(@Voice_queue)) {
    return;
  }
  if ($end_time - $self->{start_time} < 10) {
    return;
  }
  $self->{start_time} = $end_time;

  my @commands = split($Global{sp}, $command_list);
  my $results;
  foreach my $command (@commands)
  {
    $results .= $self->issue_command($command);
  }
  return $results;
}

issue_command (string Command)

This method will send the command specified in Command to the RCon socket. This method will block and wait for .5 seconds for an answer before giving up, in which case it will subtract 4 seconds from $self->{start_time}. This has the affect of decreasing the time before the next probe to 5 seconds instead of 10 seconds.

NOTE: RCon has some drain bramage to say the least. If someone knows why RCon behaves as it does, I would love to know. RCon cannot handle multiple requests coming in at (or close to) the same time, so not getting a response every time is to be expected.

sub issue_command
{
  my $self = shift;
  my $command = shift;

  my $tmpbuf = "";
  my $pattern = "^$self->{Magic}" . "print\n";
  my $tcr = 0;
  my $tmpbufc;
  my $chars_read;

  my $RCONString = $self->{Magic} . "rcon " . $Global{Rcon_passwd} . " $command";
  print {$self->{data_sock}} $RCONString;

  do_log("Waiting for answer from UDP server.", 5);

  my $select = IO::Select->new($self->{data_sock});

  while (my @sockets = $select->can_read(0.5)) {
    foreach my $socket (@sockets) {
      if (defined($chars_read = $socket->sysread($tmpbuf, 65507))) {
        $tcr += $chars_read;
        $tmpbuf =~ s/$pattern//;
        $tmpbufc .= "$command$Global{sp}$tmpbuf$Global{sp2}";
      }
    }
  }

  if (!$tcr) {
    # OK, reset to 5 seconds instead of 10
    $self->{start_time} -= 4; 
    return -1;
  }

  return $tmpbufc;
}

1;

__END__

AUTHOR

This module was coded by DranoK and is part of the core XStab modules. You may directly contact DranoK at dranok@users.sourceforge.net, or by posting to the forums at:

        http://www.oltl.net/forums/forumdisplay.php?s=&forumid=25