package TRcon;
#
# TRcon Perl Module - execute commands on a remote Half-Life2 server using remote console.
#
# Copyright (C) 2005-2007 Tobias Oetzel
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
#

use strict;
no strict 'vars';

use Sys::Hostname;
use IO::Socket;
use IO::Select;

my $VERSION = "1.00";
my $TIMEOUT = 1.0;

my $SERVERDATA_EXECCOMMAND        = 2;
my $SERVERDATA_AUTH               = 3;
my $SERVERDATA_RESPONSE_VALUE     = 0;
my $SERVERDATA_AUTH_RESPONSE      = 2;
my $REFRESH_SOCKET_COUNTER_LIMIT  = 100;
my $AUTH_PACKET_ID                = 1;
my $SPLIT_END_PACKET_ID           = 2;

#
# Constructor
#

sub new
{
  my ($class_name, $server_object) = @_;
  my ($self) = {};
  bless($self, $class_name);
  
  $self->{"rcon_socket"}            = 0;
  $self->{"server_object"}          = $server_object;
  $self->{"auth"}                   = 0;
  $self->{"refresh_socket_counter"} = 0;
  
  $self->{"packet_id"}              = 10;
  return $self;
}

sub execute
{
  my ($self, $command, $splitted_answer) = @_;
  if ($::g_stdin == 0) {
    my $answer = $self->sendrecv($command, $splitted_answer);
    if ($answer =~ /bad rcon_password/i) {
      &::printEvent("TRCON", "Bad Password");
    }
    return $answer;
  }  
}

sub get_auth_code
{
  my ($self, $id) = @_;
  my $auth = 0;
  
  if ($id == $AUTH_PACKET_ID) {
    &::printEvent("TRCON", "Rcon password accepted");
    $auth = 1;
    $self->{"auth"} = 1;
  } elsif( $id == -1) {
    &::printEvent("TRCON", "Rcon password refused");
    $self->{"auth"} = 0;
    $auth           = 0;
  } else {
    &::printEvent("TRCON", "Bad password response id=$id");
    $self->{"auth"} = 0;
    $auth           = 0;
  }
  return $auth;

}


sub sendrecv
{
  my ($self, $msg, $splitted_answer) = @_;
  
  my $rs_counter = $self->{"refresh_socket_counter"};
  if ($rs_counter % $REFRESH_SOCKET_COUNTER_LIMIT == 0)  {
    if ($self->{"rcon_socket"} > 0) {
      shutdown($self->{"rcon_socket"}, 2);
      $self->{"rcon_socket"} = 0;
    }
    my $server_object = $self->{"server_object"};
    $self->{"rcon_socket"}   =  IO::Socket::INET->new(
                                      		Proto=>"tcp",
                                            PeerAddr=>$server_object->get("address"), 
                                            PeerPort=>$server_object->get("port"), 
                                    		LocalAddr=>"$s_ip",
                            	);
    if (!$self->{"rcon_socket"}) {
      &::printEvent("TRCON", "Cannot setup TCP socket on ".$server_object->get("address").":".$server_object->get("port").": $!");
    } 
    $self->{"refresh_socket_counter"} = 0;
    $self->{"auth"} = 0;
  }                          	


  my $r_socket  = $self->{"rcon_socket"};
  my $server    = $self->{"server_object"};

  my $auth      = $self->{"auth"};
  my $response  = "";
  my $packet_id = $self->{"packet_id"};
  
  if (($r_socket) && ($r_socket->connected() )) {
    if ($auth == 0)  {
      &::printEvent("TRCON", "Trying to get rcon access (auth)");
      if ($self->send_rcon($AUTH_PACKET_ID, $SERVERDATA_AUTH, $server->get("rcon"), "")) {
        &::printEvent("TRCON", "Couldn't send password");
        return;
      }
      my ($id, $command, $response) = $self->recieve_rcon($AUTH_PACKET_ID);
      if($command == $SERVERDATA_AUTH_RESPONSE) {
        $auth = $self->get_auth_code($id);
      } elsif (($command == $SERVERDATA_RESPONSE_VALUE) && ($id == $AUTH_PACKET_ID)) {  
         # CS:Source server sends one junk packet during the authentication step, before it responds 
         # with the correct authentication response.  
         &::printEvent("TRCON", "Junk packet from Counterstrike:Source");
         my ($id, $command, $response) = $self->recieve_rcon($AUTH_PACKET_ID);
         $auth = $self->get_auth_code($id);
      }  
    }
    
    if ($auth == 1)  {
      $self->{"refresh_socket_counter"}++;
      $self->send_rcon($packet_id, $SERVERDATA_EXECCOMMAND, $msg);
      if ($splitted_answer > 0) {
        $self->send_rcon($SPLIT_END_PACKET_ID, $SERVERDATA_EXECCOMMAND, "");
      }  
      my ($id, $command, $response) = $self->recieve_rcon($packet_id, $splitted_answer);
      $self->{"packet_id"}++;
      if ($self->{"packet_id"} > 32767) {
        $self->{"packet_id"} = 10;
      }
      return $response;
    }
  } else {
    $self->{"refresh_socket_counter"} = 0;
  } 
  return;
  
}

#
# Send a package
#
sub send_rcon
{
  my ($self, $id, $command, $string1, $string2) = @_;
  my $data = pack("VVZ*Z*", $id, $command, $string1, $string2);
  my $size = length($data);
  if($size > 4096) {
    &::printEvent("TRCON", "Command to long to send!");
    return 1;
  }
  my $data = pack("V", $size).$data;

  my $r_socket = $self->{"rcon_socket"};
  if (($r_socket) && ($r_socket->connected() )) {
    $r_socket->send($data, 0);
    return 0;
  } else {
    $self->{"refresh_socket_counter"} = 0;
  }
  return 1;
}

#
#  Recieve a package
#
sub recieve_rcon
{
  my ($self, $packet_id, $splitted_answer) = @_;
  my ($size, $id, $command, $msg);
  my $tmp = "";

  my $r_socket  = $self->{"rcon_socket"};
  my $server    = $self->{"server_object"};
  my $auth      = $self->{"auth"};
  my $packet_id = $self->{"packet_id"};
  
  if (($r_socket) && ($r_socket->connected() )) {
    if(IO::Select->new($r_socket)->can_read($TIMEOUT)) {  # $TIMEOUT seconds timeout
      $r_socket->recv($tmp, 1500);
      $size    = unpack("V",  substr($tmp, 0, 4));
      $id      = unpack("V",  substr($tmp, 4, 4));
      $command = unpack("V",  substr($tmp, 8, 4));
      if ($id == $packet_id)  {
        $tmp     = substr($tmp, 12, length($tmp)-12);
        if ($splitted_answer > 0) {
          my $last_packet_id = $id;
          while ($last_packet_id != $SPLIT_END_PACKET_ID) {
            if(IO::Select->new($r_socket)->can_read($TIMEOUT)) {
              $r_socket->recv($split_data, 1500);
              my $split_size    = unpack("V",  substr($split_data, 0, 4));
              my $split_id      = unpack("V",  substr($split_data, 4, 4));
              my $split_command = unpack("V",  substr($split_data, 8, 4));
              if ($split_id == $last_packet_id) {
                $split_data = substr($split_data, 12, length($split_data)-12);
              }
              $last_packet_id = $split_id;
              $tmp .= $split_data;
            } else {
              &::printNotice("TRCON", "Multiple packet error");
              $last_packet_id = $SPLIT_END_PACKET_ID;
            }
          }  
        }
        if (length($tmp) > 0)  {
          $tmp .= "\x00";
          my ($string1, $string2) = unpack("Z*Z*", $tmp);
          $msg = $string1.$string2;
        } else {
          $msg = "";
        }  
      }
      return ($id, $command, $msg);
    } else {
      $self->{"refresh_socket_counter"} = 0;
      return (-1, -1, -1);
    }
  } else {
    $self->{"refresh_socket_counter"} = 0;
    return (-1, -1, -1);
  }
}

#
# Get error message
#

sub error
{
  my ($self) = @_;
  return $self->{"rcon_error"};
}



#
# Parse "status" command output into player information
#

sub getPlayers
{
  my ($self) = @_;
  my $status = $self->execute("status", 1);
  my @lines = split(/[\r\n]+/, $status);

  my %players;


# userid name uniqueid connected ping loss state adr
# 187 ".:[SoV]:.Evil Shadow" STEAM_0:1:6200412 13:48 97 0 active 213.10.196.229:24085

  foreach my $line (@lines)
  {
    if ($line =~ /^\#\s*
                (\d+)\s+		# userid
                "(.+)"\s+		# name
                (.+)\s+		    # uniqueid
                ([\d:]+)\s+		# time
                (\d+)\s+		# ping
                (\d+)\s+		# loss
                (.+)\s+			# state
                ([^:]+):    	# addr
                (\S+)           # port
                $/x)
    {
      my $userid   = $1;
      my $name     = $2;
      my $uniqueid = $3;
      my $time     = $4;
      my $ping     = $5;
      my $loss     = $6;
      my $state    = $7;
      my $address  = $8;
      my $port     = $9;
      #print "USERID: '$userid', NAME: '$name', UNIQUEID: '$uniqueid', TIME: '$time', PING: '$ping', LOSS: '$loss', STATE: '$state', ADDRESS:'$address', CLI_PORT: '$port'\n";

      if ($::g_mode eq "NameTrack") {
        $players{$name}    = { 
                             "Name"       => $name,
                             "UserID"     => $userid,
                             "UniqueID"   => $uniqueid,
                             "Time"       => $time,
                             "Ping"       => $ping,
                             "Loss"       => $loss,
                             "State"      => $state,
                             "Address"    => $address,
                             "ClientPort" => $port
                           };
      } elsif ($::g_mode eq "LAN") {
        $players{$address} = { 
                             "Name"       => $name,
                             "UserID"     => $userid,
                             "UniqueID"   => $uniqueid,
                             "Time"       => $time,
                             "Ping"       => $ping,
                             "Loss"       => $loss,
                             "State"      => $state,
                             "Address"    => $address,
                             "ClientPort" => $port
                           };
      } else {
        $players{$uniqueid} = { 
                             "Name"       => $name,
                             "UserID"     => $userid,
                             "UniqueID"   => $uniqueid,
                             "Time"       => $time,
                             "Ping"       => $ping,
                             "Loss"       => $loss,
                             "State"      => $state,
                             "Address"    => $address,
                             "ClientPort" => $port
                            };
      }
      
    }
  }
  return %players;
}


#
# Get information about a player by userID
#

sub getPlayer
{
  my ($self, $uniqueid) = @_;
  my %players = $self->getPlayers();
  
  if (defined($players{$uniqueid}))
  {
    return $players{$uniqueid};
  }
  else
  {
    $self->{"error"} = "No such player # $uniqueid";
    return 0;
  }
}

sub getServerData
{
  my ($self) = @_;
  my $status = $self->execute("status", 1);
  
  my @lines = split(/[\r\n]+/, $status);
  
  my $map         = "";
  my $max_players = 0;
  foreach my $line (@lines)
  {
    #      build   :  2260
    #      udp/ip  :  213.133.123.103:27015
    #      map     :  de_dust2 at: 0 x, 0 y, 0 z
    #      players :  12 (16 max)
    if ($line =~ /^\s*map\s*:\s*([\S]+).*$/x)
    {
      $map   = $1;
    }
    if ($line =~ /^\s*players\s*:.+\(([\S]+).*$/x)
    {
      $max_players = $1;
    }
  }
  return ($map, $max_players);
}


sub getVisiblePlayers
{
  my ($self) = @_;
  my $status = $self->execute("sv_visiblemaxplayers", 1);
  
  my @lines = split(/[\r\n]+/, $status);
  

  my $max_players = -1;
  foreach my $line (@lines)
  {
   # "sv_visiblemaxplayers" = "-1"
   #       - Overrides the max players reported to prospective clients
    if ($line =~ /^\s*"sv_visiblemaxplayers"\s*=\s*"([-0-9]+)".*$/x)
    {
      $max_players   = $1;
    }
  }
  return ($max_players);
}


sub getManiVersion
{
  my ($self) = @_;
  my $status = $self->execute("ma_version", 1);
  
  my @lines = split(/[\r\n]+/, $status);
  

  my $max_players = -1;
  foreach my $line (@lines)
  {
    # Mani Admin Plugin 2006 V1.2BetaN RC2-14 VSP, www.mani-admin-plugin.com
    # Server Tickrate 66
    if ($line =~ /^\s*Mani\s+Admin\s+Plugin\s+2006\s*([^ ]+)\s+.*$/x)
    {
      $mani_version   = $1;
    }
  }
  return ($mani_version);
}


sub getServerGame
{
  my ($self) = @_;
  
  my $found = 0;
  my $i     = 0;
  my $game  = "";
  while (($found == 0) && ($i < 4))  {
    if ($i == 0) {
      $check_game    = "css"; 
      $check_map     = "de_dust2";
      $check_result  = $self->execute("maps ".$check_map, 1);
    } elsif ($i == 1) {
      $check_game    = "dods"; 
      $check_map     = "dod_donner";
      $check_result  = $self->execute("maps ".$check_map, 1);
    } elsif ($i == 2) {
      $check_game    = "hl2ctf"; 
      $check_map     = "ctf_defrost";
      $check_result  = $self->execute("maps ".$check_map, 1);
    } elsif ($i == 3) {
      $check_game    = "hl2mp"; 
      $check_map     = "dm_overwatch";
      $check_result  = $self->execute("maps ".$check_map, 1);
    }
    my @lines = split(/[\r\n]+/, $check_result);
    foreach my $line (@lines) {
      if ($line =~ /.*PENDING.*$check_map.*/)  {
        $game = $check_game;
        $found++;
      }
    }  
    $i++;
  }
  return $game;
}


1;
# end
