view release on metacpan or  search on metacpan

lib/Net/SSH/Perl/Auth/RSA.pm  view on Meta::CPAN

        $ssh->debug("Trying RSA authentication via agent with '$comment'");
        $ssh->debug("Server refused our key."), next unless
            my $packet = $auth->_server_likes_key($key);

        my $challenge = $packet->get_mp_int;
        $ssh->debug("Received RSA challenge from server.");
        my $response;
        unless ($response = $agent->decrypt($key, $challenge, $ssh->session_id)) {
            $ssh->debug("Authentication agent failed to decrypt challenge.");
            $response = "\0" x 16;
        }
        $ssh->debug("Sending response to RSA challenge.");
        $packet = $ssh->packet_start(SSH_CMSG_AUTH_RSA_RESPONSE);
        $packet->put_chars($response);
        $packet->send;

        $packet = Net::SSH::Perl::Packet->read($ssh);
        if ($packet->type == SSH_SMSG_SUCCESS) {
            $agent->close_socket;
            $ssh->debug("RSA authentication accepted by server.");
            return 1;
        }
        elsif ($packet->type != SSH_SMSG_FAILURE) {
            $ssh->fatal_disconnect("Protocol error waiting RSA auth response");
        }
    }
    $agent->close_socket;
    $ssh->debug("RSA authentication using agent refused.");

    return 0;
}

sub _server_likes_key {
    my $auth = shift;
    my($key) = @_;
    my $ssh = $auth->{ssh};

    my $packet = $ssh->packet_start(SSH_CMSG_AUTH_RSA);
    $packet->put_mp_int($key->{rsa}{n});
    $packet->send;

    $packet = Net::SSH::Perl::Packet->read($ssh);
    my $type = $packet->type;
    if ($type == SSH_SMSG_FAILURE) {
        $ssh->debug("Server refused our key.");
        return 0;
    }

    if ($type != SSH_SMSG_AUTH_RSA_CHALLENGE) {
        $ssh->fatal_disconnect("Protocol error during RSA authentication: $type");
    }

    $packet;
}

sub _authenticate {
    my($auth, $auth_file) = @_;
    my $ssh = $auth->{ssh};
    my($packet);

    my($public_key, $comment, $private_key);
    eval {
        ($public_key, $comment) = _load_public_key($auth_file);
    };
    $ssh->debug("RSA authentication failed: Can't load public key."),
        return 0 if $@;

    $ssh->debug("Trying RSA authentication with key '$comment'");

    $ssh->debug("Server refused our key."), return unless
        $packet = $auth->_server_likes_key($public_key);

    my $challenge = $packet->get_mp_int;
    $ssh->debug("Received RSA challenge from server.");

    eval {
        $private_key = _load_private_key($auth_file, "");
    };
    if (!$private_key || $@) {
        my $passphrase = "";
        if ($ssh->config->get('interactive')) {
            $passphrase = _read_passphrase("Enter passphrase for RSA key '$comment': ");
        }
        else {
            $ssh->debug("Will not query passphrase for '$comment' in batch mode.");
        }

        eval {
            $private_key = _load_private_key($auth_file, $passphrase);
        };
        if (!$private_key || $@) {
            $ssh->debug("Loading private key failed: $@.");
            $packet = $ssh->packet_start(SSH_CMSG_AUTH_RSA_RESPONSE);
            $packet->put_char(0) for (1..16);
            $packet->send;

            Net::SSH::Perl::Packet->read_expect($ssh, SSH_SMSG_FAILURE);
            return 0;
        }
    }

    _respond_to_rsa_challenge($ssh, $challenge, $private_key);

    $packet = Net::SSH::Perl::Packet->read($ssh);
    my $type = $packet->type;
    if ($type == SSH_SMSG_SUCCESS) {
        $ssh->debug("RSA authentication accepted by server.");
        return 1;
    }
    elsif ($type != SSH_SMSG_FAILURE) {
        $ssh->fatal_disconnect("Protocol error waiting RSA auth response: $type");
    }

    $ssh->debug("RSA authentication refused.");
    return 0;
}

1;
__END__

=head1 NAME

Net::SSH::Perl::Auth::RSA - Perform RSA authentication

=head1 SYNOPSIS

    use Net::SSH::Perl::Auth;
    my $auth = Net::SSH::Perl::Auth->new('RSA', $ssh);
    print "Valid auth" if $auth->authenticate;

=head1 DESCRIPTION

I<Net::SSH::Perl::Auth::RSA> performs RSA authentication with
a remote sshd server. When you create a new RSA auth object,
you give it an I<$ssh> object, which should contain an open
connection to an ssh daemon, as well as any data that the
authentication module needs to proceed. In this case, for
example, the I<$ssh> object might contain a list of RSA
identity files (see the docs for I<Net::SSH::Perl>).

The I<authenticate> method first tries to establish a connection
to an authentication agent. If the connection attempt is successful,
the client loops through the identities returned from the agent,
and tries each identity/key against the server. The client enters
into a dialog with the server. The client sends the public portion
of the key returned from the agent. The server responds, telling the
client whether the key is authorized for authentication; if the
key is authorized, the server sends an RSA challenge encrypted with
the user's public key. The client then asks the agent to decrypt the
challenge using the private portion of the key, and sends back its
response. If the response is correct, the client is authenticated
successfully.

If the client cannot connect to the authentication agent, or if none
of the identities returned from the agent successfully authenticate
the user, I<authenticate> then loops through each of the files listed
as identity files (see the I<Net::SSH::Perl> constructor). If no
identity files are explicitly listed, F<$ENV{HOME}/.ssh/identity>
is used as a default. For each identity, the client enters into
a dialog with the sshd server.

The client sends the public key to the server, then waits for