view release on metacpan or  search on metacpan

lib/Net/SSH2.pm  view on Meta::CPAN

        },
        'hostbased'     => {
            ssh    => 'hostbased',
            method => \&auth_hostbased,
            params => [qw(username publickey privatekey
                       hostname local_username? passphrase?)],
        },
        'publickey'     => {
            ssh    => 'publickey',
            method => \&auth_publickey,
            params => [qw(username publickey? privatekey passphrase?)],
        },
        'keyboard'      => {
            ssh    => 'keyboard-interactive',
            method => \&auth_keyboard,
            params => [qw(_interact _fallback username cb_keyboard?)]
        },
        'keyboard-auto' => {
            ssh    => 'keyboard-interactive',
            method => \&auth_keyboard,
            params => [qw(username password)],
        },
        'password'      => {
            ssh    => 'password',
            method => \&auth_password,
            params => [qw(username password cb_password?)],
        },
        'password-interact'  => {
             ssh    => 'password',
             method => \&auth_password_interact,
             params => [qw(_interact _fallback username cb_password?)],
        },
        'none'          => {
            ssh    => 'none',
            method => \&auth_password,
            params => [qw(username)],
        },
    };
}

my @rank_default = qw(hostbased publickey keyboard-auto password agent keyboard password-interact none);

sub _auth_rank {
    my ($self, $rank) = @_;
    $rank ||= \@rank_default;
    my $libver = ($self->version)[1] || 0;
    return @$rank if $libver > 0x010203;
    return grep { $_ ne 'agent' } @$rank;
}

sub _local_user {
    for (qw(USER LOGNAME)) {
        return $ENV{$_} if defined $ENV{$_}
    }

    local ($@, $SIG{__DIE__}, $SIG{__WARN__});

    my $u = eval { getlogin };
    return $u if defined $u;

    eval { getpwuid $< }
}

my $password_when_you_mean_passphrase_warned;
sub auth {
    my ($self, %p) = @_;

    $self->_set_error(LIBSSH2_ERROR_AUTHENTICATION_FAILED(),
                      "Authentication failed"); # default error

    $p{username} = _local_user unless defined $p{username};

    my @rank = $self->_auth_rank(delete $p{rank});
    my $remote_rank;
    $remote_rank = { map { $_ => 1 } $self->auth_list($p{username}) }
        if defined $p{username};

    # if fallback is set, interact with the user even when a password
    # is given
    $p{fallback} = 1 unless defined $p{password} or defined $p{passphrase};

    TYPE: for my $type (@rank) {
        my $data = $self->_auth_methods->{$type};
        unless ($data) {
            carp "unknown authentication method '$type'";
            next;
        }
        next if $remote_rank and !$remote_rank->{$data->{ssh}};

        # do we have the required parameters?
        my @pass;
        for my $param(@{$data->{params}}) {
            my $p = $param;
            my $opt = $p =~ s/\?$//;
            my $pseudo = $p =~ s/^_//;

            if ($p eq 'passphrase' and not exists $p{$p} and defined $p{password}) {
                $p = 'password';
                $password_when_you_mean_passphrase_warned++
                    or carp "Using the key 'password' to refer to a passphrase is deprecated. Use 'passphrase' instead";
            }

            if ($pseudo) {
                next TYPE unless $p{$p};
            }
            else {
                next TYPE unless $opt or defined $p{$p};
                push @pass, $p{$p};  # if it's optional, store undef
            }
        }

        # invoke the authentication method
        return $type if $data->{method}->($self, @pass) and $self->auth_ok;
    }

    return 'none' if  $self->auth_ok;

    $self->_set_error(LIBSSH2_ERROR_AUTHENTICATION_FAILED(),
                     "All authentication methods failed");
    return;  # failure
}

lib/Net/SSH2.pm  view on Meta::CPAN

my $term_readkey_unavailable_warned;
my $term_readkey_loaded;
sub _load_term_readkey {
    return 1 if $term_readkey_loaded ||= do {
        local ($@, $!, $SIG{__DIE__}, $SIG{__WARN__});
        eval { require Term::ReadKey; 1 }
    };

    carp "Unable to load Term::ReadKey, will not ask for passwords at the console!"
        unless $term_readkey_unavailable_warned++;
    return;
}

sub _print_stderr {
    my $self = shift;
    my $ofh = select STDERR; local $|= 1; select $ofh;
    print STDERR $_ for @_;
}

sub _ask_user {
    my ($self, $prompt, $echo) = @_;
    my $timeout;
    if (($self->version)[1] >= 0x10209) {
        $timeout = $self->timeout || 0;
        $timeout = ($timeout + 999) / 1000;
    }
    _load_term_readkey or return;
    $self->_print_stderr($prompt);
    Term::ReadKey::ReadMode('noecho') unless $echo;
    my $reply = Term::ReadKey::ReadLine($timeout);
    Term::ReadKey::ReadMode('normal') unless $echo;
    $self->_print_stderr("\n")
        unless $echo and defined $reply;
    if (defined $reply) {
        chomp $reply
    }
    else {
        $self->_set_error(LIBSSH2_ERROR_SOCKET_TIMEOUT(),
                          "Timeout waiting for user response!");
    }
    return $reply;
}

sub auth_password_interact {
    my ($self, $username, $cb) = @_;
    _load_term_readkey or return;
    my $rc;
    for (0..2) {
        my $password = $self->_ask_user("${username}'s password? ", 0);
        $rc = $self->auth_password($username, $password, $cb);
        last if $rc or $self->error != LIBSSH2_ERROR_AUTHENTICATION_FAILED();
        my $ofh = select STDERR; local $|= 1; select $ofh;
        $self->_print_stderr("Password authentication failed!\n");
    }
    return $rc;
}

sub _local_home {
    return $ENV{HOME} if defined $ENV{HOME};
    local ($@, $SIG{__DIE__}, $SIG{__WARN__});
    my $home = eval { (getpwuid($<))[7] };
    return $home;
}

my $check_hostkey_void_ctx_warned;
sub check_hostkey {
    my ($self, $policy, $path, $comment) = @_;

    defined wantarray or $check_hostkey_void_ctx_warned++ or
        warnings::warnif($self, "Calling check_hostkey in void context is useless");

    my $cb;
    if (not defined $policy) {
        $policy = LIBSSH2_HOSTKEY_POLICY_STRICT();
    }
    elsif (ref $policy eq 'CODE') {
        $cb = $policy;
    }
    else {
        $policy =  _parse_constant(HOSTKEY_POLICY => $policy);
    }

    my $hostname = $self->hostname;
    croak("hostname unknown: in order to use check_hostkey the peer host name ".
          "must be given (or discoverable) at connect time")
        unless defined $hostname;

    unless (defined $path) {
        my $home = _local_home;
        unless (defined $home) {
            $self->_set_error(LIBSSH2_ERROR_FILE(), "Unable to determine known_hosts location");
            return;
        }
        require File::Spec;
        $path = File::Spec->catfile($home, '.ssh', 'known_hosts');
    }

    my ($check, $key, $type, $flags);
    my $kh = $self->known_hosts;
    if ($kh and defined $kh->readfile($path)) {

        ($key, $type) = $self->remote_hostkey;
        $flags = ( LIBSSH2_KNOWNHOST_TYPE_PLAIN() |
                   LIBSSH2_KNOWNHOST_KEYENC_RAW() |
                   (($type + 1) << LIBSSH2_KNOWNHOST_KEY_SHIFT()) );

        $check = $kh->check($hostname, $self->port, $key, $flags);
        $check == LIBSSH2_KNOWNHOST_CHECK_MATCH() and return "00";
    }
    else {
        $check = LIBSSH2_KNOWNHOST_CHECK_FAILURE();
    }

    if ($cb) {
        my $ok = $cb->($self, $check, $comment);
        $ok or $self->_set_error(LIBSSH2_ERROR_KNOWN_HOSTS(), 'Host key verification failed');
        return $ok;
    }

    return $check
        if $policy == LIBSSH2_HOSTKEY_POLICY_ADVISORY(); # user doesn't care!