X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=scpubgit%2FObject-Remote.git;a=blobdiff_plain;f=lib%2FObject%2FRemote%2FRole%2FConnector%2FPerlInterpreter.pm;h=32cb87793a564f56dc4a55d8078204124e18b2fc;hp=420707fc047e399195999c0d3b83f004162ecc1a;hb=f4a8508058f7bad5052775a8df3e683527c73333;hpb=624072a8803b6bb08260ff6f2b7fcb0dc05dd190 diff --git a/lib/Object/Remote/Role/Connector/PerlInterpreter.pm b/lib/Object/Remote/Role/Connector/PerlInterpreter.pm index 420707f..32cb877 100644 --- a/lib/Object/Remote/Role/Connector/PerlInterpreter.pm +++ b/lib/Object/Remote/Role/Connector/PerlInterpreter.pm @@ -4,7 +4,7 @@ use IPC::Open2; use IPC::Open3; use IO::Handle; use Symbol; -use Object::Remote::Logging qw( :log :dlog ); +use Object::Remote::Logging qw( :log :dlog router ); use Object::Remote::ModuleSender; use Object::Remote::Handle; use Object::Remote::Future; @@ -16,6 +16,8 @@ with 'Object::Remote::Role::Connector'; has module_sender => (is => 'lazy'); has ulimit => ( is => 'ro' ); has nice => ( is => 'ro' ); +has watchdog_timeout => ( is => 'ro', required => 1, default => sub { undef } ); +has perl_command => (is => 'lazy'); #if no child_stderr file handle is specified then stderr #of the child will be connected to stderr of the parent @@ -28,18 +30,11 @@ sub _build_module_sender { return $hook ? $hook->sender : Object::Remote::ModuleSender->new; } -has perl_command => (is => 'lazy'); -has watchdog_timeout => ( is => 'ro', required => 1, default => sub { 0 } ); - -#SSH requires the entire remote command to be -#given as one single argument to the ssh -#command line program so this jumps through -#some hoops sub _build_perl_command { my ($self) = @_; my $nice = $self->nice; - my $ulimit = $self->ulimit; - my $shell_code = 'sh -c "'; + my $ulimit = $self->ulimit; + my $shell_code = ''; if (defined($ulimit)) { $shell_code .= "ulimit -v $ulimit; "; @@ -49,9 +44,9 @@ sub _build_perl_command { $shell_code .= "nice -n $nice "; } - $shell_code .= 'perl -"'; - - return [ $shell_code ]; + $shell_code .= 'perl -'; + + return [ 'sh', '-c', $shell_code ]; } around connect => sub { @@ -62,7 +57,7 @@ around connect => sub { my ($conn) = $f->get; $self->_setup_watchdog_reset($conn); my $sub = $conn->remote_sub('Object::Remote::Logging::init_logging_forwarding'); - $sub->('Object::Remote::Logging', Object::Remote::Logging->arg_router); + $sub->('Object::Remote::Logging', router => router(), connection_id => $conn->_id); Object::Remote::Handle->new( connection => $conn, class => 'Object::Remote::ModuleLoader', @@ -85,16 +80,16 @@ sub _start_perl { Dlog_debug { "invoking connection to perl interpreter using command line: $_" } @{$self->final_perl_command}; if (defined($given_stderr)) { - #if the stderr data goes to an existing file handle - #an anonymous file handle is required - #as the other half of a pipe style file handle pair - #so the file handles can go into the run loop - $foreign_stderr = gensym(); + #if the stderr data goes to an existing file handle + #an anonymous file handle is required + #as the other half of a pipe style file handle pair + #so the file handles can go into the run loop + $foreign_stderr = gensym(); } else { - #if no file handle has been specified - #for the child's stderr then connect - #the child stderr to the parent stderr - $foreign_stderr = ">&STDERR"; + #if no file handle has been specified + #for the child's stderr then connect + #the child stderr to the parent stderr + $foreign_stderr = ">&STDERR"; } my $pid = open3( @@ -105,25 +100,24 @@ sub _start_perl { ) or die "Failed to run perl at '$_[0]': $!"; if (defined($given_stderr)) { - Dlog_debug { "Child process STDERR is being handled via run loop" }; + Dlog_debug { "Child process STDERR is being handled via run loop" }; - Object::Remote->current_loop - ->watch_io( - handle => $foreign_stderr, - on_read_ready => sub { - my $buf = ''; - my $len = sysread($foreign_stderr, $buf, 32768); - if (!defined($len) or $len == 0) { - log_trace { "Got EOF or error on child stderr, removing from watcher" }; - $self->stderr(undef); - Object::Remote->current_loop - ->unwatch_io( - handle => $foreign_stderr, - on_read_ready => 1 - ); + Object::Remote->current_loop + ->watch_io( + handle => $foreign_stderr, + on_read_ready => sub { + my $buf = ''; + my $len = sysread($foreign_stderr, $buf, 32768); + if (!defined($len) or $len == 0) { + log_trace { "Got EOF or error on child stderr, removing from watcher" }; + $self->stderr(undef); + Object::Remote->current_loop->unwatch_io( + handle => $foreign_stderr, + on_read_ready => 1 + ); } else { - Dlog_trace { "got $len characters of stderr data for connection" }; - print $given_stderr $buf or die "could not send stderr data: $!"; + Dlog_trace { "got $len characters of stderr data for connection" }; + print $given_stderr $buf or die "could not send stderr data: $!"; } } ); @@ -153,7 +147,7 @@ sub _open2_for { ->unwatch_io( handle => $foreign_stdin, on_write_ready => 1 - ); + ); } else { log_trace { "Sent $len bytes of fatnode data to remote side" }; } @@ -163,48 +157,51 @@ sub _open2_for { } sub _setup_watchdog_reset { - my ($self, $conn) = @_; - my $timer_id; + my ($self, $conn) = @_; + my $timer_id; - return unless $self->watchdog_timeout; + return unless $self->watchdog_timeout; - Dlog_trace { "Creating Watchdog management timer for connection id $_" } $conn->_id; + Dlog_trace { "Creating Watchdog management timer for connection id $_" } $conn->_id; - weaken($conn); + weaken($conn); - $timer_id = Object::Remote->current_loop->watch_time( - every => $self->watchdog_timeout / 3, - code => sub { - unless(defined($conn)) { - log_trace { "Weak reference to connection in Watchdog was lost, terminating update timer $timer_id" }; - Object::Remote->current_loop->unwatch_time($timer_id); - return; - } + $timer_id = Object::Remote->current_loop->watch_time( + every => $self->watchdog_timeout / 3, + code => sub { + unless(defined($conn)) { + log_trace { "Weak reference to connection in Watchdog was lost, terminating update timer $timer_id" }; + Object::Remote->current_loop->unwatch_time($timer_id); + return; + } - Dlog_trace { "Reseting Watchdog for connection id $_" } $conn->_id; - #we do not want to block in the run loop so send the - #update off and ignore any result, we don't need it - #anyway - $conn->send_class_call(0, 'Object::Remote::WatchDog', 'reset'); - } - ); + Dlog_trace { "Reseting Watchdog for connection id $_" } $conn->_id; + #we do not want to block in the run loop so send the + #update off and ignore any result, we don't need it + #anyway + $conn->send_class_call(0, 'Object::Remote::WatchDog', 'reset'); + } + ); } sub fatnode_text { my ($self) = @_; + my $connection_timeout = $self->timeout; + my $watchdog_timeout = $self->watchdog_timeout; my $text = ''; require Object::Remote::FatNode; - if (defined($self->watchdog_timeout)) { - $text = "my \$WATCHDOG_TIMEOUT = '" . $self->watchdog_timeout . "';\n"; - $text .= "alarm(\$WATCHDOG_TIMEOUT);\n"; + if (defined($connection_timeout)) { + $text .= "alarm($connection_timeout);\n"; + } + + if (defined($watchdog_timeout)) { + $text .= "my \$WATCHDOG_TIMEOUT = $watchdog_timeout;\n"; } else { - $text = "my \$WATCHDOG_TIMEOUT = undef;\n"; + $text .= "my \$WATCHDOG_TIMEOUT = undef;\n"; } - $text .= 'BEGIN { $ENV{OBJECT_REMOTE_DEBUG} = 1 }'."\n" - if $ENV{OBJECT_REMOTE_DEBUG}; $text .= <<'END'; $INC{'Object/Remote/FatNode.pm'} = __FILE__; $Object::Remote::FatNode::DATA = <<'ENDFAT';