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=3b4adfc70bd285a4f5bfa2656d3043ca03713aea;hp=6c10d4584c0196c097ce17c59d8e8b5e29acf4df;hb=de9062cfef7f98d0efc01b114328959f2f84ada4;hpb=fb258df60473013795325e4607b24239ca9db0fc diff --git a/lib/Object/Remote/Connection.pm b/lib/Object/Remote/Connection.pm index 6c10d45..3b4adfc 100644 --- a/lib/Object/Remote/Connection.pm +++ b/lib/Object/Remote/Connection.pm @@ -21,13 +21,14 @@ use Carp qw(croak); BEGIN { router()->exclude_forwarding } END { - log_debug { "Killing all child processes in the process group" }; - - #FIXME update along with setpgrp() to not use a process - #group anymore - - #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++ } ); @@ -45,11 +46,11 @@ has read_channel => ( is => 'ro', required => 1, trigger => sub { my ($self, $ch) = @_; - my $id = $self->_id; + my $id = $self->_id; Dlog_trace { "trigger for read_channel has been invoked for connection $id; file handle is $_" } $ch->fh; weaken($self); $ch->on_line_call(sub { $self->_receive(@_) }); - $ch->on_close_call(sub { + $ch->on_close_call(sub { log_trace { "invoking 'done' on on_close handler for connection id '$id'" }; $self->on_close->done(@_); }); @@ -89,17 +90,10 @@ 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'" }; - - #FIXME moving things into a process group has side effects for - #users of the library - move to a list - setpgrp($self->child_pid, 1); + our %child_pids; + return unless defined $pid; + $child_pids{$pid} = 1; + return; }; sub BUILD { } @@ -107,7 +101,7 @@ sub BUILD { } sub is_valid { my ($self) = @_; my $valid = ! $self->on_close->is_ready; - + log_trace { my $id = $self->_id; my $text; @@ -118,15 +112,15 @@ sub is_valid { } "Connection '$id' is valid: '$text'" }; - + return $valid; } sub _fail_outstanding { my ($self, $error) = @_; my $outstanding = $self->outstanding_futures; - - Dlog_debug { + + Dlog_debug { sprintf "Failing %i outstanding futures with '$error'", scalar(keys(%$outstanding)) }; @@ -142,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 { @@ -162,8 +157,10 @@ sub _install_future_handlers { "Remote Perl interpreter exited with value '$exit_value'" }; } + + delete $child_pids{$pid}; }); - return $f; + return $f; }; sub _id_to_remote_object { @@ -219,9 +216,9 @@ sub _build__json { } sub _load_if_possible { - my ($class) = @_; + my ($class) = @_; - use_module($class); + use_module($class); if ($@) { log_debug { "Attempt at loading '$class' failed with '$@'" }; @@ -236,7 +233,7 @@ BEGIN { Object::Remote::Connector::LocalSudo Object::Remote::Connector::SSH Object::Remote::Connector::UNIX - ); + ); } sub conn_from_spec { @@ -246,7 +243,7 @@ sub conn_from_spec { return $conn; } } - + return undef; } @@ -254,11 +251,11 @@ sub new_from_spec { my ($class, $spec, @args) = @_; return $spec if blessed $spec; my $conn = $class->conn_from_spec($spec, @args); - + die "Couldn't figure out what to do with ${spec}" unless defined $conn; - - return $conn->maybe::start::connect; + + return $conn->maybe::start::connect; } sub remote_object { @@ -355,32 +352,32 @@ sub send_discard { sub _send { my ($self, $to_send) = @_; my $fh = $self->send_to_fh; - + unless ($self->is_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; my $serialized = $self->_serialize($to_send)."\n"; Dlog_trace { my $l = length($serialized); "serialization is completed; sending '$l' characters of serialized data to $_" } $fh; - my $ret; - eval { + my $ret; + eval { #TODO this should be converted over to a non-blocking ::WriteChannel class die "filehandle is not open" unless openhandle($fh); log_trace { "file handle has passed openhandle() test; printing to it" }; $ret = print $fh $serialized; die "print was not successful: $!" unless defined $ret }; - + if ($@) { Dlog_debug { "exception encountered when trying to write to file handle $_: $@" } $fh; my $error = $@; chomp($error); $self->on_close->done("could not write to file handle: $error") unless $self->on_close->is_ready; - return; + return; } - - return $ret; + + return $ret; } sub _serialize { @@ -422,14 +419,14 @@ sub _deobjectify { if ($ref eq 'HASH') { my $tied_to = tied(%$data); if(defined($tied_to)) { - return +{__remote_tied_hash__ => $self->_local_object_to_id($tied_to)}; + return +{__remote_tied_hash__ => $self->_local_object_to_id($tied_to)}; } else { return +{ map +($_ => $self->_deobjectify($data->{$_})), keys %$data }; } } elsif ($ref eq 'ARRAY') { my $tied_to = tied(@$data); if (defined($tied_to)) { - return +{__remote_tied_array__ => $self->_local_object_to_id($tied_to)}; + return +{__remote_tied_array__ => $self->_local_object_to_id($tied_to)}; } else { return [ map $self->_deobjectify($_), @$data ]; } @@ -516,79 +513,25 @@ sub _invoke { Object::Remote::Connection - An underlying connection for L 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 $remote = Object::Remote->connect('myserver'); + my $remote_user = Object::Remote->connect('user@myserver'); 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 +=head1 DESCRIPTION -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 +This is the class that supports connections to remote objects. =head1 SEE ALSO =over 4 +=item C + =item C =back