view release on metacpan or  search on metacpan

lib/Net/SFTP/Foreign/Backend/Net_SSH2.pm  view on Meta::CPAN

sub _make_error_string {
    my ($self, $msg) = @_;
    my ($err_code, $err_name, $err_str) = $self->{_ssh2}->error;
    if ($err_code) {
	return sprintf("%s: %s (%d): %s", $msg, $err_name, $err_code, $err_str)
    }
    else {
	return $msg
    }
}

sub _conn_failed {
    my ($self, $sftp, $msg) = @_;
    $sftp->_conn_failed($self->_make_error_string($msg))
}

sub _conn_lost {
    my ($self, $sftp, $msg) = @_;
    $sftp->_conn_lost(undef, undef, $self->_make_error_string($msg))
}

my %auth_arg_map = qw(host hostname
		      user username
                      passphrase password
		      local_user local_username
                      key_path privatekey);

sub _init_transport {
    my ($self, $sftp, $opts) = @_;
    my $ssh2 = delete $opts->{ssh2};
    if (defined $ssh2) {
        $self->{_ssh2} = $ssh2;
        $debug and $debug & 131072 and $ssh2->debug(1);
	unless ($ssh2->auth_ok) {
	    $sftp->_conn_failed("Net::SSH2 object is not authenticated");
	    return;
	}
    }
    else {
	my %auth_args;
	for (qw(rank username passphrase password publickey privatekey
		hostname key_path local_user local_username interact
		cb_keyboard cb_password user host)) {
	    my $map = $auth_arg_map{$_} || $_;
            next if defined $auth_args{$map};
	    $auth_args{$map} = delete $opts->{$_} if exists $opts->{$_}
	}

        if (defined $auth_args{privatekey} and not defined $auth_args{publickey}) {
            $auth_args{publickey} = "$auth_args{privatekey}.pub";
        }

	my $host = $auth_args{hostname};
	defined $host or croak "sftp target host not defined";
	my $port = delete $opts->{port} || 22;
	%$opts and return;

        unless (defined $auth_args{username}) {
            local $SIG{__DIE__};
            $auth_args{username} = eval { scalar getpwuid $< };
            defined $auth_args{username} or croak "required option 'user' missing";
        }

	$ssh2 = $self->{_ssh2} = Net::SSH2->new();
        $debug and $debug & 131072 and $ssh2->debug(1);

	unless ($ssh2->connect($host, $port)) {
	    $self->_conn_failed($sftp, "Connection to remote host $host failed");
	    return;
	}

	unless ($ssh2->auth(%auth_args)) {
	    $self->_conn_failed($sftp, "Authentication failed");
	    return;
	}
    }

    my $channel = $self->{_channel} = $ssh2->channel;
    unless (defined $channel) {
	$self->_conn_failed($sftp, "Unable to create new session channel");
	return;
    }
    $channel->ext_data('ignore');
    $channel->subsystem('sftp');
}

sub _sysreadn {
    my ($self, $sftp, $n) = @_;
    my $channel = $self->{_channel};
    my $bin = \$sftp->{_bin};
    while (1) {
	my $len = length $$bin;
	return 1 if $len >= $n;
	my $buf = '';
	my $read = $channel->read($buf, $n - $len);
	unless (defined $read) {
            $debug and $debug & 32 and _debug("read failed: " . $self->{_ssh2}->error . ", n: $n, len: $len");
            if ($self->{_ssh2}->error == $eagain_error) {
                $debug and $debug & 32 and _debug "read error: EAGAIN, delaying before retrying";
                sleep 0.01;
                redo;
            }
	    $self->_conn_lost($sftp, "Read failed");
	    return undef;
	}
        $sftp->{_read_total} += $read;
        if ($debug and $debug & 32) {
            _debug "$read bytes read from SSH channel, total $sftp->{_read_total}";
            $debug & 2048 and $read and _hexdump($buf);
        }
	$$bin .= $buf;
    }
    return $n;
}

sub _do_io {
    my ($self, $sftp, $timeout) = @_;
    my $channel = $self->{_channel};
    return undef unless $sftp->{_connected};