X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=scpubgit%2FObject-Remote.git;a=blobdiff_plain;f=lib%2FObject%2FRemote%2FConnection.pm;h=77fc2d74b8ff416048e3c06e7290634f593b4006;hp=e47b8fcab073994450d1d37574f891f21bf49c41;hb=5ccce2d5c1fb651f83c73c811069003e4a591a53;hpb=d2eadebbdb4416f421ffd5298c782fdc32f388e7 diff --git a/lib/Object/Remote/Connection.pm b/lib/Object/Remote/Connection.pm index e47b8fc..77fc2d7 100644 --- a/lib/Object/Remote/Connection.pm +++ b/lib/Object/Remote/Connection.pm @@ -16,17 +16,19 @@ use Module::Runtime qw(use_module); use Scalar::Util qw(weaken blessed refaddr openhandle); use JSON::PP qw(encode_json); use Moo; +use Carp qw(croak); -BEGIN { - router()->exclude_forwarding; - $SIG{PIPE} = sub { log_debug { "Got a PIPE signal" } }; -} +BEGIN { router()->exclude_forwarding } END { - log_debug { "Killing all child processes in the process group" }; - - #send SIGINT to the process group for our children - kill(1, -2); + our %child_pids; + + log_trace { "END handler is being invoked in " . __PACKAGE__ }; + + foreach(keys(%child_pids)) { + log_debug { "Killing child process '$_'" }; + kill('TERM', $_); + } } has _id => ( is => 'ro', required => 1, default => sub { our $NEXT_CONNECTION_ID++ } ); @@ -34,9 +36,9 @@ has _id => ( is => 'ro', required => 1, default => sub { our $NEXT_CONNECTION_ID has send_to_fh => ( is => 'ro', required => 1, trigger => sub { - my $self = $_[0]; - $_[1]->autoflush(1); - Dlog_trace { my $id = $self->_id; "connection had send_to_fh set to $_" } $_[1]; + my $self = $_[0]; + $_[1]->autoflush(1); + Dlog_trace { my $id = $self->_id; "connection had send_to_fh set to $_" } $_[1]; }, ); @@ -58,8 +60,8 @@ has read_channel => ( has on_close => ( is => 'rw', default => sub { $_[0]->_install_future_handlers(CPS::Future->new) }, trigger => sub { - log_trace { "Installing handlers into future via trigger" }; - $_[0]->_install_future_handlers($_[1]) + log_trace { "Installing handlers into future via trigger" }; + $_[0]->_install_future_handlers($_[1]) }, ); @@ -88,25 +90,30 @@ has _json => ( after BUILD => sub { my ($self) = @_; my $pid = $self->child_pid; - - unless (defined $pid) { - log_trace { "After BUILD invoked for connection but there was no pid" }; - return; - } - - log_trace { "Setting process group of child process '$pid'" }; - - setpgrp($self->child_pid, 1); + our %child_pids; + return unless defined $pid; + $child_pids{$pid} = 1; + return; }; sub BUILD { } sub is_valid { my ($self) = @_; - my $closed = $self->on_close->is_ready; + my $valid = ! $self->on_close->is_ready; - log_trace { "Connection closed: $closed" }; - return ! $closed; + log_trace { + my $id = $self->_id; + my $text; + if ($valid) { + $text = 'yes'; + } else { + $text = 'no'; + } + "Connection '$id' is valid: '$text'" + }; + + return $valid; } sub _fail_outstanding { @@ -120,6 +127,7 @@ sub _fail_outstanding { foreach(keys(%$outstanding)) { log_trace { "Failing future for $_" }; my $future = $outstanding->{$_}; + $future->fail("$error\n"); } %$outstanding = (); @@ -128,6 +136,7 @@ sub _fail_outstanding { sub _install_future_handlers { my ($self, $f) = @_; + our %child_pids; Dlog_trace { "Installing handlers into future for connection $_" } $self->_id; weaken($self); $f->on_done(sub { @@ -148,6 +157,8 @@ sub _install_future_handlers { "Remote Perl interpreter exited with value '$exit_value'" }; } + + delete $child_pids{$pid}; }); return $f; }; @@ -237,9 +248,9 @@ sub conn_from_spec { } sub new_from_spec { - my ($class, $spec) = @_; + my ($class, $spec, @args) = @_; return $spec if blessed $spec; - my $conn = $class->conn_from_spec($spec); + my $conn = $class->conn_from_spec($spec, @args); die "Couldn't figure out what to do with ${spec}" unless defined $conn; @@ -265,7 +276,7 @@ sub connect { sub remote_sub { my ($self, $sub) = @_; my ($pkg, $name) = $sub =~ m/^(.*)::([^:]+)$/; - Dlog_debug { "Invoking remote sub '$sub' for connection $_" } $self->_id; + Dlog_debug { "Invoking remote sub '$sub' for connection '$_'" } $self->_id; return await_future($self->send_class_call(0, $pkg, can => $name)); } @@ -343,7 +354,7 @@ sub _send { my $fh = $self->send_to_fh; unless ($self->is_valid) { - die "Attempt to invoke _send on a connection that is not valid"; + croak "Attempt to invoke _send on a connection that is not valid"; } Dlog_trace { "Starting to serialize data in argument to _send for connection $_" } $self->_id; @@ -501,8 +512,82 @@ sub _invoke { Object::Remote::Connection - An underlying connection for L -=head1 LAME + use Object::Remote; + + my %opts = ( + nice => '10', ulimit => '-v 400000', + watchdog_timeout => 120, stderr => \*STDERR, + ); + + my $local = Object::Remote->connect('-'); + my $remote = Object::Remote->connect('myserver', nice => 5); + my $remote_user = Object::Remote->connect('user@myserver', %opts); + my $local_sudo = Object::Remote->connect('user@'); + + #$remote can be any other connection object + my $hostname = Sys::Hostname->can::on($remote, 'hostname'); + +=head1 DESCRIPTION + +This is the class that supports connections to a Perl interpreter that is executed in a +different process. The new Perl interpreter can be either on the local or a remote machine +and is configurable via arguments passed to the constructor. + +=head1 ARGUMENTS + +=over 4 + +=item nice + +If this value is defined then it will be used as the nice value of the Perl process when it +is started. The default is the undefined value and will not nice the process. + +=item stderr + +If this value is defined then it will be used as the file handle that receives the output +of STDERR from the Perl interpreter process and I/O will be performed by the run loop in a +non-blocking way. If the value is undefined then STDERR of the remote process will be connected +directly to STDERR of the local process with out the run loop managing I/O. The default value +is undefined. + +There are a few ways to use this feature. By default the behavior is to form one unified STDERR +across all of the Perl interpreters including the local one. For small scale and quick operation +this offers a predictable and easy to use way to get at error messages generated anywhere. If +the local Perl interpreter crashes then the remote Perl interpreters still have an active STDERR +and it is possible to still receive output from them. This is generally a good thing but can +cause issues. + +When using a file handle as the output for STDERR once the local Perl interpreter is no longer +running there is no longer a valid STDERR for the remote interpreters to send data to. This means +that it is no longer possible to receive error output from the remote interpreters and that the +shell will start to kill off the child processes. Passing a reference to STDERR for the local +interpreter (as the SYNOPSIS shows) causes the run loop to manage I/O, one unified STDERR for +all Perl interpreters that ends as soon as the local interpreter process does, and the shell will +start killing children when the local interpreter exits. + +It is also possible to pass in a file handle that has been opened for writing. This would be +useful for logging the output of the remote interpreter directly into a dedicated file. + +=item ulimit + +If this string is defined then it will be passed unmodified as the arguments to ulimit when +the Perl process is started. The default value is the undefined value and will not limit the +process in any way. + +=item watchdog_timeout + +If this value is defined then it will be used as the number of seconds the watchdog will wait +for an update before it terminates the Perl interpreter process. The default value is undefined +and will not use the watchdog. See C for more information. + +=back + +=head1 SEE ALSO + +=over 4 + +=item C -Shipping prioritised over writing this part up. Blame mst. +=back =cut