#!/usr/bin/perl -w
#
# tentacle.pl, the example (minecraft) polyp connector for jellyfish
# version 2.0.0 by Pegasus Epsilon <pegasus@pimpninjas.org>
#
# (C) 2014 All Rights Reserved
#
# NOTICE: This is not free software. Modification is not permitted.
# NOTICE: This is not free software. Distribution is not permitted.
# NOTICE: This is not free software. For author's use only.
use strict;
use POSIX;
use Socket;
use Fcntl;
use Storable;
use IPC::Open2;
sub fail { print STDERR shift, "\n"; exit }
# deal with command line
fail("Usage: $0 polypname username password host port") if $#ARGV != 4;
my ($polyp, $user, $pass, $host, $port) = @ARGV;
# save command line
my $cmd = join ' ', $0, @ARGV;
# prettify ps listing
$0 = join ' ', "[tentacle]", $user;
# make sure i'm not already running
if (-e "$user.tentacle") {
open *PID, '<', "$user.tentacle";
my $pid = <PID>;
close PID;
if (kill 0, $pid) {
print STDERR "[$$] $user tentacle already running.";
exit;
} else { print STDERR "[$$] Cleaned up a stale pid file.\n"; }
}
# daemonize
print STDERR "[$$] $polyp tentacle started, detaching...\n";
close STDOUT; open STDOUT, '>>', "$polyp.log";
close STDERR; open STDERR, '>&', *STDOUT;
exit if fork; exit if fork;
# write our PID file
open *PID, '>', "$user.tentacle";
print PID "$$\n";
close PID;
# remove it when we exit
END { unlink "$user.tentacle" }
# get the pid of the polyp's child
open PID, '<', "$polyp.pid";
my $pid = <PID>;
close PID;
# passthrough sigint to the polyp's child
$SIG{INT} = sub { print "\r"; kill SIGINT, $pid };
# connect to the polyp
socket POLYP, PF_UNIX, SOCK_STREAM, 0
or fail("[$$] Can't create unix domain socket.");
connect POLYP, sockaddr_un("$polyp.polyp")
or fail("[$$] Can't connect to polyp.");
# configure the polyp connection
fcntl POLYP, F_SETFL, O_NONBLOCK;
my $inputs = '';
vec($inputs, my $fd_polyp = fileno POLYP, 1) = 1;
# load home system
my %homes = do {
-e 'homes' && (%_ = %{retrieve 'homes'})
&& print "[$$] Loaded homes\n" || print "[$$] Couldn't load homes\n";
%_;
};
# set all pipes hot
select((select($_), $| = 1)[0]) for (\*STDOUT, \*STDERR, \*POLYP);
my ($replytime, $replyto) = 0;
# sends arg0 an arg1 colored message (arg2)
sub MC_msg {
if ('@a' ne $_[0]) { print POLYP "tell $_[0] $_[2]\n" }
else { print POLYP "say $_[2]\n" }
}
# returns true if the message is for medusa
sub should_relay {
local $_ = shift;
# all this is, is a mess of regex.
# matches are propagated to the network.
m!^<! or m!^\*! or
m/^Done \([\d.]+s\)! For help, type "help" or "\?"/ or
m!^Stopping the server! or
m!^[^ ]+ joined the game$! or
m!^[^ ]+ left the game$! or
m!^[^ ]+ was squashed by a falling anvil$! or
m!^[^ ]+ was pricked to death$! or
m!^[^ ]+ walked into a cactus whilst trying to escape ! or
m!^[^ ]+ was shot by arrow$! or
m!^[^ ]+ drowned$! or
m!^[^ ]+ drowned whilst trying to escape $! or
m!^[^ ]+ blew up$! or
m!^[^ ]+ was blown up by ! or
m!^[^ ]+ hit the ground too hard$! or
m!^[^ ]+ fell from a high place$! or
m!^[^ ]+ fell off a ladder$! or
m!^[^ ]+ fell off some vines$! or
m!^[^ ]+ fell out of the water$! or
m!^[^ ]+ fell into a patch of fire$! or
m!^[^ ]+ fell into a patch of cacti$! or
m!^[^ ]+ was doomed to fall! or
m!^[^ ]+ was shot off some vines by ! or
m!^[^ ]+ was shot off a ladder by ! or
m!^[^ ]+ was blown from a high place by ! or
m!^[^ ]+ went up in flames$! or
m!^[^ ]+ burned to death$! or
m!^[^ ]+ was burnt to a crisp whilst fighting ! or
m!^[^ ]+ walked into a fire whilst fighting ! or
m!^[^ ]+ was slain by ! or
m!^[^ ]+ was shot by ! or
m!^[^ ]+ was fireballed by ! or
m!^[^ ]+ was killed by ! or
m!^[^ ]+ got finished off by ! or
m!^[^ ]+ tried to swim in lava$! or
m!^[^ ]+ tried to swim in lava while trying to escape ! or
m!^[^ ]+ died$! or
m!^[^ ]+ was squashed by a falling block$! or
m!^[^ ]+ was killed by magic$! or
m!^[^ ]+ starved to death$! or
m!^[^ ]+ suffocated in a wall$! or
m!^[^ ]+ was killed while trying to hurt ! or
m!^[^ ]+ was pummeled by ! or
m!^[^ ]+ fell out of the world$! or
m!^[^ ]+ fell from a high place and fell out of the world$! or
m!^[^ ]+ was knocked into the void by ! or
m!^[^ ]+ withered away$!
}
# fire off an age check for the given user
sub MC_check_age {
local $_ = shift;
# check if in nether
print POLYP '/execute $_ ~ ~ ~ testforblock 0 127 0 minecraft:bedrock\n';
# check if in end
print POLYP '/execute $_ ~ ~ ~ testforblock 0 0 0 minecraft:air\n';
}
# handle commands from users
# I would very much like it if mojang would let the server console see
# invalid /commands from connected clients, for this right here. - pegasus
my (%ages, %cmds, @blocks);
sub MC_cmd {
(my $u, local $_) = @_;
if (defined $cmds{$u}) { push $cmds{$u}, $_; } else { $cmds{$u} = [$_] }
$ages{$u} = "overworld" unless (defined $ages{$u});
/^help$/ && return MC_msg($u, 'aqua', '[JF] Available commands: help home sethome');
/^(set|)home$/ && return MC_check_age($u);
shift $cmds{$u};
MC_msg($u, 'red', "[JF] Unknown command: $_");
}
sub MC_cmd_age_aware {
local $_ = $cmds{my $u = shift};
my $h = $homes{$ages{$u}}{$u};
# make sure user's home in this age is unobstructed
# FIXME this only checks where your feet will go, you can still suffocate.
/^home$/ && defined($h) && return print POLYP
'/execute ', $u, ' ~ ~ ~ testforblock ', $h, ' minecraft:air\n';
# find the player
/^sethome$/ && return print POLYP '/execute ', $u,
' ~ ~ ~ testforblock ~ ~ ~ minecraft:air\n';
}
sub MC_testforblock_success {
my $u = shift;
$_ = join ' ', @_;
# check age testforblocks
/0 127 0/ && return $ages{$u} = "nether";
/0 0 0/ && return do { $ages{$u} = "end"; MC_cmd_age_aware($u); };
# (set)home testforblocks
(my $c, $_) = ($_, $cmds{$u});
/^home$/ && return do {
shift $cmds{$u};
my $h = $homes{my $a = $ages{$u}}{$u};
if (defined $h && /$h/) { print POLYP "/tp $u $c\n" }
else { MC_msg($u, 'red', "[JF] You don't have a home set in $a") }
};
/^sethome$/ && return do {
shift $cmds{$u};
$homes{my $a = $ages{$u}}{$u} = $c;
MC_msg($u, 'cyan', "[JF] Successfully set your $a home ($c)");
}
}
sub MC_testforblock_failure {
my $u = shift;
$_ = join ' ', @_;
# check age testforblocks
/0 0 0/ && return MC_cmd_age_aware($u);
# (set)home testforblocks
(my $c, $_, $b) = ($_, $cmds{$u}, $blocks[$_[0]][$_[1]][$_[2]]);
/^home$/ && return do {
shift $cmds{$u};
MC_msg($u, 'red', "[JF] Your home has been blocked with $b");
};
/^sethome$/ && return do {
shift $cmds{$u};
MC_msg($u, 'red', "[JF] Can't set your home while standing in $b");
};
}
sub MC_testforblock {
local $_ = shift;
# testforblock succeeded
m!\[([^:]+): Successfully found the block at (\d+),(\d+),(\d+)\.\]!
&& defined $cmds{$1} && return MC_testforblock_success($1, $2, $3, $4);
# testforblock failed, block half
m!The block at (\d+),(\d+),(\d+) is ([^ ]+)! && return ($blocks[$1][$2][$3] = $4);
# testforblock failed, user half
m!Failed to execute 'testforblock ([~\d]+) ([~\d]+) ([~\d]+) [^']+' as (.+)!
&& return MC_testforblock_failure($4, $1, $2, $3);
# not a testforblock response.
undef;
}
# handle data from the (minecraft) polyp
sub handle_polyp {
(my $socket, local $_) = @_;
print $_;
s![\r\n]+!!g; s!^[\d-]+ [\d:]+ \[INFO\] \[Minecraft-Server\] !!;
return unless length;
# handle testforblock responses
if (defined MC_testforblock($_)) { return; }
# all .whatever commands (for us)
if (s!<([^>]+)> \.([^ ]+)!!) { MC_cmd($1, $2, $_) }
# messages that are for medusa
elsif (should_relay($_)) { print $socket "[$user] $_\r\n" }
# everything else is a reply to an issued command
elsif (time <= $replytime and not m!^\[Server\]!) { print $socket "/$replyto [$user] $_\r\n" }
# or just ignored.
}
# read data from the (minecraft) polyp
sub read_polyp {
my $socket = shift;
defined($_ = <POLYP>) or do { print "Server exited.\n"; exit };
while () { handle_polyp($socket, $_); }
continue { defined($_ = <POLYP>) or last };
}
# disconnect polyp from medusa
sub detach {
my $socket = shift;
MC_msg('@a', 'cyan', '[JF] Wrapper shutting down.');
print $socket "[$user] Disconnecting.\r\n";
}
# handle data from medusa
sub handle_medusa {
(my $socket, local $_) = @_;
s/[\r\n]+//g; s!\[([^]:]+):([^]]+)\] !!;
my ($src, $tgt) = ($1, $2);
return unless length;
if ('*' ne $tgt) {
$replytime = time + 2 unless m!^stop$!;
print $replyto = $src, " has issued a command: $_\n";
# check for commands being sent to us (the tentacle)
# instead of the polyp through us
# only /detach so far.
if (m!^detach$!) {
detach($socket);
exit;
} elsif (m!^reboot$!) {
detach($socket);
exec $cmd;
}
# this command is not for us (the tentacle)
else { print POLYP "/$_\r\n"; }
return;
}
# not a command, must be a chat message.
MC_msg('@a', 'yellow', $_);
}
# read data from the medusa connection
sub read_medusa {
my $socket = shift;
defined(local $_ = <$socket>) or do { close $socket; last };
while () { handle_medusa($socket, $_) }
continue { defined($_ = <$socket>) or last };
}
print "[$$] tentacle started ", scalar localtime, "\n";
MC_msg('@a', 'aqua', '[JF] Wrapper online (commands disabled because forge).');
for (;;) { # ever
socket my $socket, PF_INET, SOCK_STREAM, (getprotobyname 'tcp')[2];
select(((select $socket), $| = 1)[0]);
vec($inputs, my $fd_socket = fileno $socket, 1) = 1;
connect $socket, sockaddr_in($port, inet_aton($host)) or do {
print "Connection failed: $!\n";
sleep 10;
<POLYP> # empty wrapped buffer
} until (connect $socket, sockaddr_in($port, inet_aton($host)));
print "Connected to $host:$port\n";
local $_ = <$socket>;
s/[\r\n]+//g;
print "Server says: $_\n";
print "Trying to log in as $user with password $pass.\n";
print $socket "/login $user $pass\r\n";
fcntl $socket, F_SETFL, O_NONBLOCK;
while (my $n = select(my $readable = $inputs, undef, my $exception = $inputs, undef)) {
# ignore interrupted system calls
if (-1 == $n && $!{EINTR}) { undef $!; next; }
# reconnect on socket exception
last if (vec($exception, $fd_socket, 1));
# die on pipe exception
if (vec($exception, $fd_polyp, 1)) {
print "[DEBUG] Exceptions: ", unpack("b*", $exception), ", $!, \$n: $n\n";
exit;
}
if (vec($readable, $fd_polyp, 1)) { read_polyp($socket); next }
if (vec($readable, $fd_socket, 1)) { read_medusa($socket); next }
}
print "Reconnecting...\n";
}