view release on metacpan or  search on metacpan

lib/Net/SSH/Any/OS/_Base.pm  view on Meta::CPAN

package Net::SSH::Any::OS::_Base;

use strict;
use warnings;

use Carp;
our @CARP_NOT = ('Net::SSH::Any::Backend::_Cmd');

use POSIX ();
use Net::SSH::Any::Util qw($debug _debug _array_or_scalar_to_list);
use Net::SSH::Any::Constants qw(:error);

sub loaded { 1 } # helper method to ensure the module has been correctly loaded

sub setenv {
    my ($any, $key, $value) = @_;
    # FIXME: this fails on threaded perls on Windows.
    $ENV{$key} = $value;
    1;
}

sub pty {
    my $any = shift;
    $any->_load_module('IO::Pty') or return;
    IO::Pty->new;
}

sub export_handler {
    my ($any, $file) = @_;
    my $fn = fileno $file;
    return $fn if $fn >= 0;
    ()
}

sub set_file_inherit_flag { 1 }

sub has_working_socketpair { }

sub io3_check_and_clean_data {
    my ($any, $in, $data) = @_;
    my @data = grep { defined and length } _array_or_scalar_to_list $data;
    if (@data and not $in) {
        croak "remote input channel is not defined but data is available for sending"
    }
    \@data
}

sub current_user {
    my $any = shift;
    local ($SIG{__DIE__}, $@);
    eval { (getpwuid $<)[0] } // eval { getlogin() }
}

sub interactive_login {
    my ($any, $pty, $proc) = @_;
    my $opts = $any->{be_opts}; # FIXME. This shouldn't be here!
    my $user = $opts->{user};
    my $password = $opts->{password};
    my $password_prompt = $opts->{password_prompt};
    my $asks_username_at_login = $opts->{asks_username_at_login};

    if (defined $password_prompt) {
        unless (ref $password_prompt eq 'Regexp') {
            $password_prompt = quotemeta $password_prompt;
            $password_prompt = qr/$password_prompt\s*$/i;
        }
    }

    if ($asks_username_at_login) {
         croak "ask_username_at_login set but user was not given" unless defined $user;
         croak "ask_username_at_login set can not be used with a custom password prompt"
             if defined $password_prompt;
    }

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