File Coverage

blib/lib/Net/SSH/Any.pm

Criterion	Covered	Total	%
statement	27	181	14.9
branch	0	106	0.0
condition	0	67	0.0
subroutine	9	29	31.0
pod	11	13	84.6
total	47	396	11.8

package Net::SSH::Any;

our $VERSION = '0.09';

use strict;
use warnings;
use warnings::register;
use Carp;

use Net::SSH::Any::Util;
use Net::SSH::Any::URI;
use Net::SSH::Any::Constants qw(:error);
use Scalar::Util qw(dualvar);

use Net::SSH::Any::_Base;
our @ISA = qw(Net::SSH::Any::_Base);

my $REQUIRED_BACKEND_VERSION = '2';
our @default_backends = qw(Net_OpenSSH Net_SSH2 Net_SSH_Perl Ssh_Cmd Plink_Cmd);

sub _new {
    my ($class, $opts) = @_;
    my $any = $class->SUPER::_new($opts);
    $opts->{uri} // $opts->{host} // croak "either host or uri argument must be given";
    $opts->{password} //= delete $opts->{passwd};

    my @uri_opts = (port => 22);
    if (defined (my $uri = delete $opts->{uri})) {
        $uri = $uri->as_string if ref $uri and $uri->can('as_string');
        push @uri_opts, uri => $uri;
    }
    for (qw(host user port password passphrase)) {
        if (defined (my $v = delete $opts->{$_})) {
            push @uri_opts, $_, $v;
        }
    }
    my $uri = $any->{uri} = Net::SSH::Any::URI->new(@uri_opts);
    unless ($uri) {
        $any->_set_error(SSHA_CONNECTION_ERROR, "Unable to parse URI");
        return $any;
    }

    unless (defined $uri->user) {
        if (defined (my $current_user = $any->_os_current_user)) {
            $uri->user($current_user);
        }
        else {
            $any->_set_error(SSHA_UNIMPLEMENTED_ERROR, "Unable to infer login name");
            return $any;
        }
    }

    if (defined (my $key_paths = delete $opts->{key_path} // delete $opts->{key_paths})) {
        $uri->or_set(key_path => _array_or_scalar_to_list($key_paths))
    }

    $any->{io_timeout} = delete $opts->{io_timeout} // 120;
    $any->{timeout} = delete $opts->{timeout};
    $any->{remote_shell} = delete $opts->{remote_shell} // 'POSIX';
    $any->{known_hosts_path} = delete $opts->{known_hosts_path};
    $any->{strict_host_key_checking} = delete $opts->{strict_host_key_checking} // 1;
    $any->{compress} = delete $opts->{compress} // 1;
    $any->{backend_opts} = delete $opts->{backend_opts};
    $any->{batch_mode} = delete $opts->{batch_mode};

    my @backends = _array_or_scalar_to_list(delete $opts->{backend} // delete $opts->{backends} // \@default_backends);
    $any->{backends} = \@backends;

    for my $backend (@backends) {
        $any->{error} = 0;
        if ($any->_load_backend_module(__PACKAGE__, $backend, $REQUIRED_BACKEND_VERSION)) {
            $any->{backend} or croak "internal error: backend not set";
            my %backend_opts = map { $_ => $any->{$_} // scalar($uri->get($_)) }
                qw(host port user password passphrase key_path timeout io_timeout
                   strict_host_key_checking known_hosts_path compress batch_mode);


            if (my $extra = $any->{backend_opts}{$backend}) {
                @backend_opts{keys %$extra} = values %$extra;
            }
            defined $backend_opts{$_} or delete $backend_opts{$_}
                for keys %backend_opts;

            if ($any->_validate_backend_opts(%backend_opts)) {
                $any->_connect;
                return $any;
            }
            unless ($any->{error}) {
                $any->_set_error(SSHA_BACKEND_ERROR, "internal error: _validate_backend_opts failed without setting the error");
            }
            $any->_log_error_and_reset_backend;
        }
    }
    $any->_set_error(SSHA_NO_BACKEND_ERROR, "no backend available");
    $any;
}

sub new {
    my $class = shift;
    my %opts = (@_ & 1 ? (uri => @_) : @_);
    $class->_new(\%opts);
}

sub _clear_error {
    my $any = shift;
    my $error = $any->{error};
    return if ( $error and
                ( $error == SSHA_NO_BACKEND_ERROR or
                  $error == SSHA_BACKEND_ERROR or
                  $error == SSHA_CONNECTION_ERROR ) );
    $any->{error} = 0;
    1;
}

sub _quoter {
    my ($any, $shell) = @_;
    if (defined $shell and $shell ne $any->{remote_shell}) {
	return $any->_new_quoter($shell);
    }
    $any->{quoter} //= $any->_new_quoter($any->{remote_shell});
}

sub _delete_stream_encoding_and_encode_input_data {
    my ($any, $opts) = @_;
    my $stream_encoding = $any->_delete_stream_encoding($opts) or return;
    $debug and $debug & 1024 and _debug("stream_encoding: "
                                        . ($stream_encoding ? $stream_encoding : '') );
    if (defined(my $data = $opts->{stdin_data})) {
        my @input = grep defined, _array_or_scalar_to_list $data;
        $any->_encode_data($stream_encoding => @input) or return;
        $opts->{stdin_data} = \@input;
    }
    $stream_encoding
}

sub _check_child_error {
    my $any = shift;
    $any->error and return;
    if ($?) {
        $any->_set_error(SSHA_REMOTE_CMD_ERROR,
                         "remote command failed with code " . ($? >> 8)
                         . " and signal " . ($? & 255));
        return;
    }
    return 1;
}

_sub_options capture => qw(timeout stdin_data stderr_to_stdout stderr_discard
                           stderr_fh stderr_file);
sub capture {
    my $any = shift;
    $any->_clear_error or return undef;
    my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
    my $stream_encoding = $any->_delete_stream_encoding_and_encode_input_data(\%opts) or return;
    my $cmd = $any->_quote_args(\%opts, @_) // return;
    _croak_bad_options %opts;
    my ($out) = $any->_capture(\%opts, $cmd) or return;
    $any->_check_child_error;
    if ($stream_encoding) {
	$any->_decode_data($stream_encoding => $out) or return;
    }
    if (wantarray) {
	my $pattern = quotemeta $/;
	return split /(?<=$pattern)/, $out;
    }
    $out
}

_sub_options capture2 => qw(timeout stdin_data);
sub capture2 {
    my $any = shift;
    $any->_clear_error or return undef;
    my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
    my $stream_encoding = $any->_delete_stream_encoding_and_encode_input_data(\%opts) or return;
    my $cmd = $any->_quote_args(\%opts, @_) // return;
    _croak_bad_options %opts;
    my ($out, $err) = $any->_capture2(\%opts, $cmd) or return;
    $any->_check_child_error;
    if ($stream_encoding) {
        $any->_decode_data($stream_encoding => $out) or return;
        $any->_decode_data($stream_encoding => $err) or return;
    }
    wantarray ? ($out, $err) : $out
}

_sub_options system => qw(timeout stdin_data stdin_file stdin_fh
                          stdout_fh stdout_file stdout_discard
                          stderr_to_stdout stderr_fh stderr_file stderr_discard
                          _window_size);
sub system {
    my $any = shift;
    $any->_clear_error or return undef;
    my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
    my $stream_encoding = $any->_delete_stream_encoding_and_encode_input_data(\%opts) or return;
    my $cmd = $any->_quote_args(\%opts, @_) // return;
    _croak_bad_options %opts;
    $any->_system(\%opts, $cmd);
    $any->_check_child_error;
}

_sub_options dpipe => qw(stderr_to_stdout stderr_discard subsystem);
sub dpipe {
    my $any = shift;
    $any->_clear_error or return undef;
    my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
    my $cmd = $any->_quote_args(\%opts, @_) // return;
    _croak_bad_options %opts;
    $any->_dpipe(\%opts, $cmd);
}

_sub_options sftp => qw(fs_encoding timeout block_size queue_size autoflush write_delay
                        read_ahead late_set_perm autodie remote_sftp_server_cmd ssh1);
sub sftp {
    my ($any, %opts) = @_;

    $opts{timeout} //= $any->{timeout} if defined $any->{timeout};
    $opts{fs_encoding} //= $any->_delete_argument_encoding(\%opts);

    _croak_bad_options %opts;
    $any->_load_module('Net::SFTP::Foreign') or return;
    if (my $sftp = $any->_sftp(\%opts)) {
        if (my $error = $sftp->error) {
            $any->_set_error(SSHA_SFTP_ERROR, 'Unable to start SFTP connection', $sftp->error);
            return;
        }
        return $sftp;
    }
    else {
        $any->_or_set_error(SSHA_SFTP_ERROR, 'Unable to start SFTP connection', 'Unknown error');
    }
    ()
}

sub _helper_delegate {
    my $any = shift;
    my $class = shift;
    $any->_load_module($class) or return;
    my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
    my $obj = $class->_new($any, \%opts, @_) or return;
    $obj->run(\%opts);
}

sub _wait_ssh_proc {
    my ($any, $proc, $timeout, $force_kill) = @_;
    $force_kill //= $any->{_kill_ssh_on_timeout};
    if ($force_kill) {
        $timeout = $any->{_timeout} unless defined $timeout;
        $timeout = 0 if $any->error == SSHA_TIMEOUT_ERROR;
    }

    $any->_os_wait_proc($proc, $timeout, $force_kill);
}

sub scp_get         { shift->_helper_delegate('Net::SSH::Any::SCP::Getter::Standard', @_) }
sub scp_get_content { shift->_helper_delegate('Net::SSH::Any::SCP::Getter::Content',  @_) }
sub scp_mkdir       { shift->_helper_delegate('Net::SSH::Any::SCP::Putter::DirMaker', @_) }
sub scp_put         { shift->_helper_delegate('Net::SSH::Any::SCP::Putter::Standard', @_) }
sub scp_put_content { shift->_helper_delegate('Net::SSH::Any::SCP::Putter::Content',  @_) }

sub scp_find        {
    _warn("this feature is not finished yet");
    shift->_helper_delegate('Net::SSH::Any::SCP::Getter::Finder', @_)
}

sub autodetect {
    my $any = shift;
    my $auto = $any->_helper_delegate('Net::SSH::Any::Autodetector', @_) // return;
    wantarray ? %$auto : $auto;
}

1;

__END__