view release on metacpan or  search on metacpan

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

        }
        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'    );
            }

            my $port = delete $opts->{port};
	    my $ssh1 = delete $opts->{ssh1};

            my $more = delete $opts->{more};
            defined $more and !ref($more) and $more =~ /^-\w\s+\S/ and
                warnings::warnif("Net::SFTP::Foreign", "'more' argument looks like it should be split first");
            my @more = _ensure_list $more;

            my @preferred_authentications;
            if (defined $key_path) {
                push @preferred_authentications, 'publickey';
                push @open2_cmd, map { -i => $_ } _ensure_list $key_path;
            }

            if ($ssh_cmd_interface eq 'plink') {
                push @open2_cmd, -P => $port if defined $port;
                if (defined $pass and !$pass_is_passphrase) {
                    warnings::warnif("Net::SFTP::Foreign", "using insecure password authentication with plink");
                    push @open2_cmd, -pw => $pass;
                    undef $pass;
                }

            }
            elsif ($ssh_cmd_interface eq 'ssh') {
                push @open2_cmd, -p => $port if defined $port;
		if (defined $pass and !$pass_is_passphrase) {
		    push @open2_cmd, -o => 'NumberOfPasswordPrompts=1';
                    push @preferred_authentications, ('keyboard-interactive', 'password');
		}
                if (@preferred_authentications

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

	    my $child;
            my $pty = IO::Pty->new;

            $redirect_stderr_to_tty and $stderr_fh = $pty->slave;

            $child = $backend->_open4($sftp, $sftp->{ssh_in}, $sftp->{ssh_out}, $stderr_fh, $pty, @open2_cmd);
            unless (defined $child) {
                $sftp->_conn_failed("Bad ssh command", $!);
                return;
            }
            $sftp->{pid} = $child;
            open my $pty_dup, '+>&', $pty; # store pty as a file handler instead of a object in
                                           # order to save it from being destroyed too early
                                           # during global destruction
            $sftp->{_pty} = $pty_dup;

            $debug and $debug & 65536 and _debug "starting password authentication";
            my $rv = '';
            vec($rv, fileno($pty), 1) = 1;
            my $buffer = '';
            my $at = 0;
            my $password_sent;
            my $start_time = time;
            while(1) {
                if (defined $sftp->{_timeout}) {
                    $debug and $debug & 65536 and _debug "checking timeout, max: $sftp->{_timeout}, ellapsed: " . (time - $start_time);
                    if (time - $start_time > $sftp->{_timeout}) {
                        $sftp->_conn_failed("login procedure timed out");
                        return;
                    }
                }

                if (waitpid($child, POSIX::WNOHANG()) > 0 or $! == Errno::ECHILD()) {
                    undef $sftp->{pid};
                    my $err = $? >> 8;
                    $sftp->_conn_failed("SSH slave exited unexpectedly with error code $err");
                    return;
                }

                $debug and $debug & 65536 and _debug "waiting for data from the pty to become available";

                my $rv1 = $rv;
                select($rv1, undef, undef, 1) > 0 or next;
                if (my $bytes = sysread($pty, $buffer, 4096, length $buffer)) {
                    if ($debug and $debug & 65536) {
                        _debug "$bytes bytes readed from pty:";
                        _hexdump substr($buffer, -$bytes);
                    }
                    if ($buffer =~ /^The authenticity of host/mi or
                        $buffer =~ /^Warning: the \S+ host key for/mi) {
                        $sftp->_conn_failed("the authenticity of the target host can't be established, " .
                                            "the remote host public key is probably not present on the " .
                                            "'~/.ssh/known_hosts' file");
                        return;
                    }
                    if ($password_sent) {
                        $debug and $debug & 65536 and _debug "looking for password ok";
                        last if substr($buffer, $at) =~ /\n$/;
                    }
                    else {
                        $debug and $debug & 65536 and _debug "looking for user/password prompt";
                        my $re = ( defined $password_prompt
                                   ? $password_prompt
                                   : qr/(user|name|login)?[:?]\s*$/i );

                        $debug and $debug & 65536 and _debug "matching against $re";

                        if (substr($buffer, $at) =~ $re) {
                            if ($ask_for_username_at_login and
                                ($ask_for_username_at_login ne 'auto' or defined $1)) {
                                $debug and $debug & 65536 and _debug "sending username";
                                print $pty "$user\n";
                                undef $ask_for_username_at_login;
                            }
                            else {
                                $debug and $debug & 65536 and _debug "sending password";
                                print $pty "$pass\n";
                                $password_sent = 1;
                            }
                            $at = length $buffer;
                        }
                    }
                }
                else {
                    $debug and $debug & 65536 and _debug "no data available from pty, delaying until next read";
                    sleep 0.1;
                }

            }
            $debug and $debug & 65536 and _debug "password authentication done";
	    $pty->close_slave();
        }
        else {
	    $sftp->{pid} = $backend->_open4($sftp, $sftp->{ssh_in}, $sftp->{ssh_out}, $stderr_fh, undef, @open2_cmd);
            unless (defined $sftp->{pid}) {
                $sftp->_conn_failed("Bad ssh command", $!);
                return;
            }
        }
    }
    $backend->_init_transport_streams($sftp);
}

sub _after_init {
    my ($backend, $sftp) = @_;
    if ($sftp->{pid} and not $sftp->error) {
        # do not propagate signals sent from the terminal to the
        # slave SSH:
        local ($@, $!);
        eval { setpgrp($sftp->{pid}, 0) };
    }
}

sub _do_io {
    my (undef, $sftp, $timeout) = @_;

    $debug and $debug & 32 and _debug(sprintf "_do_io connected: %s", $sftp->{_connected} || 0);

    return undef unless $sftp->{_connected};

    my $fnoout = fileno $sftp->{ssh_out};
    my $fnoin = fileno $sftp->{ssh_in};
    my ($rv, $wv) = ('', '');