view release on metacpan or  search on metacpan

local/lib/perl5/Net/SFTP/Foreign/Backend/Unix.pm  view on Meta::CPAN

        $sftp->_conn_failed("Unable to created pipes: $!");
        return;
    }
    my $pid = fork;
    unless ($pid) {
        unless (defined $pid) {
            $sftp->_conn_failed("Unable to fork new process: $!");
            return;
        }
        close ($dad_in);
        close ($dad_out);

        shift; shift;
        my $child_err = shift;
        my $pty = shift;

        $pty->make_slave_controlling_terminal if defined $pty;

        my $child_err_fno = eval { no warnings; fileno($child_err  ? $child_err : *STDERR) };
        my $child_err_safe; # passed handler may be tied, so we
                            # duplicate it in order to get a plain OS
                            # handler.
        if (defined $child_err_fno and $child_err_fno >= 0) {
            open $child_err_safe, ">&=$child_err_fno" or POSIX::_exit(1);
        }
        else {
            open $child_err_safe, ">/dev/null" or POSIX::_exit(1);
        }

        my $child_in_fno       = _fileno_dup_over(0 => $child_in      );
        my $child_out_fno      = _fileno_dup_over(1 => $child_out     );
        my $child_err_safe_fno = _fileno_dup_over(2 => $child_err_safe);

        unless (($child_in_fno       == 0 or POSIX::dup2($child_in_fno,       0)) and
                ($child_out_fno      == 1 or POSIX::dup2($child_out_fno,      1)) and
                ($child_err_safe_fno == 2 or POSIX::dup2($child_err_safe_fno, 2))) {
            POSIX::_exit(1);
        }
        do { exec @_ };
        POSIX::_exit(1);
    }
    close $child_in;
    close $child_out;

    $_[0] = $dad_in;
    $_[1] = $dad_out;
    $pid;
}

sub _init_transport {
    my ($backend, $sftp, $opts) = @_;

    my $transport = delete $opts->{transport};

    if (defined $transport) {
	if (ref $transport eq 'ARRAY') {
            @{$sftp}{qw(ssh_in ssh_out pid)} = @$transport;
        }
        else {
            $sftp->{ssh_in} = $sftp->{ssh_out} = $transport;
            $sftp->{_ssh_out_is_not_dupped} = 1;
        }
    }
    else {
        my $user = delete $opts->{user};
        my $pass = delete $opts->{passphrase};
        my $ask_for_username_at_login;
	my $pass_is_passphrase;
        my $password_prompt;
        if (defined $pass) {
            $pass_is_passphrase = 1;
        }
        else {
            $pass = delete $opts->{password};
	    if (defined $pass) {
                $sftp->{_password_authentication} = 1;
                $password_prompt = $sftp->{_password_prompt} = delete $opts->{password_prompt};
                if (defined $password_prompt) {
                    unless (ref $password_prompt eq 'Regexp') {
                        $password_prompt = quotemeta $password_prompt;
                        $password_prompt = qr/$password_prompt\s*$/i;
                    }
                }
                $ask_for_username_at_login =
                    $sftp->{_ask_for_username_at_login} =
                        ( delete($opts->{ask_for_username_at_login}) ||
                          delete($opts->{asks_for_username_at_login}) );
                if ($ask_for_username_at_login) {
                    croak "ask_for_username_at_login set but user was not given" unless defined $user;
                    croak "ask_for_username_at_login can not be used with a custom password prompt"
                        if defined $password_prompt;
                }
            }
        }

        delete $opts->{expect_log_user}; # backward compatibility, not used anymore
	my $stderr_discard = delete $opts->{stderr_discard};
	my $stderr_fh = ($stderr_discard ? undef : delete $opts->{stderr_fh});
        my $open2_cmd = delete $opts->{open2_cmd};
        my $ssh_cmd_interface = delete $opts->{ssh_cmd_interface};

	my @open2_cmd;
        if (defined $open2_cmd) {
            @open2_cmd = _ensure_list($open2_cmd);
        }
        else {
            my $host = delete $opts->{host};
            defined $host or croak "sftp target host not defined";

            my $key_path = delete $opts->{key_path};

            my $ssh_cmd = delete $opts->{ssh_cmd};
            $ssh_cmd = 'ssh' unless defined $ssh_cmd;
            @open2_cmd = _ensure_list $ssh_cmd;

            unless (defined $ssh_cmd_interface) {
                $ssh_cmd_interface = ( "@open2_cmd" =~ /\bplink\b/i ? 'plink'  :
                                       "@open2_cmd" =~ /\bsshg3\b/i ? 'tectia' :
                                                                      'ssh'    );
            }