Bug #105771 for Net-OpenSSH: Support for server to server scp

There didn't seem to be any way to use the scp_put functionality to do a server to server copy. I have added a new option, "remote_src", to allow this. I don't know if this is the best approach or not but it is working for me. --- OpenSSH.pm.orig 2015-07-08 19:51:06.963301058 +0200 +++ OpenSSH.pm 2015-07-09 12:47:37.252742665 +0200 @@ -1,6 +1,6 @@ package Net::OpenSSH; -our $VERSION = '0.64'; +our $VERSION = '0.65'; use strict; use warnings; @@ -2097,9 +2097,17 @@ $prefix = "$self->{_user}\@$prefix" if defined $self->{_user}; my $remote_shell = delete $opts{remote_shell}; - my $target = $prefix . ':' . ( @_ > 1 - ? $self->_quote_args({quote_args => 1, remote_shell => $remote_shell}, pop(@_)) - : ''); + my $remote_src = delete $opts{remote_src}; + + # if remote_src is set then we are 'put'ing from the remote machine + # so we can't assume the target will be the remote machine + my($target); + if (! $remote_src) { + $target = $prefix . ':'; + } + $target .= ( @_ > 1 + ? $self->_quote_args({quote_args => 1, remote_shell => $remote_shell}, pop(@_)) + : ''); my @src = @_; if ($glob) { @@ -2111,7 +2119,11 @@ return undef; } } - $_ = "./$_" for grep m|^[^/]*:|, @src; + if ($remote_src) { + map { $_ = $prefix . ':' . $_ } @src; + } else { + $_ = "./$_" for grep m|^[^/]*:|, @src; + } ($self, \%opts, $target, @src); } @@ -3473,6 +3485,14 @@ Note that C<scp> will not generate progress reports unless its stdout stream is attached to a tty. +=item remote_src => 0 + +scp_put only. Indicates that the src argument is located on the remote host +and the scp is initiated from there. Ordinarily you will specify a target +string beginning with 'host:' to perform a server to server copy. For +example, to copy a file from the remote system to a machine called +"host2": + + $ssh->scp_put({'remote_src' => 1 }, 'example.txt', 'host2:new_example.txt'); + =item ssh_opts => \@opts List of extra options for the C<ssh> command.