XDebug.pm


package XSTAB::XDebug;
# This package creates the debug telnet server
# This module is released under the GPL
# $Id: XDebug.pm,v 1.8 2003/03/23 09:34:31 dranok Exp $
# Author: DranoK
# Email: dranok@users.sourceforge.net
# Documentation: http://xstab.sourceforge.net
######################################################


NAME

XSTAB::XDebug


DESCRIPTION

This module provides a telnet server for admins to ssh to, primarily to debug XStab. Replacement modules may impliment a simpler telnet API for webpages to give commands to XStab


INITIALIZATION

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

my $VERSION = 0.9;


PUBLIC METHODS

create ()
Standard constructor which will return the blessed object. Before doing so it sets $self->{Admin_sessions} and $self->{World} to be empty hashes. This constructor also creates the TCP port and select object which we will listen on. It also sets up $self->{Admin_commands}

See PRIVATE METHODS for syntax on individual commands.

sub create
{
  my $class = shift;

  my $self = { };
  $self->{Admin_sessions} = { };
  $self->{World} = { };
  $self->{World}{timeout} = ".02";
  $self->{Admin_commands} = {"set" => { "function" => "_do_set",
			                "enabled" => 1 },
  		             "show" => { "function" => "_do_show",
			       	         "enabled" => 1 },
			     "tail" => { "function" => "_do_tail",
                                         "num_args" => 1,
					 "enabled" => 1 },
			     "trace" => { "function" => "_do_trace",
				  	  "enabled" => 1},
			     "status" => { "function" => "_do_status",
					   "enabled" => 1},
			     "voice" => { "function" => "_do_voice",
					  "enabled" => 1},
			     "global" => { "function" => "_do_global",
					   "enabled" => 1 } };

  $self->{World}{listen_socket} = IO::Socket::INET->new(LocalPort => $Global{Debug_port},
			              		        Listen => 5,
					  	        Proto => 'tcp',
					  	        Reuse => 1);
  die $@ unless $self->{World}{listen_socket};
  $self->{Admin_readers} = IO::Select->new() or die "Can't create select object";
  $self->{Admin_readers}->add($self->{World}{listen_socket});

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

do_one_loop (int Average_loops)
This method will do one main debug loop, cylcling through each of the open connections (or connections awaiting to be authenticated), and handleing each of them. Average_loops is how many loops per second the main loop in XStab is performing.

This loop multiplexes sockets to avoid blocking waits.

sub do_one_loop
{
  my $self = shift;
  my $avg_loops = shift;
  my @ready = $self->{Admin_readers}->can_read($self->{World}{timeout});
  foreach my $handle (@ready)
  {
    if ($handle eq $self->{World}{listen_socket})
    { # Do an accept
      my $connect = $self->{World}{listen_socket}->accept();
      $self->{Admin_readers}->add($connect);
#      syswrite($connect, "XStab Experiemental TCP interface\n\r[$avg_loops iterations/s]> ");
#      syswrite($connect, "Please enter administrative passcode: ");
      my $ip = $connect->sockhost();
      $self->{Admin_sessions}{$connect}{ip} = $ip;
      $self->{Admin_sessions}{$connect}{write} = "Please enter administrative passcode: ";
      do_log("$ip: Connected.", 3);
    } else {
      my $ip = $handle->sockhost();
      my $input;
      my $bytes = sysread($handle, $input, 2048);
      if ($bytes > 0) {
        $self->{Admin_sessions}{$handle}{read} .= $input;
        if ($input =~ /[\n\r]/) {
          if ($self->{Admin_sessions}{$handle}{iswindows}) {
#            syswrite($handle, "\n\r");
            $self->{Admin_sessions}{$handle}{write} .= "\n\r";
          }
          # Strip out newlines 
          $self->{Admin_sessions}{$handle}{read} =~ s/[\n\r]//g;
          if (!$self->{Admin_sessions}{$handle}{has_auth}) {
            if ($self->{Admin_sessions}{$handle}{read} eq $Global{Debug_passwd}) {
              $self->{Admin_sessions}{$handle}{has_auth} = 1;
              delete $self->{Admin_sessions}{$handle}{read};
            } else {
              $self->{Admin_readers}->remove($handle);
              delete $self->{Admin_sessions}{$handle};
              close $handle;
              do_log("$ip: Auth failure.", 3); 
              next;
            }
          } 
          $self->{Admin_sessions}{$handle}{read} =~ s/[^a-z0-9A-Z_ ]//g;
          if ($self->{Admin_sessions}{$handle}{read} eq 'quit') {
            $self->{Admin_readers}->remove($handle);
            delete $self->{Admin_sessions}{$handle};
            close $handle;
            do_log("$ip: Disconnected.", 3); 
            next;
          }
          if ($self->{Admin_sessions}{$handle}{read}) {
            do_log("$ip: Parsing '$self->{Admin_sessions}{$handle}{read}'", 5);
            $self->{Admin_sessions}{$handle}{write} .= $self->parse_command($handle, $self->{Admin_sessions}{$handle}{read});
            delete ($self->{Admin_sessions}{$handle}{read});
          } 
          if (defined(${$self->{Admin_sessions}{$handle}{*trace}})) {
            $self->{Admin_sessions}{$handle}{write} .= "\n\r[$avg_loops iterations/s, trace value: ${$self->{Admin_sessions}{$handle}{*trace}}]> ";
          } else {
            $self->{Admin_sessions}{$handle}{write} .= "\n\r[$avg_loops iterations/s]> ";
          }
        } else {
          $self->{Admin_sessions}{$handle}{write} .= $input;
#          syswrite($handle, $input);
          $self->{Admin_sessions}{$handle}{iswindows} = 1;
        }
      } else {
        $self->{Admin_readers}->remove($handle);
        delete $self->{Admin_sessions}{$handle};
        close $handle;
        do_log("$ip disconnected (No Data).", 3); 
      }
    }
  }

  @ready = $self->{Admin_readers}->can_write($self->{World}{timeout}); 
  foreach my $handle (@ready) {
    if ($self->{Admin_sessions}{$handle}{write}) {
      syswrite($handle, $self->{Admin_sessions}{$handle}{write});
      delete $self->{Admin_sessions}{$handle}{write};
    }
  }
}

pushlog (int Priority, string Line)
This method will send events from the debug log to any open admin session which has requested such information via the 'tail' command.
sub pushlog
{
  my $self = shift;
  my $prio = shift;
  my $line = shift;

  foreach my $handle (keys %{$self->{Admin_sessions}}) {
    if ($self->{Admin_sessions}{$handle}{dotail} >= $prio) {
      $self->{Admin_sessions}{$handle}{write} .= "\n\r$line";
    }
  }
}

parse_command (handle Handle, string Input)
This method will parse Input and, assuming it is a valid command, execute it via the supplied function.

Returns the result from the command executed, or an error string.

sub parse_command
{
  my $self = shift;
  my $handle = shift;
  my $input = shift;
  
  my $ip = $self->{Admin_sessions}{$handle}{ip};
  my @tokens = split(' ', $input);

  my $matches = 0;
  my $command = undef;
  my $arguments = @tokens;
  $arguments--;
  foreach my $elem (keys %{$self->{Admin_commands}}) {
    if ($elem =~ /$tokens[0]/ && $self->{Admin_commands}{$elem}{enabled} && ($arguments == $self->{Admin_commands}{$elem}{num_args} || !$self->{Admin_commands}{$elem}{num_args}))
    {
      $matches++;
      $command = $elem;
    }
  }
  if ($matches < 1) {
    do_log("$ip: No such command: $tokens[0]", 5);
    return "No such command: $tokens[0]";
  } elsif ($matches > 1) {
    do_log("$ip: Ambiguous command: $input", 5);
    return "Ambiguous command: $tokens[0]";
  }
  no strict 'refs';
  my $ret = $self->{Admin_commands}{$command}{function}($self, $handle, $ip, @tokens);
  return $ret;
}


PRIVATE METHODS

The following methods are private, as they do not propperly conform to OO standards. In fact, they are called above after 'strict refs' is explicitly disabled. These will not work if you want to override this module. As such, you probably want to rewrite this entire module instead of trying to extend it.

_do_global (ref self, handle Handle, string IP, string Command, string Var, scalar Value)
This command will set values in the %Global hash, or read values from it. Synatx:
        global Foo 5 -- Sets $Global{Foo} = 5
        global Foo   -- Displays the value of $Global{Foo}
sub _do_global
{
  my $self = shift;
  my $handle = shift;
  my $ip = shift;
  my $command = shift;
  my $var = shift;
  my $value = shift;

  if ($value) {
    $Global{$var} = $value;
    do_log("$ip: Global Override: Global{$var} = $value", 3);
    return "Global{$var} = $value";
  } else {
    return "Global{$var} = $Global{$var}";
  }
}
 

_do_set (ref self, handle Handle, string IP, string Command, int ClientID, scalar Value, array Data)
This command will set an element in the $Player's hash. Syntax is:
        set 5 66 fielda fieldb == $Players{5}{fielda}{fieldb} = 66
sub _do_set
{
  my $self = shift;
  my $handle = shift;
  my $ip = shift;
  my $command = shift;
  my $client = shift;
  my $value = shift;
  my @depth = @_;
 
  if (scalar(@depth) > 3) {
    return "Depth too deep!";
  } elsif (scalar(@depth) > 2) {
    $Players{$client}{$depth[0]}{$depth[1]}{$depth[2]} = $value;
  } elsif (scalar(@depth) > 1) {
    $Players{$client}{$depth[0]}{$depth[1]} = $value;
  } elsif (scalar(@depth) > 0) {
    $Players{$client}{$depth[0]} = $value;
  } else {
    return "No depth hash specified!";
  }
  do_log("$ip: Playerhash Override has occured.", 3);
  return "New value has been set.";
}

_do_trace (ref self, handle Handle, string IP, string Command, int ClientID, array Data)
This command will alter your prompt to display the value of the variable you specifiy in the $Player's hash. You will need to press 'enter' repeated to view the value 'real time'. Syntax is:
        trace 5 fielda fieldb -- Will trace $Players{5}{fielda}{fieldb}
        trace 0               -- Disables tracing
sub _do_trace
{
  my $self = shift;
  my $handle = shift;
  my $ip = shift;
  my $command = shift;
  my $client = shift;
  my @depth = @_;

  my $td = scalar(@depth);
  if (scalar(@depth) > 3) {
    return "Depth too deep!";
  } elsif (scalar(@depth) > 2) {
    $self->{Admin_sessions}{$handle}{*trace} = \$Players{$client}{$depth[0]}{$depth[1]}{$depth[2]};
  } elsif (scalar(@depth) > 1) {
    $self->{Admin_sessions}{$handle}{*trace} = \$Players{$client}{$depth[0]}{$depth[1]};
  } elsif (scalar(@depth) > 0) {
    $self->{Admin_sessions}{$handle}{*trace} = \$Players{$client}{$depth[0]};
  } else {
    $self->{Admin_sessions}{$handle}{*trace} = undef;
    return "Trace mode disabled.";
  }
  return "Trace value: ${$self->{Admin_sessions}{$handle}{*trace}}";
}

_do_show (ref self, handle Handle, string IP, string Command, int ClientID, array Data)
This command will display the a variable in the $Player's hash. Syntax is:
        show 5 fielda fieldb == print $Players{5}{fielda}{fieldb}
sub _do_show
{
  my $self = shift;
  my $handle = shift;
  my $ip = shift;
  my $command = shift;
  my $client = shift;
  my @depth = @_;
 
  my $value;

  if (scalar(@depth) > 3) {
    return "Depth too deep!";
  } elsif (scalar(@depth) > 2) {
    $value = $Players{$client}{$depth[0]}{$depth[1]}{$depth[2]};
  } elsif (scalar(@depth) > 1) {
    $value = $Players{$client}{$depth[0]}{$depth[1]};
  } elsif (scalar(@depth) > 0) {
    $value = $Players{$client}{$depth[0]};
  } else {
    return "No depth hash specified!";
  }
  return "Current value: $value";
}

_do_tail (ref self, handle Handle, string IP, string Command, int Level)
This command will set your session log level to X, where X is a number between 1 and 5. The higher this number, the more info you will receive. Syntax is:
        tail X -- Sets log level to X
        tail 0 -- Disables the viewing of the log
sub _do_tail
{
  my $self = shift;
  my $handle = shift;
  my $ip = shift;
  my $command = shift;
  my $level = shift;
  
  if (!$level)
  {
    $self->{Admin_sessions}{$handle}{dotail} = 0;
    return "Log tail disabled.";
  } else {
    $self->{Admin_sessions}{$handle}{dotail} = $level;
    return "Log tail level: $level";
  }
}

_do_status ()
This command will return information presented by the Game module about who is currently playing. The format of this printout is entirely dependant upon the Game module. Syntax:
        status
sub _do_status
{
  my @tmpar = split($Global{sp}, $main::game->get_status());
  my $ret;
  foreach my $elem (@tmpar) {
    $ret .= "$elem\n\r";
  }
  return $ret;
}

_do_voice (ref self, handle Handle, string IP, string Command)
This command will send the supplied argument into the @Voice_queue. Usefull for interacting with the game server. Syntax:
        voice foo bar -- Places "foo bar" into the voice queue with a priority of 2
sub _do_voice
{
  my $self = shift;
  my $handle = shift;
  my $ip = shift;
  my $command = shift;

  my $str = join(' ', @_);
  push(@Voice_queue, "2$Global{sp}$str");
  return "Sending '$str' to the Voice Queue";
}

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("XDebug: $string", $prio);
}

1;


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