X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FObject%2FRemote%2FConnector%2FSSH.pm;h=73bc2fc2630ad7b775b8e49190fc0dde706db92e;hb=f425c3cb155190f7113bda4ad91d831662a2ac7a;hp=fcfb445905e710bfc2a01e063f7810c9414e6c3d;hpb=b9baacc29444767f88abdbca93f65c8bd5e5a676;p=scpubgit%2FObject-Remote.git diff --git a/lib/Object/Remote/Connector/SSH.pm b/lib/Object/Remote/Connector/SSH.pm index fcfb445..73bc2fc 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,27 +15,14 @@ has ssh_options => (is => 'ro', default => sub { [ '-A' ] }); has ssh_command => (is => 'ro', default => sub { 'ssh' }); -#TODO properly integrate if this works -BEGIN { $ENV{TERM} = 'dumb'; } - -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), ]; } @@ -42,7 +30,7 @@ sub final_perl_command { shift->ssh_perl_command } no warnings 'once'; -push @Object::Remote::Connection::Guess, sub { +push @Object::Remote::Connection::Guess, sub { for ($_[0]) { # 0-9 a-z _ - first char, those or . subsequent - hostnamish if (defined and !ref and /^(?:.*?\@)?[\w\-][\w\-\.]/) {