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=4f74078d6799a4cc907746ce52532767696aa6cb;hb=f4a8508058f7bad5052775a8df3e683527c73333;hpb=353556c4b81bcb3a0c3fff934eff5ab2f19733d4 diff --git a/lib/Object/Remote/Role/Connector/PerlInterpreter.pm b/lib/Object/Remote/Role/Connector/PerlInterpreter.pm index 4f74078..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; @@ -14,6 +14,10 @@ use Moo::Role; 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 @@ -26,11 +30,24 @@ 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 } ); - -#TODO convert the ulimit and nice values into configurable attributes -sub _build_perl_command {[ 'sh -c "ulimit -v 200000; nice -n 15 perl -"' ] } +sub _build_perl_command { + my ($self) = @_; + my $nice = $self->nice; + my $ulimit = $self->ulimit; + my $shell_code = ''; + + if (defined($ulimit)) { + $shell_code .= "ulimit -v $ulimit; "; + } + + if (defined($nice)) { + $shell_code .= "nice -n $nice "; + } + + $shell_code .= 'perl -'; + + return [ 'sh', '-c', $shell_code ]; +} around connect => sub { my ($orig, $self) = (shift, shift); @@ -40,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', @@ -63,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 need 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( @@ -83,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: $!"; } } ); @@ -131,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" }; } @@ -141,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';