瀏覽代碼

WIP on remote shim, need to plumb it up now and add prove bitz

Andy Baugh 3 年之前
父節點
當前提交
6cb5a68116
共有 3 個文件被更改,包括 59 次插入5 次删除
  1. 27 0
      bin/remote_shim.pl
  2. 29 3
      bin/rprove
  3. 3 2
      lib/App/Prove/Remote/Connector.pm

+ 27 - 0
bin/remote_shim.pl

@@ -0,0 +1,27 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+my $wd   = $ENV{'RPROVE_WORK_DIR'};
+my $test = $ARGV[0];
+my $ssh  = Net::OpenSSH->new($ENV{'RPROVE_HOST'});
+
+# Print directly to stdout, as this function merges
+# STDOUT & STDERR and discards STDIN.
+# Do this to avoid TTY overflow, and because prove expects
+# to capture output from STDOUT/ERR anyways.
+my $system_opts = {
+    'stdout_discard'   => 0,
+    'stderr_discard'   => 0,
+    'stderr_to_stdout' => 1,
+    'stdin_discard'    => 1,
+};
+
+# Optionally move to the working directory.
+my $cd = $wd ? "cd $wd && " : '';
+$ssh->system(
+    $system_opts, "${cd}$ENV{'RPROVE_INTERPRETER'} '$wd/$test'" 
+);
+
+# Net::OpenSSH sets this value correctly for our purposes here.
+exit $?;

+ 29 - 3
bin/rprove

@@ -10,13 +10,17 @@ use Getopt::Long                  ();
 exit run() unless caller();
 exit run() unless caller();
 
 
 sub run {
 sub run {
-    my ( $host, $verbosity, @tests ) = ('127.0.0.1', 0);
+    my ( $host, $verbosity, $workdir ) = ( '127.0.0.1', 0, '', 'perl' );
     Getopt::Long::Configure( 'bundling', 'auto_help', 'pass_through' );
     Getopt::Long::Configure( 'bundling', 'auto_help', 'pass_through' );
     Getopt::Long::GetOptions(
     Getopt::Long::GetOptions(
         'host|h=s'      => \$host,
         'host|h=s'      => \$host,
         'verbosity|v=i' => \$verbosity,
         'verbosity|v=i' => \$verbosity,
+		'workdir=s'     => \$workdir,
+		'interpreter=s' => \$interpreter,
     );
     );
-    my $conn = App::Prove::Remote::Connector->new($host, $verbosity);
+    my $conn = App::Prove::Remote::Connector->new(
+		$host, $verbosity, $workdir, $interpreter
+	);
     return 0;
     return 0;
 }
 }
 
 
@@ -54,13 +58,35 @@ Host to connect to. Defaults to 127.0.0.1
 How verbose you want this to be. Useful if you need to debug
 How verbose you want this to be. Useful if you need to debug
 some strange SSH behavior.
 some strange SSH behavior.
 
 
+=item B<-wordkir>
+
+Directory to execute the test from. Useful to set if the test requires it.
+
+=item B<-interpreter>
+
+Path to the interpreter to run your tests with. Default is /usr/bin/perl.
+Useful to set if you have perl in a nonstandard location
+or non-perl tests to execute that still emit valid TAP.
+
 =back
 =back
 
 
 =head1 DESCRIPTION
 =head1 DESCRIPTION
 
 
 B<rprove> will locally run prove with a --exec argument which is a shim.
 B<rprove> will locally run prove with a --exec argument which is a shim.
 This (remote_shim.pl) will connect to the remote host for the test in
 This (remote_shim.pl) will connect to the remote host for the test in
-question, upload it to a temporary directory and run it on the host.
+question and run it on the host.
+
+Why do this? Because sometimes testing certain scenarios is better done
+on a disposable remote environment instead of on the local environment.
+
+If someone has a "smoker" like environment (Jenkins, some other CI) which
+also runs your tests, this could also be of use from the orchestrator's
+end.
+
+Anyways, the user is responsible for ensuring the test (and code under
+test) has been properly deployed to the remote system under test, so
+make sure that's done first if you want this approach to work.
+
 Output of the script is then read by the TAP parser as is expected for
 Output of the script is then read by the TAP parser as is expected for
 a seamless testing experience *as if you had ran the test locally*.
 a seamless testing experience *as if you had ran the test locally*.
 
 

+ 3 - 2
lib/App/Prove/Remote/Connector.pm

@@ -10,11 +10,12 @@ use experimental 'signatures';
 
 
 # Cache the connections/objects internally
 # Cache the connections/objects internally
 my ( $ssh, $sftp );
 my ( $ssh, $sftp );
-sub new ( $class,  $host='127.0.0.1', $verbosity=0 ) {
+sub new ( $class,  $host='127.0.0.1', $verbosity=0, $workdir=undef ) {
     my $obj = bless {
     my $obj = bless {
         'ppid'      => $$, # May not need this ultimately
         'ppid'      => $$, # May not need this ultimately
         'host'      => $host,
         'host'      => $host,
-        'verbosity' => $verbosity
+        'verbosity' => $verbosity,
+		'workdir'   => $workdir,
     }, $class;
     }, $class;
     return $obj;
     return $obj;
 }
 }