use B qw(perlstring);
my @exclude_mods = qw(XSLoader.pm DynaLoader.pm);
+#used by t/watchdog_fatnode
+our $INHIBIT_RUN_NODE = 0;
sub stripspace {
my ($text) = @_;
use strictures 1;
use Object::Remote::Node;
- Object::Remote::Node->run(watchdog_timeout => $WATCHDOG_TIMEOUT);
+
+ unless ($Object::Remote::FatNode::INHIBIT_RUN_NODE) {
+ Object::Remote::Node->run(watchdog_timeout => $WATCHDOG_TIMEOUT);
+ }
+
END_END
my %files = map +($mods{$_} => scalar do { local (@ARGV, $/) = ($_); <> }),
log_trace { "run() has been invoked on remote node" };
if ($args{watchdog_timeout}) {
- Object::Remote::WatchDog->new(timeout => $args{watchdog_timeout});
+ Object::Remote::WatchDog->new(timeout => $args{watchdog_timeout});
}
my $c = Object::Remote::Connector::STDIO->new->connect;
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
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
+
+#TODO this is SSH's problem not perl's so move
+#this to the SSH connector
sub _build_perl_command {
my ($self) = @_;
my $nice = $self->nice;
use Object::Remote::Logging qw ( :log :dlog );
use Moo;
-BEGIN {
- $SIG{ALRM} = sub {
- #if the Watchdog is killing the process we don't want any chance of the
- #process not actually exiting and die could be caught by an eval which
- #doesn't do us any good
- log_error { sprintf("Watchdog has expired, terminating the process at file %s line %s", __FILE__, __LINE__ + 1); };
- exit(1);
- };
-};
-
has timeout => ( is => 'ro', required => 1 );
around new => sub {
#start the watchdog
sub BUILD {
my ($self) = @_;
+
+ $SIG{ALRM} = sub {
+ #if the Watchdog is killing the process we don't want any chance of the
+ #process not actually exiting and die could be caught by an eval which
+ #doesn't do us any good
+ log_error { sprintf("Watchdog has expired, terminating the process at file %s line %s", __FILE__, __LINE__ + 1); };
+ exit(1);
+ };
+
Dlog_debug { "Initializing watchdog with timeout of $_ seconds" } $self->timeout;
alarm($self->timeout);
}
use Test::Fatal;
use FindBin;
use lib "$FindBin::Bin/lib";
+require 't/logsetup.pl';
use Object::Remote;
use Object::Remote::Future qw( await_all await_future );
use Test::More;
use Sys::Hostname qw(hostname);
+require 't/logsetup.pl';
+
use Object::Remote;
$ENV{PERL5LIB} = join(
use Test::More;
use Sys::Hostname qw(hostname);
+require 't/logsetup.pl';
+
use Object::Remote::FromData;
my $connection = Object::Remote->connect('-');
use lib "$FindBin::Bin/lib";
+require 't/logsetup.pl';
+
use Object::Remote;
is exception {
--- /dev/null
+package ORTestTiedRemote;
+
+use Moo;
+
+use Tie::Array;
+use Tie::Hash;
+
+has hash => ( is => 'ro', builder => 1 );
+has array => ( is => 'ro', builder => 1 );
+
+sub _build_hash {
+ tie(my %hash, 'Tie::StdHash');
+ %hash = ( akey => 'a value');
+ return \%hash;
+}
+
+sub _build_array {
+ tie(my @array, 'Tie::StdArray');
+ @array = ('another value');
+ return \@array;
+}
+
+sub sum_array {
+ my ($self) = @_;
+ my $sum = 0;
+
+ foreach(@{$self->array}) {
+ $sum += $_;
+ }
+
+ return $sum;
+}
+
+sub sum_hash {
+ my ($self) = @_;
+ my $sum = 0;
+
+ foreach(values(%{$self->hash})) {
+ $sum += $_;
+ }
+
+ return $sum;
+}
+
+1;
+
--- /dev/null
+#require this file in the test to initialize the logging framework
+#so the tests can run
+
+package Object::Remote::Logger::TestOutput;
+
+use base qw ( Log::Contextual::SimpleLogger );
+
+#we want the code blocks in the log lines to execute but not
+#output anything so turn this into a null logger
+sub _log { }
+
+package main;
+
+use Object::Remote::Logging qw( :log );
+use Object::Remote::LogDestination;
+#make sure to enable execution of every logging code block
+#by setting the log level as high as it can go
+ my $____LOG_DESTINATION = Object::Remote::LogDestination->new(
+ logger => Object::Remote::Logger::TestOutput->new({ levels_upto => 'trace' }),
+ );
+
+ $____LOG_DESTINATION->connect(Object::Remote::Logging->arg_router);
+1;
+
--- /dev/null
+use strictures 1;
+use Test::More;
+
+use Data::Dumper;
+
+require 't/logsetup.pl';
+
+use Object::Remote::Connector::Local;
+use Object::Remote::Connector::SSH;
+
+my $defaults = Object::Remote::Connector::Local->new;
+
+my $normal = $defaults->final_perl_command;
+my $ulimit = Object::Remote::Connector::Local->new(ulimit => 536)->final_perl_command;
+my $nice = Object::Remote::Connector::Local->new(nice => 834)->final_perl_command;
+my $both = Object::Remote::Connector::Local->new(nice => 612, ulimit => 913)->final_perl_command;
+my $ssh = Object::Remote::Connector::SSH->new(nice => 494, ulimit => 782, ssh_to => 'testhost')->final_perl_command;
+
+is($defaults->timeout->{after}, 10, 'Default connection timeout value is correct');
+is($defaults->watchdog_timeout, undef, 'Watchdog is not enabled by default');
+is($defaults->nice, undef, 'Nice is not enabled by default');
+is($defaults->ulimit, undef, 'Ulimit is not enabled by default');
+is($defaults->stderr, undef, 'Child process STDERR is clone of parent process STDERR by default');
+
+is_deeply($normal, ['sh -c "perl -"'], 'Default Perl interpreter arguments correct');
+is_deeply($ulimit, ['sh -c "ulimit -v 536; perl -"'], 'Arguments for ulimit are correct');
+is_deeply($nice, ['sh -c "nice -n 834 perl -"'], 'Arguments for nice are correct');
+is_deeply($both, ['sh -c "ulimit -v 913; nice -n 612 perl -"'], 'Arguments for nice and ulimit are correct');
+is_deeply($ssh, [qw(ssh -A testhost), 'sh -c "ulimit -v 782; nice -n 494 perl -"'], "Arguments using ssh are correct");
+
+done_testing;
+
use strictures 1;
use Test::More;
+require 't/logsetup.pl';
+
use Object::Remote::Connector::Local;
use Object::Remote;
use Object::Remote::ModuleSender;
use Object::Remote;
use File::Spec;
+require 't/logsetup.pl';
+
{
package S1S;
--- /dev/null
+use strictures 1;
+use Test::More;
+
+use lib 't/lib';
+
+use Tie::Array;
+use Tie::Hash;
+
+require 't/logsetup.pl';
+
+use Object::Remote;
+use ORTestTiedRemote;
+
+my @test_data = qw(1 5 10 30 80);
+my $test_sum;
+
+map { $test_sum += $_ } @test_data;
+
+my $conn = Object::Remote->connect('-');
+my $remote = ORTestTiedRemote->new::on($conn);
+
+isa_ok($remote, 'Object::Remote::Proxy');
+
+my $remote_array = $remote->array;
+my $remote_hash = $remote->hash;
+
+is(ref($remote_array), 'ARRAY', 'Array ref is array ref');
+is(ref(tied(@$remote_array)), 'Object::Remote::Proxy', 'Array is tied to proxy object');
+is_deeply($remote_array, ['another value'], 'Array is initialized properly');
+
+@$remote_array = @test_data;
+is($remote->sum_array, $test_sum, 'Sum of array data matches sum of test data');
+
+is(ref($remote_hash), 'HASH', 'Hash ref is hash ref');
+is(ref(tied(%$remote_hash)), 'Object::Remote::Proxy', 'Hash is tied to proxy object');
+is_deeply($remote_hash, { akey => 'a value' }, 'Hash is initialized properly');
+
+%$remote_hash = ();
+do { my $i = 0; map { $remote_hash->{++$i} = $_ } @test_data };
+is($remote->sum_hash, $test_sum, 'Sum of hash values matches sum of test data');
+
+done_testing;
+
+
+
\ No newline at end of file
use strictures 1;
use Test::More;
+require 't/logsetup.pl';
+
use Object::Remote;
use Object::Remote::Connector::Local;
use Test::Fatal;
use FindBin;
+require 't/logsetup.pl';
+
$ENV{PERL5LIB} = join(
':', ($ENV{PERL5LIB} ? $ENV{PERL5LIB} : ()), qw(lib t/lib)
);
--- /dev/null
+use strictures 1;
+use Test::More;
+
+require 't/logsetup.pl';
+
+use Object::Remote::Connection;
+use Object::Remote::FromData;
+
+$SIG{ALRM} = sub { fail("Watchdog killed remote process in time"); die "test failed" };
+
+my $conn = Object::Remote::Connection->conn_from_spec("-", watchdog_timeout => 1)->connect;
+
+my $remote = HangClass->new::on($conn);
+
+isa_ok($remote, 'Object::Remote::Proxy');
+is($remote->alive, 1, "Hanging test object is running");
+
+alarm(3);
+
+eval { $remote->hang };
+
+like($@, qr/^Object::Remote connection lost: eof/, "Correct error message");
+
+done_testing;
+
+__DATA__
+
+package HangClass;
+
+use Moo;
+
+sub alive {
+ return 1;
+}
+
+sub hang {
+ while(1) {
+ sleep(1);
+ }
+}
+
+
+
+
+
--- /dev/null
+use strictures 1;
+use Test::More;
+
+require 't/logsetup.pl';
+
+use Object::Remote::Connector::Local;
+
+$SIG{ALRM} = sub { die "alarm signal\n" };
+
+open(my $nullfh, '>', '/dev/null') or die "Could not open /dev/null: $!";
+
+my $fatnode_text = Object::Remote::Connector::Local->new(watchdog_timeout => 1)->fatnode_text;
+
+#this simulates a node that has hung before it reaches
+#the watchdog initialization - it's an edge case that
+#could cause remote processes to not get cleaned up
+#if it's not handled right
+eval {
+ no warnings 'once';
+ local *STDOUT = $nullfh;
+ $Object::Remote::FatNode::INHIBIT_RUN_NODE = 1;
+ eval $fatnode_text;
+
+ if ($@) {
+ die "could not eval fatnode text: $@";
+ }
+
+ while(1) {
+ sleep(1);
+ }
+};
+
+is($@, "alarm signal\n", "Alarm handler was invoked");
+
+done_testing;
+
projects / scpubgit/Object-Remote.git / commitdiff