From: Tyler Riddle Date: Wed, 10 Oct 2012 13:46:16 +0000 (-0700) Subject: fix ssh arguments the correct way X-Git-Tag: v0.003001_01~100 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8506bc0849fa561ef232a09e0394c417bc437aa2;p=scpubgit%2FObject-Remote.git fix ssh arguments the correct way --- diff --git a/Makefile.PL b/Makefile.PL index 6ee313e..047562f 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -13,6 +13,7 @@ WriteMakefile( 'JSON::PP' => 0, 'CPS::Future' => 0, 'Class::C3' => 0, # required to fatpack Moo + 'String::ShellEscape' => 0, # required for ssh argument manipulation }, EXE_FILES => [ 'bin/object-remote-node', diff --git a/lib/Object/Remote/Connector/SSH.pm b/lib/Object/Remote/Connector/SSH.pm index 363e214..dbc988a 100644 --- a/lib/Object/Remote/Connector/SSH.pm +++ b/lib/Object/Remote/Connector/SSH.pm @@ -2,6 +2,7 @@ package Object::Remote::Connector::SSH; use Object::Remote::ModuleSender; use Object::Remote::Handle; +use String::ShellQuote; use Moo; with 'Object::Remote::Role::Connector::PerlInterpreter'; @@ -14,24 +15,14 @@ has ssh_options => (is => 'ro', default => sub { [ '-A' ] }); has ssh_command => (is => 'ro', default => sub { 'ssh' }); -sub _escape_shell_arg { - my ($self, $str) = (@_); - $str =~ s/((?:^|[^\\])(?:\\\\)*)'/$1\\'/g; - return "$str"; -} - - sub _build_ssh_perl_command { my ($self) = @_; - my $perl_command = join('', @{$self->perl_command}); - - #TODO non-trivial to escape properly for ssh and shell - #this "works" but is not right, needs to be replaced - #after testing + my $perl_command = $self->perl_command; + return [ do { my $c = $self->ssh_command; ref($c) ? @$c : $c }, @{$self->ssh_options}, $self->ssh_to, - $self->_escape_shell_arg($perl_command), + shell_quote(@$perl_command), ]; } diff --git a/lib/Object/Remote/Role/Connector/PerlInterpreter.pm b/lib/Object/Remote/Role/Connector/PerlInterpreter.pm index 60c0dd4..5bf2f96 100644 --- a/lib/Object/Remote/Role/Connector/PerlInterpreter.pm +++ b/lib/Object/Remote/Role/Connector/PerlInterpreter.pm @@ -30,18 +30,11 @@ sub _build_module_sender { return $hook ? $hook->sender : Object::Remote::ModuleSender->new; } -#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; - my $ulimit = $self->ulimit; - my $shell_code = 'sh -c "'; + my $ulimit = $self->ulimit; + my $shell_code = ''; if (defined($ulimit)) { $shell_code .= "ulimit -v $ulimit; "; @@ -51,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 { diff --git a/t/perl_execute.t b/t/perl_execute.t index 3777485..c710ed3 100644 --- a/t/perl_execute.t +++ b/t/perl_execute.t @@ -22,11 +22,11 @@ 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"); +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;