GSP/GSP-Agent-Linux
1
0
Fork 0
Code Issues 1 Pull requests Projects Releases Packages Wiki Activity Actions

Initial Linux agent repository

Browse source
This commit is contained in:
Frank Harris 2026-06-08 10:48:00 -05:00
commit ff2cb0d399
235 changed files with 40477 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

346
KKrcon/HL2.pm Normal file
View file

@ -0,0 +1,346 @@
# HL2 - Perl extension Half-Life 2 (Source) engine Rcon interface
#
# $Id:$
#
package HL2;
use strict;
use warnings;
use IO::Socket;
use IO::Select;
# release version
our $VERSION = "0.05";
# constants for command type
sub CMD { 2 }
sub AUTH { 3 }
# create class
sub new {
my $class = shift;
# create object with defaults
my $self = {
hostname => undef,
port => 27015,
password => undef,
timeout => 5,
connected => 0,
authenticated => 0,
socket => undef,
sequence => 0,
};
# create object
bless($self, $class);
# initialize class instances
$self->init();
# parse constructor args
while (my ($key, $val) = splice(@_, 0, 2)) {
$key = lc($key);
if ($key eq "hostname") { $self->hostname($val) }
elsif ($key eq "port") { $self->port($val) }
elsif ($key eq "password") { $self->password($val) }
elsif ($key eq "timeout") { $self->timeout($val) }
else { print STDERR "Unknown attribute: $key\n" }
}
return $self;
}
# initialize class instances
sub init {
my $self = shift;
my $class = ref($self);
# manipulate symbol table.. gotta love perl
no strict "refs";
no warnings;
foreach my $instance (keys %$self) {
*{"${class}::${instance}"} = sub {
my $self = shift;
my $value = shift;
my $ref = \$self->{$instance};
if (defined $value) {
$$ref = $value;
return $self;
} else {
return $$ref;
}
};
}
}
# run a command and return its response
sub run {
my $self = shift;
my $command = shift;
if (!$self->connected()) {
$self->connect();
}
if (!$self->authenticated()) {
$self->authenticate();
}
my $socket = $self->socket();
if($socket->connected)
{
print $socket $self->packet(CMD, $command);
return $self->response();
}
return;
}
# create tcp socket
sub connect {
my $self = shift;
my $socket = IO::Socket::INET->new(
PeerAddr => $self->hostname(),
PeerPort => $self->port(),
Timeout => $self->timeout(),
Proto => "tcp",
Type => SOCK_STREAM,
) || die "Failed to connect: $!\n";
$self->socket($socket);
$self->connected(1);
}
# authenticate rcon session
sub authenticate {
my $self = shift;
# send authentication packet to server
my $socket = $self->socket();
print $socket $self->packet(AUTH, $self->password());
# auth response sends back an empty packet first
$self->response();
$self->response();
$self->authenticated(1);
}
######################
# PROTOCOL FUNCTIONS #
######################
# rcon command protocol:
# (V)[size] (V)[requestID] (V)[command] (0)[string1] (0)[string2]
#
# rcon response protocol:
# (V)[size] (V)[requestID] (V)[responseID] (0)[string1] (0)[string2]
#
# V = a 32-bit unsigned long int, little-endian (VAX/Intel)
# 0 = null-terminated string
#
# NOTE: string2 appears unused, so our functions ignore it
# create a packet of type (AUTH or CMD)
sub packet {
my $self = shift;
my $type = shift;
my $payload = shift;
# sequence increments, but auth
# packet is 2.. no idea why that is,
# but tcpdump does not lie
my $sequence;
if ($type == AUTH) {
$sequence = 2;
} else {
$sequence = $self->sequence();
# increment for next use
$self->sequence($sequence + 1);
}
my $packet = pack("VV", $sequence, $type) . "$payload\x00\x00";
$packet = pack("V", length($packet)) . $packet;
return $packet;
}
# receive packet
sub response {
my $self = shift;
my $payload = $self->read();
# remove protocol cruft and null terminators
$payload =~ s/\x00{2}$//;
return $payload;
}
# read length of bytes from socket with timeout
sub read {
my $self = shift;
my $length = shift;
my $socket = $self->socket();
my $timeout = $self->timeout();
my $select = IO::Select->new($socket);
my $reply = "";
my $buffer;
my ($size, $request_id, $command_response, $data);
while ($select->can_read(0.5)) {
$socket->recv($buffer, 4, MSG_PEEK);
$size = unpack("V", $buffer);
last if (!defined($size));
$socket->recv($buffer, $size+4, MSG_WAITALL);
($size, $request_id, $command_response, $data) =
unpack('VVVZ*x', $buffer);
$reply .= "$data";
}
return $reply;
}
1;
__END__
=head1 NAME
HL2 - Perl extension Half-Life 2 (Source) engine Rcon interface
=head1 SYNOPSIS
use HL2;
my $rcon = HL2->new(
hostname => "insub.org",
password => "yourpass",
timeout => 3,
);
print $rcon->run("status");
$rcon->run("changelevel de_dust");
=head1 DESCRIPTION
Use this module to send "rcon" (remote control) commands to a
Source server, such as Counter-Strike Source.
=head1 METHODS
=over 4
=item $rcon = HL2->new()
Create a new rcon object. You can specify the hostname,
password and/or timeout in the constructor, or use the class
methods to change them (see SYNOPSIS).
=item $rcon->authenticated()
Returns true if session has succesfully authenticated.
=item $rcon->password()
Returns current password, or sets it. Note that setting
this after authentication will not have any effect unless
you reconnect with $rcon->authenticated(0).
=item $rcon->hostname()
Returns current hostname, or sets it.
=item $rcon->port()
Returns current port, or sets it. Defaults to 27015.
=item $rcon->sequence()
Returns the current command sequence. This starts
at 0 and increases with each call.
=item $rcon->socket()
Returns the IO::Socket object for the session or
creates a new one if none exists.
=item $rcon->timeout()
Returns the TCP response timeout, or sets it. Defaults
to 5.
=item $rcon->connect()
Connects to remote server.
=item $packet = $rcon->packet($type, $payload)
Creats a packet to send to the remote server.
Type should be either CMD or AUTH, e.g.:
print $socket $rcon->packet(AUTH, $rcon->password())
=item $rcon->authenticate()
Authenticates with the rcon server. This is done automatically
when you try to run a command.
=item $response = $rcon->run($command)
Runs a command on the remote server and returns its response
=item $response = $rcon->response()
Reads a response packet from the server. This is called
authomatically when you use run() so you shouldn't need to
use this.
=back
=head1 CAVEATS
This module DOES NOT DO ANY COMMAND VALIDATION. You are responsible for
sending sane commands to the server. If you use this with CGI that allows
internet users to submit console commands, you MUST taint-check this. Users
with RCON access can send anything to the console. I highly recommend that you
restrict what console commands a user can send.
=head1 BUGS
As of this writing, there are some bugs with the rcon server itself.
One such bug is that some output goes to the console instead of to
the rcon client. For example, the command "listid" causes the list
of banned users to spew to the physical console instead of back to
the rcon client, making it effectively useless. If you are not getting
back a response you expected, please verify that it's not going to
the console (run srcds in screen so you can access it) before submitting
a bug report to me about it. Or better yet, submit a bug report to Valve.
Authentication validation is currently unsupported.
=head1 SEE ALSO
http://gruntle.org/projects/
http://insub.org/cs/
=head1 AUTHOR
Chris Jones, E<lt>cjones@gruntle.orgE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2004 by Chris Jones
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.5 or,
at your option, any later version of Perl 5 you may have available.
=cut

282
KKrcon/KKrcon.pm Normal file
View file

@ -0,0 +1,282 @@
package KKrcon;
#
# KKrcon Perl Module - execute commands on a remote Half-Life server using Rcon.
# http://kkrcon.sourceforge.net
#
# Synopsis:
#
# use KKrcon;
# $rcon = new KKrcon(Password=>PASSWORD, [Host=>HOST], [Port=>PORT], [Type=>"new"|"old"]);
# $result = $rcon->execute(COMMAND);
# %players = $rcon->getPlayers();
# $player = $rcon->getPlayer(USERID);
#
# Copyright (C) 2000, 2001 Rod May
#
# 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 Socket;
use Sys::Hostname;
# Release version number
$VERSION = "2.11";
##
## Main
##
#
# Constructor
#
sub new
{
my $class_name = shift;
my %params = @_;
my $self = {};
bless($self, $class_name);
my %server_types = (new=>1, old=>2);
# Check parameters
$params{"Host"} = "127.0.0.1" unless($params{"Host"});
$params{"Port"} = 27015 unless($params{"Port"});
$params{"Type"} = "new" unless($params{"Type"});
# Initialise properties
$self->{"rcon_password"} = $params{"Password"}
or die("KKrcon: a Password is required\n");
$self->{"server_host"} = $params{"Host"};
$self->{"server_port"} = int($params{"Port"})
or die("KKrcon: invalid Port \"" . $params{"Port"} . "\"\n");
$self->{"server_type"} = ($server_types{$params{"Type"}} || 1);
$self->{"error"} = "";
# Set up socket parameters
$self->{"_ipaddr"} = gethostbyname($self->{"server_host"})
or die("KKrcon: could not resolve Host \"" . $self->{"server_host"} . "\"\n");
return $self;
}
#
# Execute an Rcon command and return the response
#
sub execute
{
my ($self, $command) = @_;
my $msg;
my $ans;
if ($self->{"server_type"} == 1)
{
# version x.1.0.6+ HL server
$msg = "\xFF\xFF\xFF\xFFchallenge rcon\n\0";
$ans = $self->_sendrecv($msg);
if ($ans =~ /challenge +rcon +(\d+)/)
{
$msg = "\xFF\xFF\xFF\xFFrcon $1 \"" . $self->{"rcon_password"} . "\" $command\0";
$ans = $self->_sendrecv($msg);
}
elsif (!$self->error())
{
$ans = "";
$self->{"error"} = "No challenge response";
}
}
else
{
# QW/Q2/Q3 or old HL server
$msg = "\xFF\xFF\xFF\xFFrcon " . $self->{"rcon_password"} . " $command\n\0";
$ans = $self->_sendrecv($msg);
}
if ($ans =~ /bad rcon_password/i)
{
$self->{"error"} = "Bad Password";
}
return $ans;
}
sub _sendrecv
{
my ($self, $msg) = @_;
my $host = $self->{"server_host"};
my $port = $self->{"server_port"};
my $ipaddr = $self->{"_ipaddr"};
# Open socket
socket(RCON, PF_INET, SOCK_DGRAM, getprotobyname("udp")) or die("KKrcon: socket: $!\n");
my $hispaddr = sockaddr_in($port, $ipaddr);
unless(defined(send(RCON, $msg, 0, $hispaddr)))
{
die("KKrcon: send $ip:$port : $!");
}
my $rin;
vec($rin, fileno(RCON), 1) = 1;
my $ans;
if (select($rin, undef, undef, 10.0)) {
$hispaddr = recv(RCON, $ans, 8192, 0);
if (defined($ans)) {
$ans =~ s/^\xFF\xFF\xFF\xFFprint\n//; # CoD2 response
$ans =~ s/\x00+$//; # trailing crap
$ans =~ s/^\xFF\xFF\xFF\xFFl//; # HL response
$ans =~ s/^\xFF\xFF\xFF\xFFn//; # QW response
$ans =~ s/^\xFF\xFF\xFF\xFF//; # Q2/Q3 response
$ans =~ s/^\xFE\xFF\xFF\xFF.....//; # old HL bug/feature
if (length($ans) > 512) {
my $tmp;
my @explode;
while (select($rin, undef, undef, 0.05)) {
@explode = split(/\n/, $ans);
$explode[$#explode] =~ s/^ //;
$explode[$#explode] = 'X' . $explode[$#explode];
$ans = join("\n", @explode);
$hispaddr = recv(RCON, $tmp, 8192, 0);
if (defined($tmp)) {
$tmp =~ s/^\xFF\xFF\xFF\xFFprint\n//; # CoD2 response
$tmp =~ s/\x00+$//; # trailing crap
$tmp =~ s/^\xFF\xFF\xFF\xFFl//; # HL response
$tmp =~ s/^\xFF\xFF\xFF\xFFn//; # QW response
$tmp =~ s/^\xFF\xFF\xFF\xFF//; # Q2/Q3 response
$tmp =~ s/^\xFE\xFF\xFF\xFF.....//; # old HL bug/feature
$ans .= $tmp;
}
}
}
}
}
# Close socket
close(RCON);
if (!defined($ans)) {
$ans = "";
$self->{"error"} = "Rcon timeout";
}
return $ans;
}
#
# Get error message
#
sub error
{
my ($self) = @_;
return $self->{"error"};
}
#
# Parse "status" command output into player information
#
sub getPlayers
{
my ($self) = @_;
my $status = $self->execute("status");
my @lines = split(/[\r\n]+/, $status);
my %players;
foreach $line (@lines)
{
if ($line =~ /^\#[\s\d]\d\s+
(.+)\s+ # name
(\d+)\s+ # userid
(\d+)\s+ # wonid
([\d-]+)\s+ # frags
([\d:]+)\s+ # time
(\d+)\s+ # ping
(\d+)\s+ # loss
(\S+) # addr
$/x)
{
my $name = $1;
my $userid = $2;
my $wonid = $3;
my $frags = $4;
my $time = $5;
my $ping = $6;
my $loss = $7;
my $address = $8;
$players{$userid} = {
"Name" => $name,
"UserID" => $userid,
"WONID" => $wonid,
"Frags" => $frags,
"Time" => $time,
"Ping" => $ping,
"Loss" => $loss,
"Address" => $address
};
}
}
return %players;
}
#
# Get information about a player by userID
#
sub getPlayer
{
my ($self, $userid) = @_;
my %players = $self->getPlayers();
if (defined($players{$userid}))
{
return $players{$userid};
}
else
{
$self->{"error"} = "No such player # $userid";
return 0;
}
}
1;
# end