138 lines
3.5 KiB
Perl
Executable file
138 lines
3.5 KiB
Perl
Executable file
#!/usr/bin/perl
|
|
package POE::Component::BukkitDtach;
|
|
|
|
use warnings;
|
|
use strict;
|
|
|
|
use POE qw(Wheel::Run);
|
|
use Data::Dumper;
|
|
|
|
sub spawn {
|
|
my $class = shift;
|
|
my $file = shift;
|
|
POE::Session->create(
|
|
inline_states => {
|
|
_start => \&on_start,
|
|
got_child_stdout => \&on_child_stdout,
|
|
got_child_stderr => \&on_child_stderr,
|
|
got_child_close => \&on_child_close,
|
|
got_child_signal => \&on_child_signal,
|
|
attach_child => \&attach_child,
|
|
tick => \&tick,
|
|
queue_command => \&queue_command,
|
|
sig_int => \&interrupt,
|
|
},
|
|
heap => {file => $file, queue => []},
|
|
);
|
|
}
|
|
|
|
sub interrupt {
|
|
my ($heap) = $_[HEAP];
|
|
|
|
my $children = [keys %{$_[HEAP]{children_by_pid}}];
|
|
for my $ck (@$children) {
|
|
my $child = $_[HEAP]{children_by_pid}{$ck};
|
|
$child->kill("QUIT");
|
|
}
|
|
|
|
if (@$children) {$_[KERNEL]->sig_handled(); $heap->{no_kids} = 1;};
|
|
}
|
|
|
|
sub queue_command {
|
|
my (@commands) = @_[ARG0..$#_];
|
|
my ($heap, $kernel) = @_[HEAP, KERNEL];
|
|
print "QUEUED COMMAND! @commands\n";
|
|
push @{$heap->{queue}}, @commands;
|
|
}
|
|
|
|
sub attach_child {
|
|
return if $_[HEAP]{no_kids};
|
|
|
|
system("sudo minecraftquickperms");
|
|
my $file = $_[HEAP]{file};
|
|
my $child = POE::Wheel::Run->new(
|
|
Program => [ "/usr/bin/dtach", "-a", $file ],
|
|
StdoutEvent => "got_child_stdout",
|
|
StderrEvent => "got_child_stderr",
|
|
CloseEvent => "got_child_close",
|
|
Conduit => "pty-pipe",
|
|
);
|
|
$_[KERNEL]->sig_child($child->PID, "got_child_signal");
|
|
# Wheel events include the wheel's ID.
|
|
$_[HEAP]{children_by_wid}{$child->ID} = $child;
|
|
|
|
# Signal events include the process ID.
|
|
$_[HEAP]{children_by_pid}{$child->PID} = $child;
|
|
|
|
print(
|
|
"Child pid ", $child->PID,
|
|
" started as wheel ", $child->ID, ".\n"
|
|
);
|
|
}
|
|
|
|
sub on_start {
|
|
$_[KERNEL]->yield("attach_child");
|
|
$_[KERNEL]->delay_add(tick => 5);
|
|
$_[KERNEL]->sig(INT => "sig_int");
|
|
}
|
|
|
|
sub tick {
|
|
my $heap = $_[HEAP];
|
|
my $queue = $heap->{queue};
|
|
my $children = [keys %{$_[HEAP]{children_by_pid}}];
|
|
|
|
$_[KERNEL]->delay(tick => 2);
|
|
|
|
return unless @$queue; # don't do anything if we don't have anything to run
|
|
|
|
if (@$children == 1) {
|
|
print "only one child!\n";
|
|
my $child = $_[HEAP]{children_by_pid}{$children->[0]};
|
|
$child->put(@$queue); # run everything!
|
|
@$queue = (); # clear the queue!
|
|
} else {
|
|
print "OMG WTF\n";
|
|
}
|
|
}
|
|
|
|
# Wheel event, including the wheel's ID.
|
|
sub on_child_stdout {
|
|
my ($stdout_line, $wheel_id) = @_[ARG0, ARG1];
|
|
my $child = $_[HEAP]{children_by_wid}{$wheel_id};
|
|
print "pid ", $child->PID, " STDOUT: $stdout_line\n";
|
|
}
|
|
|
|
# Wheel event, including the wheel's ID.
|
|
sub on_child_stderr {
|
|
my ($stderr_line, $wheel_id) = @_[ARG0, ARG1];
|
|
my $child = $_[HEAP]{children_by_wid}{$wheel_id};
|
|
print "pid ", $child->PID, " STDERR: $stderr_line\n";
|
|
}
|
|
|
|
# Wheel event, including the wheel's ID.
|
|
sub on_child_close {
|
|
my $wheel_id = $_[ARG0];
|
|
my $child = delete $_[HEAP]{children_by_wid}{$wheel_id};
|
|
|
|
# May have been reaped by on_child_signal().
|
|
unless (defined $child) {
|
|
print "wid $wheel_id closed all pipes.\n";
|
|
return;
|
|
}
|
|
|
|
print "pid ", $child->PID, " closed all pipes.\n";
|
|
delete $_[HEAP]{children_by_pid}{$child->PID};
|
|
$_[KERNEL]->delay_add("attach_child"=>5); # wait five seconds and then add the child again
|
|
}
|
|
|
|
sub on_child_signal {
|
|
print "pid $_[ARG1] exited with status $_[ARG2].\n";
|
|
my $child = delete $_[HEAP]{children_by_pid}{$_[ARG1]};
|
|
|
|
# May have been reaped by on_child_close().
|
|
return unless defined $child;
|
|
|
|
delete $_[HEAP]{children_by_wid}{$child->ID};
|
|
}
|
|
|
|
1;
|