544 lines
15 KiB
Perl
544 lines
15 KiB
Perl
# Minecraft::RCON - RCON remote console for Minecraft
|
|
#
|
|
# 1.x and above by Ryan Thompson <rjt@cpan.org>
|
|
#
|
|
# Original (0.1.x) by Fredrik Vold, no copyrights, no rights reserved.
|
|
# This is absolutely free software, and you can do with it as you please.
|
|
# If you do derive your own work from it, however, it'd be nice with some
|
|
# credits to me somewhere in the comments of that work.
|
|
#
|
|
# Based on http:://wiki.vg/RCON documentation
|
|
|
|
package Minecraft::RCON;
|
|
|
|
our $VERSION = '1.03';
|
|
|
|
use 5.010;
|
|
use strict;
|
|
use warnings;
|
|
no warnings 'uninitialized';
|
|
|
|
use Term::ANSIColor 3.01;
|
|
use IO::Socket 1.18; # autoflush
|
|
use Carp;
|
|
|
|
use constant {
|
|
# Packet types
|
|
AUTH => 3, # Minecraft RCON login packet type
|
|
AUTH_RESPONSE => 2, # Server auth response
|
|
AUTH_FAIL => -1, # Auth failure (password invalid)
|
|
COMMAND => 2, # Command packet type
|
|
RESPONSE_VALUE => 0, # Server response
|
|
};
|
|
|
|
# Minecraft -> ANSI color map
|
|
my %COLOR = map { $_->[1] => color($_->[0]) } (
|
|
[black => '0'], [blue => '1'], [green => '2'],
|
|
[cyan => '3'], [red => '4'], [magenta => '5'],
|
|
[yellow => '6'], [white => '7'], [bright_black => '8'],
|
|
[bright_blue => '9'], [bright_green => 'a'], [bright_cyan => 'b'],
|
|
[bright_red => 'c'], [bright_magenta => 'd'], [yellow => 'e'],
|
|
[bright_white => 'f'],
|
|
[bold => 'l'], [concealed => 'm'], [underline => 'n'],
|
|
[reverse => 'o'], [reset => 'r'],
|
|
);
|
|
|
|
# Defaults for new objects. Override in constructor or with accessors.
|
|
sub _DEFAULTS(%) {
|
|
(
|
|
address => '127.0.0.1',
|
|
port => 25575,
|
|
password => '',
|
|
color_mode => 'strip',
|
|
request_id => 0,
|
|
|
|
# DEPRECATED options
|
|
strip_color => undef,
|
|
convert_color => undef,
|
|
|
|
@_, # Subclasses may override
|
|
);
|
|
}
|
|
|
|
# DEPRECATED warning text for convenience/consistency
|
|
my $DEP = 'deprecated and will be removed in a future release.';
|
|
|
|
sub new {
|
|
my $class = shift;
|
|
my %opts = 'HASH' eq ref $_[0] ? %{$_[0]} : @_;
|
|
my %DEFAULTS = _DEFAULTS();
|
|
|
|
# DEPRECATED -- Warn and transition to new option
|
|
if ($opts{convert_color}) {
|
|
carp "convert_color $DEP\nConverted to color_mode => 'convert'.";
|
|
$opts{color_mode} = 'convert';
|
|
}
|
|
if ($opts{strip_color}) {
|
|
carp "strip_color $DEP\nConverted to color_mode => 'strip'.";
|
|
$opts{color_mode} = 'strip';
|
|
}
|
|
|
|
my @unknowns = grep { not exists $DEFAULTS{$_} } sort keys %opts;
|
|
carp "Ignoring unknown option(s): " . join(', ', @unknowns) if @unknowns;
|
|
|
|
bless { %DEFAULTS, %opts }, $class;
|
|
}
|
|
|
|
sub connect {
|
|
my ($s) = @_;
|
|
|
|
return 1 if $s->connected;
|
|
|
|
croak 'Password required' unless length $s->{password};
|
|
|
|
$s->{socket} = IO::Socket::INET->new(
|
|
PeerAddr => $s->{address},
|
|
PeerPort => $s->{port},
|
|
Proto => 'tcp',
|
|
) or croak "Connection to $s->{address}:$s->{port} failed: .$!";
|
|
|
|
my $id = $s->_next_id;
|
|
$s->_send_encode(AUTH, $id, $s->{password});
|
|
my ($size,$res_id,$type,$payload) = $s->_recv_decode;
|
|
|
|
# Force a reconnect if we're about to error out
|
|
$s->disconnect unless $type == AUTH_RESPONSE and $id == $res_id;
|
|
|
|
croak 'RCON authentication failed' if $res_id == AUTH_FAIL;
|
|
croak "Expected AUTH_RESPONSE(2), got $type" if $type != AUTH_RESPONSE;
|
|
croak "Expected ID $id, got $res_id" if $id != $res_id;
|
|
croak "Non-blank payload <$payload>" if length $payload;
|
|
|
|
return 1;
|
|
}
|
|
|
|
sub connected { $_[0]->{socket} and $_[0]->{socket}->connected }
|
|
|
|
sub disconnect {
|
|
$_[0]->{socket}->shutdown(2) if $_[0]->connected;
|
|
delete $_[0]->{socket} if exists $_[0]->{socket};
|
|
1;
|
|
}
|
|
|
|
sub command {
|
|
my ($s, $command, $mode) = @_;
|
|
|
|
croak 'Command required' unless length $command;
|
|
croak 'Not connected' unless $s->connected;
|
|
|
|
my $id = $s->_next_id;
|
|
my $nonce = 16 + int rand(2 ** 15 - 16); # Avoid 0..15
|
|
$s->_send_encode(COMMAND, $id, $command);
|
|
$s->_send_encode($nonce, $id, 'nonce');
|
|
|
|
my $res = '';
|
|
while (1) {
|
|
my ($size,$res_id,$type,$payload) = $s->_recv_decode;
|
|
if ($id != $res_id) {
|
|
$s->disconnect;
|
|
croak sprintf(
|
|
"Desync. Expected %d (0x%4x), got %d (0x%4x). Disconnected.",
|
|
$id, $id, $res_id, $res_id
|
|
);
|
|
}
|
|
croak "size:$size id:$id got type $type, not RESPONSE_VALUE(0)"
|
|
if $type != RESPONSE_VALUE;
|
|
last if $payload eq sprintf 'Unknown request %x', $nonce;
|
|
$res .= $payload;
|
|
}
|
|
|
|
$s->color_convert($res, defined $mode ? $mode : $s->{color_mode});
|
|
}
|
|
|
|
sub color_mode {
|
|
my ($s, $mode, $code) = @_;
|
|
return $s->{color_mode} if not defined $mode;
|
|
croak 'Invalid color mode.'
|
|
unless $mode =~ /^(strip|convert|ignore)$/;
|
|
|
|
if ($code) {
|
|
my $was = $s->{color_mode};
|
|
$s->{color_mode} = $mode;
|
|
$code->();
|
|
$s->{color_mode} = $was;
|
|
} else {
|
|
$s->{color_mode} = $mode;
|
|
}
|
|
}
|
|
|
|
sub color_convert {
|
|
my ($s, $text, $mode) = @_;
|
|
$mode = $s->{color_mode} if not defined $mode;
|
|
my $re = qr/\x{00A7}(.)/o;
|
|
|
|
$text =~ s/$re//g if $mode eq 'strip';
|
|
$text =~ s/$re/$COLOR{$1}/g if $mode eq 'convert';
|
|
$text .= $COLOR{r} if $mode eq 'convert' and $text =~ /\e\[/;
|
|
|
|
$text;
|
|
}
|
|
|
|
sub DESTROY { $_[0]->disconnect }
|
|
|
|
#
|
|
# DEPRECATED methods
|
|
#
|
|
|
|
sub convert_color {
|
|
my ($s, $val) = @_;
|
|
carp "convert_color() is $DEP\nUse color_mode('convert') instead";
|
|
$s->color_mode('convert') if $val;
|
|
|
|
$s->color_mode eq 'convert';
|
|
}
|
|
|
|
sub strip_color {
|
|
my ($s, $val) = @_;
|
|
carp "strip_color() is $DEP\nUse color_mode('strip') instead";
|
|
$s->color_mode('strip') if $val;
|
|
|
|
$s->color_mode eq 'strip';
|
|
}
|
|
|
|
sub address {
|
|
carp "address() is $DEP";
|
|
$_[0]->{address} = $_[1] if defined $_[1];
|
|
$_[0]->{address};
|
|
}
|
|
|
|
sub port {
|
|
carp "port() is $DEP";
|
|
$_[0]->{port} = $_[1] if defined $_[1];
|
|
$_[0]->{port};
|
|
}
|
|
|
|
sub password {
|
|
carp "password() is $DEP";
|
|
$_[0]->{password} = $_[1] if defined $_[1];
|
|
$_[0]->{password};
|
|
}
|
|
|
|
#
|
|
# Private helpers
|
|
#
|
|
|
|
# Increment and return the next request ID, wrapping at 2**31-1
|
|
sub _next_id { $_[0]->{request_id} = ($_[0]->{request_id} + 1) % 2**31 }
|
|
|
|
# Form and send a packet of the specified type, request_id and payload
|
|
sub _send_encode {
|
|
my ($s, $type, $id, $payload) = @_;
|
|
confess "Request ID `$id' is not an integer" unless $id =~ /^\d+$/;
|
|
$payload = "" unless defined $payload;
|
|
my $data = pack('V!V' => $id, $type) . $payload . "\0\0";
|
|
$s->{socket}->send(pack(V => length $data) . $data);
|
|
|
|
}
|
|
|
|
# Grab a single packet.
|
|
sub _recv_decode {
|
|
my ($s) = @_;
|
|
confess "_recv_decode when not connected" unless $s->connected;
|
|
|
|
local $_; $s->{socket}->recv($_, 4);
|
|
my $size = unpack 'V';
|
|
$_ = '';
|
|
my $frags = 0;
|
|
|
|
croak "Zero length packet" unless $size;
|
|
|
|
while ($size > length) {
|
|
my $buf;
|
|
$s->{socket}->recv($buf, $size);
|
|
$_ .= $buf;
|
|
$frags++;
|
|
}
|
|
|
|
croak 'Packet too short. ' . length($_) . ' < 10' if 10 > length($_);
|
|
croak "Received packet missing terminator" unless s/\0\0$//;
|
|
|
|
$size, unpack 'V!V(A*)';
|
|
}
|
|
|
|
1;
|
|
|
|
__END__
|
|
|
|
=head1 NAME
|
|
|
|
Minecraft::RCON - RCON remote console communication with Minecraft servers
|
|
|
|
=head1 VERSION
|
|
|
|
Version 1.03
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use Minecraft::RCON;
|
|
|
|
my $rcon = Minecraft::RCON->new( { password => 'secret' } );
|
|
|
|
eval { $rcon->connect };
|
|
die "Connection failed: $@" if $@;
|
|
|
|
my $response;
|
|
eval { $response = $rcon->command('help') };
|
|
say $@ ? "Error: $@" : "Response: $response";
|
|
|
|
$rcon->disconnect;
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
C<Minecraft::RCON> provides a nice object interface for talking to Mojang AB's
|
|
game Minecraft. Intended for use with their multiplayer servers, specifically
|
|
I<your> multiplayer server, as you will need the correct RCON password, and
|
|
RCON must be enabled on said server.
|
|
|
|
=head1 CONSTRUCTOR
|
|
|
|
=head2 new( %options )
|
|
|
|
Create a new RCON object. Note we do not connect automatically; see
|
|
C<connect()> for that. The properties and their defaults are shown below:
|
|
|
|
my $rcon = Minecraft::RCON->new({
|
|
address => '127.0.0.1',
|
|
port => 25575,
|
|
password => '',
|
|
color_mode => 'strip',
|
|
error_mode => 'error',
|
|
});
|
|
|
|
We will C<carp()> but not die in the event that any unknown options are
|
|
provided.
|
|
|
|
=over 4
|
|
|
|
=item address
|
|
|
|
The hostname or IP address to connect to.
|
|
|
|
=item port
|
|
|
|
The TCP port number to connect to.
|
|
|
|
=item password
|
|
|
|
The plaintext password used to authenticate. This password must match the
|
|
C<rcon.password=> line in the F<server.properties> file for your server.
|
|
|
|
=item color_mode
|
|
|
|
The color mode controls how C<Minecraft::RCON> handles color codes sent back
|
|
by the Minecraft server. It must be one of C<strip>, C<convert>, or C<ignore>.
|
|
constants. See C<color_mode()> for more information.
|
|
|
|
=back
|
|
|
|
=head1 METHODS
|
|
|
|
=head2 connect
|
|
|
|
eval { $rcon->connect }; # $@ will be set on error
|
|
|
|
Attempt to connect to the configured address and port, and issue the
|
|
configured password for authentication.
|
|
|
|
If already connected, returns C<undef> (nothing to be done).
|
|
|
|
This method will C<croak> if the connection fails for any reason.
|
|
Otherwise, returns a true value.
|
|
|
|
=head2 connected
|
|
|
|
say "We are connected!" if $rcon->connected;
|
|
|
|
Returns true if we have a connected socket, false otherwise. Note that we have
|
|
no way to tell if there is a misbehaving Minecraft server on the other
|
|
side of that socket, so it is entirely possible for this command (or
|
|
C<connect()>) to succeed, but C<command()> calls to fail.
|
|
|
|
=head2 disconnect
|
|
|
|
$rcon->disconnect;
|
|
|
|
Disconnects from the server by closing the socket. Always succeeds.
|
|
|
|
=head2 command( $command, [ $color_mode ] )
|
|
|
|
my $response = $rcon->command("data get block $x $y $z");
|
|
my $ansi = $rcon->command('list', 'convert');
|
|
|
|
Sends the C<$command> to the Minecraft server, and synchronously waits for the
|
|
response. This method is capable of handling fragmented responses (spread over
|
|
several response packets), and will concatenate them all before returning the
|
|
result.
|
|
|
|
The resulting server response will have its color codes stripped, converted,
|
|
or ignored, according to the current C<color_mode()> setting, unless a
|
|
C<$color_mode> is given, which will override the current setting for this
|
|
command only.
|
|
|
|
=head2 color_mode( $color_mode, [ $code ] )
|
|
|
|
$rcon->color_mode('strip');
|
|
|
|
When a command response is received, the color codes it contains can be
|
|
stripped, converted to ANSI, or left alone, depending on this setting.
|
|
|
|
C<$color_mode> is optional, unless C<$code> is also specified.
|
|
The valid modes are as follows:
|
|
|
|
=over 10
|
|
|
|
=item strip
|
|
|
|
Strip any color codes, returning the plaintext.
|
|
|
|
=item convert
|
|
|
|
Convert any color codes to the equivalent ANSI escape sequences, suitable for
|
|
display in a terminal.
|
|
|
|
=item ignore
|
|
|
|
Ignore color codes, returning the full command response verbatim.
|
|
|
|
=back
|
|
|
|
The current mode will be returned.
|
|
|
|
If C<$code> is specified and is a C<CODE> ref, C<color_mode()> will apply the
|
|
new color mode, run C<$code-E<gt>()>, and then restore the original color
|
|
mode. This is useful when you use one color mode most of the time, but have
|
|
sections of code requiring a different mode:
|
|
|
|
Example usage:
|
|
|
|
# Color mode is 'convert'
|
|
$rcon->color_mode(strip => sub {
|
|
my $plaintext = $rcon->command('...');
|
|
});
|
|
|
|
But see also C<command($cmd, $mode)> for running single commands with
|
|
another color mode.
|
|
|
|
|
|
=head2 color_convert( $string, [ $color_mode ] )
|
|
|
|
my $response = $rcon->command('list');
|
|
my ($strip, $ansi) = map { $rcon->color_convert($response, $_) }
|
|
qw<strip convert>;
|
|
|
|
This method is used internally by C<command()> to convert command responses as
|
|
configured in the object. However, C<color_convert()> itself may be useful in
|
|
some applications where a stripped version of the response may be needed for
|
|
parsing, while an ANSI version may be desired for display to a terminal, for
|
|
example, without having to run the command itself (with possible side-effects)
|
|
a second time. For C<color_convert()> to do anything meaningful, your object's
|
|
C<color_mode> should be set to C<ignore>.
|
|
|
|
=head1 ERROR HANDLING
|
|
|
|
This module C<croak>s (see L<Carp>) for almost all errors.
|
|
When an error does not affect control flow, we will C<carp> instead.
|
|
|
|
Thus, C<command()> and C<connect()>, at minimum, should be wrapped in block
|
|
C<eval>:
|
|
|
|
eval { $result = $rcon->command('list'); };
|
|
warn "I don't know who is online because: $@" if $@;
|
|
|
|
If a little extra syntactic sugar is desired, you can use an exception handler
|
|
like L<Try::Tiny> instead:
|
|
|
|
use Try::Tiny;
|
|
|
|
try {
|
|
$result = $rcon->command('list');
|
|
} catch {
|
|
warn "I don't know who is online because: $_";
|
|
}
|
|
|
|
=head1 DEPRECATED METHODS
|
|
|
|
The following methods have been deprecated. They will issue a warning to
|
|
STDOUT when called, and will be removed in a future release.
|
|
|
|
=head2 convert_color ( $enable )
|
|
|
|
If C<$enable> is a true value, change the color mode to C<convert>.
|
|
Returns 1 if the current color mode is C<convert>, undef otherwise.
|
|
|
|
B<Deprecated.> Use C<color_mode('convert')> instead.
|
|
|
|
=head2 strip_color
|
|
|
|
If C<$enable> is a true value, change the color mode to C<strip>.
|
|
Returns 1 if the current color mode is C<strip>, undef otherwise.
|
|
|
|
B<Deprecated.> Use C<color_mode('strip')> instead.
|
|
|
|
=head1 SUPPORT
|
|
|
|
=over 4
|
|
|
|
=item L<https://github.com/rjt-pl/Minecraft-RCON.git>: Source code repository
|
|
|
|
=item L<https://github.com/rjt-pl/Minecraft-RCON/issues>: Bug reports and feature requests
|
|
|
|
=back
|
|
|
|
=head1 SEE ALSO
|
|
|
|
=over 4
|
|
|
|
=item L<Net::RCON::Minecraft> for an alternative API
|
|
|
|
=item L<Terminal::ANSIColor>, L<IO::Socket::INET>
|
|
|
|
=item L<https://developer.valvesoftware.com/wiki/Source_RCON_Protocol>
|
|
|
|
=item L<https://wiki.vg/RCON>
|
|
|
|
=back
|
|
|
|
=head1 AFFILIATION WITH MOJANG
|
|
|
|
I<Note from original author, Fredrik Vold:>
|
|
|
|
I am in no way affiliated with Mojang or the development of Minecraft.
|
|
I'm simply a fan of their work, and a server admin myself. I needed
|
|
some RCON magic for my servers website, and there was no perl module.
|
|
|
|
It is important that everyone using this module understands that if
|
|
Mojang changes the way RCON works, I won't be notified any sooner than
|
|
anyone else, and I have no special avenue of connection with them.
|
|
|
|
=head1 AUTHORS
|
|
|
|
=over 4
|
|
|
|
=item B<Ryan Thompson> C<E<lt>rjt@cpan.orgE<gt>>
|
|
|
|
Addition of unit test suite, fragmentation support, and other improvements.
|
|
|
|
This program is free software; you can redistribute it
|
|
and/or modify it under the same terms as Perl itself.
|
|
|
|
L<http://dev.perl.org/licenses/artistic.html>
|
|
|
|
=item B<Fredrik Vold> C<E<lt>fredrik@webkonsept.comE<gt>>
|
|
|
|
Original (0.1.x) author.
|
|
|
|
No copyright claimed, no rights reserved.
|
|
|
|
You are absolutely free to do as you wish with this code, but mentioning me in
|
|
your comments or whatever would be nice.
|
|
|
|
Minecraft is a trademark of Mojang AB. Name used in accordance with my
|
|
interpretation of L<http://www.minecraft.net/terms>, to the best of my
|
|
knowledge.
|
|
|
|
=back
|