view release on metacpan or  search on metacpan

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

            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
                    and not grep { $more[$_] eq '-o' and
                                       $more[$_ + 1] =~ /^PreferredAuthentications\W/ } 0..$#more-1) {
                    push @open2_cmd, -o => 'PreferredAuthentications=' . join(',', @preferred_authentications);
                }
            }
            elsif ($ssh_cmd_interface eq 'tectia') {
            }
            else {
                die "Unsupported ssh_cmd_interface '$ssh_cmd_interface'";
            }

            push @open2_cmd, -l => $user if defined $user;
            push @open2_cmd, @more;
            push @open2_cmd, $host;
	    push @open2_cmd, ($ssh1 ? "/usr/lib/sftp-server" : -s => 'sftp');
        }

        my $redirect_stderr_to_tty = ( defined $pass and
                                       ( delete $opts->{redirect_stderr_to_tty} or $ssh_cmd_interface eq 'tectia' ) );

        $redirect_stderr_to_tty and ($stderr_discard or $stderr_fh)
            and croak "stderr_discard or stderr_fh can not be used together with password/passphrase "
                          . "authentication when Tectia client is used";

	$debug and $debug & 1 and _debug "ssh cmd: @open2_cmd\n";

	%$opts and return; # Net::SFTP::Foreign will find the
                           # unhandled options and croak

	if (${^TAINT} and Scalar::Util::tainted($ENV{PATH})) {
            _tcroak('Insecure $ENV{PATH}')
        }

	if ($stderr_discard) {
	    $stderr_fh = $backend->_open_dev_null($sftp) or return;
	}

        if (defined $pass) {
            # user has requested to use a password or a passphrase for
            # authentication we use IO::Pty to handle that

            eval { require IO::Pty; 1 }
                or croak "password authentication not available, IO::Pty is not installed or failed to load: $@";

            local ($ENV{SSH_ASKPASS}, $ENV{SSH_AUTH_SOCK}) if $pass_is_passphrase;

            my $name = $pass_is_passphrase ? 'Passphrase' : 'Password';

	    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;