lib/Object/Remote/Role/Connector/PerlInterpreter.pm

   1 package Object::Remote::Role::Connector::PerlInterpreter;
   2
   3 use IPC::Open3;
   4 use IO::Handle;
   5 use Symbol;
   6 use Object::Remote::Logging qw(:log :dlog router);
   7 use Object::Remote::ModuleSender;
   8 use Object::Remote::Handle;
   9 use Object::Remote::Future;
  10 use Scalar::Util qw(blessed weaken);
  11 use Moo::Role;
  12
  13 with 'Object::Remote::Role::Connector';
  14
  15 has module_sender => (is => 'lazy');
  16 has watchdog_timeout => ( is => 'ro', required => 1, default => sub { undef });
  17 has forward_env => (is => 'ro', required => 1, builder => 1);
  18 has perl_command => (is => 'lazy');
  19 has pid => (is => 'rwp');
  20 has connection_id => (is => 'rwp');
  21
  22 #if no child_stderr file handle is specified then stderr
  23 #of the child will be connected to stderr of the parent
  24 has stderr => ( is => 'rw', default => sub { undef } );
  25
  26 BEGIN { router()->exclude_forwarding; }
  27
  28 sub _build_module_sender {
  29   my ($hook) =
  30     grep {blessed($_) && $_->isa('Object::Remote::ModuleLoader::Hook') }
  31       @INC;
  32   return $hook ? $hook->sender : Object::Remote::ModuleSender->new;
  33 }
  34
  35 #By policy object-remote does not invoke a shell
  36 sub _build_perl_command {
  37   my $perl_bin = 'perl';
  38
  39   if (exists $ENV{OBJECT_REMOTE_PERL_BIN}) {
  40     $perl_bin = $ENV{OBJECT_REMOTE_PERL_BIN};
  41   }
  42   return [$perl_bin, '-'];
  43 }
  44
  45 sub _build_forward_env {
  46   return [qw(
  47     OBJECT_REMOTE_PERL_BIN
  48     OBJECT_REMOTE_LOG_LEVEL OBJECT_REMOTE_LOG_FORMAT OBJECT_REMOTE_LOG_SELECTIONS
  49     OBJECT_REMOTE_LOG_FORWARDING
  50   )];
  51 }
  52
  53 around connect => sub {
  54   my ($orig, $self) = (shift, shift);
  55   my $f = $self->$start::start($orig => @_);
  56   return future {
  57     $f->on_done(sub {
  58       my ($conn) = $f->get;
  59       $self->_setup_watchdog_reset($conn);
  60       my $sub = $conn->remote_sub('Object::Remote::Logging::init_remote_logging');
  61       $sub->('Object::Remote::Logging', router => router(), connection_id => $conn->_id);
  62       Object::Remote::Handle->new(
  63         connection => $conn,
  64         class => 'Object::Remote::ModuleLoader',
  65         args => { module_sender => $self->module_sender }
  66       )->disarm_free;
  67       require Object::Remote::Prompt;
  68       Object::Remote::Prompt::maybe_set_prompt_command_on($conn);
  69     });
  70     $f;
  71   } 2;
  72 };
  73
  74 sub final_perl_command { shift->perl_command }
  75
  76 sub _start_perl {
  77   my $self = shift;
  78   my $given_stderr = $self->stderr;
  79   my $foreign_stderr;
  80
  81   Dlog_verbose {
  82     s/\n/ /g; "invoking connection to perl interpreter using command line: $_"
  83   } @{$self->final_perl_command};
  84
  85   if (defined($given_stderr)) {
  86     #if the stderr data goes to an existing file handle
  87     #an anonymous file handle is required
  88     #as the other half of a pipe style file handle pair
  89     #so the file handles can go into the run loop
  90     $foreign_stderr = gensym();
  91   } else {
  92     #if no file handle has been specified
  93     #for the child's stderr then connect
  94     #the child stderr to the parent stderr
  95     $foreign_stderr = ">&STDERR";
  96   }
  97
  98   my $pid = open3(
  99     my $foreign_stdin,
 100     my $foreign_stdout,
 101     $foreign_stderr,
 102     @{$self->final_perl_command},
 103   ) or die "Failed to run perl at '$_[0]': $!";
 104
 105   $self->_set_pid($pid);
 106
 107   if (defined($given_stderr)) {
 108     Dlog_debug { "Child process STDERR is being handled via run loop" };
 109
 110     Object::Remote->current_loop
 111                   ->watch_io(
 112                       handle => $foreign_stderr,
 113                       on_read_ready => sub {
 114                         my $buf = '';
 115                         my $len = sysread($foreign_stderr, $buf, 32768);
 116                         if (!defined($len) or $len == 0) {
 117                           log_trace { "Got EOF or error on child stderr, removing from watcher" };
 118                           $self->stderr(undef);
 119                           Object::Remote->current_loop->unwatch_io(
 120                                          handle => $foreign_stderr,
 121                                          on_read_ready => 1
 122                                        );
 123                           } else {
 124                             Dlog_trace { "got $len characters of stderr data for connection" };
 125                             print $given_stderr $buf or die "could not send stderr data: $!";
 126                           }
 127                          }
 128                       );
 129   }
 130
 131   return ($foreign_stdin, $foreign_stdout, $pid);
 132 }
 133
 134 sub _open2_for {
 135   my $self = shift;
 136   my ($foreign_stdin, $foreign_stdout, $pid) = $self->_start_perl(@_);
 137   my $to_send = $self->fatnode_text;
 138   log_debug { my $len = length($to_send); "Sending contents of fat node to remote node; size is '$len' characters" };
 139   Object::Remote->current_loop
 140                 ->watch_io(
 141                     handle => $foreign_stdin,
 142                     on_write_ready => sub {
 143                       my $len = syswrite($foreign_stdin, $to_send, 32768);
 144                       if (defined $len) {
 145                         substr($to_send, 0, $len) = '';
 146                       }
 147                       # if the stdin went away, we'll never get Shere
 148                       # so it's not a big deal to simply give up on !defined
 149                       if (!defined($len) or 0 == length($to_send)) {
 150                         log_trace { "Got EOF or error when writing fatnode data to filehandle, unwatching it" };
 151                         Object::Remote->current_loop
 152                                       ->unwatch_io(
 153                                           handle => $foreign_stdin,
 154                                           on_write_ready => 1
 155                                       );
 156                       } else {
 157                           log_trace { "Sent $len bytes of fatnode data to remote side" };
 158                       }
 159                     }
 160                   );
 161   return ($foreign_stdin, $foreign_stdout, $pid);
 162 }
 163
 164 sub _setup_watchdog_reset {
 165   my ($self, $conn) = @_;
 166   my $timer_id;
 167
 168   return unless $self->watchdog_timeout;
 169
 170   Dlog_trace { "Creating Watchdog management timer for connection id $_" } $conn->_id;
 171
 172   weaken($conn);
 173
 174   $timer_id = Object::Remote->current_loop->watch_time(
 175     every => $self->watchdog_timeout / 3,
 176     code => sub {
 177       unless(defined($conn)) {
 178         log_warn { "Weak reference to connection in Watchdog was lost, terminating update timer $timer_id" };
 179         Object::Remote->current_loop->unwatch_time($timer_id);
 180         return;
 181       }
 182
 183       unless($conn->is_valid) {
 184         log_warn { "Watchdog timer found an invalid connection, removing the timer" };
 185         Object::Remote->current_loop->unwatch_time($timer_id);
 186         return;
 187       }
 188
 189       Dlog_trace { "Reseting Watchdog for connection id $_" } $conn->_id;
 190       #we do not want to block in the run loop so send the
 191       #update off and ignore any result, we don't need it
 192       #anyway
 193       $conn->send_class_call(0, 'Object::Remote::WatchDog', 'reset');
 194     }
 195   );
 196
 197   $conn->on_close->on_ready(sub {
 198     log_debug { "Removing watchdog for connection that is now closed" };
 199     Object::Remote->current_loop->unwatch_time($timer_id);
 200   });
 201 }
 202
 203 sub fatnode_text {
 204   my ($self) = @_;
 205   my $connection_timeout = $self->timeout;
 206   my $watchdog_timeout = $self->watchdog_timeout;
 207   my $text = '';
 208
 209   require Object::Remote::FatNode;
 210
 211   if (defined($connection_timeout)) {
 212     $text .= "alarm($connection_timeout);\n";
 213   }
 214
 215   if (defined($watchdog_timeout)) {
 216     $text .= "my \$WATCHDOG_TIMEOUT = $watchdog_timeout;\n";
 217   } else {
 218     $text .= "my \$WATCHDOG_TIMEOUT = undef;\n";
 219   }
 220
 221   $text .= $self->_create_env_forward(@{$self->forward_env});
 222
 223   #Action at a distance but at least it's not spooky - the logging
 224   #system needs to know if a node is remote but there is a period
 225   #during init where the remote connection information has not been
 226   #setup on the remote side yet so this flag allows a graceful
 227   #degredation to happen
 228   $text .= '$Object::Remote::FatNode::REMOTE_NODE = "1";' . "\n";
 229
 230   $text .= <<'END';
 231 $INC{'Object/Remote/FatNode.pm'} = __FILE__;
 232 $Object::Remote::FatNode::DATA = <<'ENDFAT';
 233 END
 234   $text .= do { no warnings 'once'; $Object::Remote::FatNode::DATA };
 235   $text .= "ENDFAT\n";
 236   $text .= <<'END';
 237 eval $Object::Remote::FatNode::DATA;
 238 die $@ if $@;
 239 END
 240
 241   $text .= "__END__\n";
 242   return $text;
 243 }
 244
 245 sub _create_env_forward {
 246   my ($self, @env_names) = @_;
 247   my $code = '';
 248
 249   foreach my $name (@env_names) {
 250     next unless exists $ENV{$name};
 251     my $value = $ENV{$name};
 252     $name =~ s/'/\\'/g;
 253     if(defined($value)) {
 254       $value =~ s/'/\\'/g;
 255       $value = "'$value'";
 256     } else {
 257       $value = 'undef';
 258     }
 259     $code .= "\$ENV{'$name'} = $value;\n";
 260   }
 261
 262   return $code;
 263 }
 264
 265 1;
 266
 267 =head1 NAME
 268
 269 Object::Remote::Role::Connector::PerlInterpreter - Role for connections to a Perl interpreter
 270
 271 =head1 SYNOPSIS
 272
 273   use Object::Remote;
 274
 275   my %opts = (
 276     perl_command => [qw(nice -n 10 perl -)],
 277     watchdog_timeout => 120, stderr => \*STDERR,
 278   );
 279
 280   my $local_connection = Object::Remote->connect('-', %opts);
 281   my $hostname = Sys::Hostname->can::on($remote, 'hostname');
 282
 283 =head1 DESCRIPTION
 284
 285 This is the role that supports connections to a Perl interpreter that is executed in a
 286 different process. The new Perl interpreter can be either on the local or a remote machine
 287 and is configurable via arguments passed to the constructor.
 288
 289 =head1 ARGUMENTS
 290
 291 =over 4
 292
 293 =item perl_command
 294
 295 By default the Perl interpeter will be executed as "perl -" but this can be changed by
 296 providing an array reference as the value to the perl_command attribute during construction.
 297
 298 =item stderr
 299
 300 If this value is defined then it will be used as the file handle that receives the output
 301 of STDERR from the Perl interpreter process and I/O will be performed by the run loop in a
 302 non-blocking way. If the value is undefined then STDERR of the remote process will be connected
 303 directly to STDERR of the local process with out the run loop managing I/O. The default value
 304 is undefined.
 305
 306 There are a few ways to use this feature. By default the behavior is to form one unified STDERR
 307 across all of the Perl interpreters including the local one. For small scale and quick operation
 308 this offers a predictable and easy to use way to get at error messages generated anywhere. If
 309 the local Perl interpreter crashes then the remote Perl interpreters still have an active STDERR
 310 and it is possible to still receive output from them. This is generally a good thing but can
 311 cause issues.
 312
 313 When using a file handle as the output for STDERR once the local Perl interpreter is no longer
 314 running there is no longer a valid STDERR for the remote interpreters to send data to. This means
 315 that it is no longer possible to receive error output from the remote interpreters and that the
 316 shell will start to kill off the child processes. Passing a reference to STDERR for the local
 317 interpreter (as the SYNOPSIS shows) causes the run loop to manage I/O, one unified STDERR for
 318 all Perl interpreters that ends as soon as the local interpreter process does, and the shell will
 319 start killing children when the local interpreter exits.
 320
 321 It is also possible to pass in a file handle that has been opened for writing. This would be
 322 useful for logging the output of the remote interpreter directly into a dedicated file.
 323
 324 =item watchdog_timeout
 325
 326 If this value is defined then it will be used as the number of seconds the watchdog will wait
 327 for an update before it terminates the Perl interpreter process. The default value is undefined
 328 and will not use the watchdog. See C<Object::Remote::Watchdog> for more information.
 329
 330 =back
 331
 332 =head1 SEE ALSO
 333
 334 =over 4
 335
 336 =item C<Object::Remote>
 337
 338 =back
 339
 340 =cut