#!/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;

my $spawn = '-170 70 259';

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 = "$0 ".join ' ', @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.\n";

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;

# 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;

# set all pipes hot

select((select($_), $| = 1)[0]) for (\*STDOUT, \*STDERR, \*POLYP);

my ($replytime, $replyto) = 0;

# log startup

print "[$$] tentacle started ", scalar localtime, "\n";

# load home system

my %homes = do {

-e 'homes'

&& (%_ = %{retrieve 'homes'})

&& print "[$$] Loaded homes\n"

|| print "[$$] Couldn't load homes\n";

%_;

};

# write our PID file

open *PID, '>', "$user.tentacle";

print PID "$$\n";

close PID;

# save homes and remove our PID file when we exit

sub cleanup {

store \%homes, 'homes' if %homes;

unlink "$user.tentacle" if $user;

}

END { cleanup }

# sends arg0 an arg1 colored message (arg2)

sub MC_msg {

local $_ = $_[2]; s/\\/\\\\/g; s/"/\\"/g;

# make http://... URLs clickable

s|(http://[A-Za-z0-9._~:/?#\[\]\@\!\$&'()*+,;=-]+)|"},{clickEvent:{action:open_url,value:"$1"},text:"$1"},{text:"|g;

# catch any bare www... URLs the previous line missed

s|((?<!http://)www\.[A-Za-z0-9._~:/?#\[\]\@\!\$&'()*+,;=-]+)|"},{clickEvent:{action:open_url,value:"http://$1"},text:"$1"},{text:"|g;

print POLYP "tellraw $_[0] {color:$_[1],text:\"\",extra:[{text:\"$_\"}]}\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!^Stopping the server! or

m!^Waiting for world backup! or

m!^Starting minecraft server version! or

m/^Done \([\d.]+s\)! For help, type "help" or "\?"/ or

m!^[^ ]+ joined the game$! or

m!^[^ ]+ left the game$! or

m!^[^ ]+ has just earned the achievement ! 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 {

# FIXME: messages cannot start with . -- this is annoying.

(my $u, local $_) = @_;

/^help$/ && return MC_msg($u, 'aqua', '[JF] Available commands: help sethome home spawn back');

if (defined $cmds{$u}) { push $cmds{$u}, $_; } else { $cmds{$u} = [$_] }

$ages{$u} = "overworld" unless (defined $ages{$u});

/^((set|)home|spawn|back)$/ && 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}[0];

# find the player

/^(sethome|back|home)$/ && return print POLYP

"/execute $u ~ ~ ~ testforblock ~ ~ ~ minecraft:air\n";

# make sure teleport target is unobstructed

# FIXME this only checks where your feet will go, you can still suffocate,

# or fall in lava.

/^spawn$/ && do {

unshift $cmds{$u}, "checkspawn";

"overworld" eq $ages{$u} && return print POLYP

"/execute $u ~ ~ ~ testforblock $spawn minecraft:air\n";

# abort

shift $cmds{$u};

return MC_msg($u, 'red', "[JF] There is no spawn in the $ages{$u}")

};

}

my %back;

sub MC_testforblock_always {

# (set)home/spawn testforblocks

my ($u, $c) = @_;

local $_ = $cmds{$u}[0];

return unless defined;

my $a = $ages{$u};

# MC_msg($u, 'green', join " ", "[JF:DEBUG]", "back", $back{$a}{$u}, "current", $c) if $back{$a}{$u};

# data saving commands

/^sethome$/ && return do {

shift $cmds{$u};

$homes{my $a = $ages{$u}}{$u} = $c;

MC_msg($u, 'cyan', "[JF] Successfully set your $a home ($c)");

store \%homes, 'homes';

};

# teleporting commands

/^checkspawn$/ && return do {

# spawn is clear, find player

shift $cmds{$u};

return print POLYP "/execute $u ~ ~ ~ testforblock ~ ~ ~ minecraft:air\n";

};

# save location for .back

(my $b, $back{$ages{$u}}{$u}) = ($back{$ages{$u}}{$u}, $c);

/^spawn$/ && return do {

shift $cmds{$u};

print POLYP "/tp $u $spawn\n"

};

/^back$/ && do {

shift $cmds{$u};

defined($b) && return print POLYP "/tp $u $b\n";

return MC_msg($u, 'red', "[JF] Where were you, though?");

};

/^home$/ && do {

shift $cmds{$u};

my $a = $ages{$u};

my $h = $homes{$a}{$u};

defined($h) && return print POLYP "/tp $u $h\n";

return MC_msg($u, 'red', "[JF] You don't have a home set in the $a");

};

}

sub MC_testforblock_success {

my $u = shift;

local $_ = join ' ', @_;

# check age testforblocks

/0 127 0/ && return $ages{$u} = "nether";

/0 0 0/ && return do { $ages{$u} = "end"; MC_cmd_age_aware($u); };

MC_testforblock_always $u, $_;

}

sub MC_testforblock_failure {

my $u = shift;

$_ = join ' ', @_;

# check age testforblocks

/0 127 0/ && return 1;

/0 0 0/ && return MC_cmd_age_aware($u);

shift $cmds{$u};

MC_msg($u, 'red', '[JF] Teleport aborted due to cramped quarters.');

# MC_testforblock_always $u, $_;

}

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;

}

# restart on SIGUSR1

$SIG{USR1} = sub {

print POLYP '/tellraw @a {text:"New server version detected!"}', "\n";

print POLYP '/tellraw @a {text:"Saving everything..."}', "\n";

print POLYP "/save-all\n";

};

sub savedone {

print POLYP '/tellraw @a {text:"Loading new version! See you soon!"}', "\n";

print POLYP "/stop\n";

}

# show info to medusa

my ($servertype, $serverinfo);

sub info {

my $socket = shift;

print $socket "[$user] running ", $servertype, " on ", $serverinfo, "\n";

}

# handle data from the (minecraft) polyp

sub handle_polyp {

(my $socket, local $_) = @_;

s![\r\n]+!!g; s!^\[[\d:]+\] \[Server thread/INFO\]: !!;

return unless length;

# handle testforblock responses

if (defined MC_testforblock($_)) { return; }

# all .whatever commands (for us)

if (s!<([^>]+)> \.([^ ]+)!!) { return MC_cmd($1, $2, $_) }

# autokick experiment

if (/<([^>]+)>.*\balot\b/) { print POLYP "/kick $1 a lot*\r\n"; }

# messages that are for medusa

if (should_relay($_)) { return print $socket "[$user] $_\r\n" }

# save complete notification, for handing clean restarts

if (/Starting (\S+) server on (\S+)/) {

return ($servertype, $serverinfo) = ($1, $2);

}

if (/Saved the world/) { return savedone; }

# everything else is a reply to an issued command

if (time <= $replytime) { return 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', 'aqua', '[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 and reboot so far.

if (/^detach$/) {

detach($socket);

exit;

}

if (/^reboot$/) {

cleanup;

detach($socket);

print "Relaunching as $cmd...\n";

exec $cmd;

}

if (/^info/) { return info; }

# this command is not for us (the tentacle)

return print POLYP "/$_\r\n";

}

# 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 };

}

MC_msg('@a', 'aqua', '[JF] Wrapper online.');

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.\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";

}