view release on metacpan or  search on metacpan

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

    
                    $ssh->debug("Enabling encryption/MAC/compression.");
                    $ssh->{kex} = $kex;
                    for my $att (qw( mac ciph comp )) {
                        $kex->{$att}[0]->enable if $kex->{$att}[0];
                        $kex->{$att}[1]->enable if $kex->{$att}[1];
                    }
                    $cb->($ssh);
                });
            });
    
        });
    };
    use Net::SSH::Perl::Kex::DH1;
    no strict "subs";
    *Net::SSH::Perl::Kex::DH1::exchange = sub {
        package Net::SSH::Perl::Kex::DH1;
        my $kex = shift;
        my $ssh = $kex->{ssh};
        my $packet;
        my $dh = _dh_new_group1;
        my $cb = shift;

        $ssh->debug("Entering Diffie-Hellman Group 1 key exchange.");
        $packet = $ssh->packet_start(SSH2_MSG_KEXDH_INIT);
        $packet->put_mp_int($dh->pub_key);
        $packet->send;

        $ssh->debug("Sent DH public key, waiting for reply.");
        Net::SSH::Perl::Packet->read_expect($ssh,
            SSH2_MSG_KEXDH_REPLY, sub {
            my ($ssh, $packet) = @_;
            my $host_key_blob = $packet->get_str;
            my $s_host_key = Net::SSH::Perl::Key->new_from_blob($host_key_blob,
                \$ssh->{datafellows});
            $ssh->debug("Received host key, type '" . $s_host_key->ssh_name . "'.");

            $ssh->check_host_key($s_host_key);

            my $dh_server_pub = $packet->get_mp_int;
            my $signature = $packet->get_str;

            $ssh->fatal_disconnect("Bad server public DH value")
                unless _pub_is_valid($dh, $dh_server_pub);

            $ssh->debug("Computing shared secret key.");
            my $shared_secret = $dh->compute_key($dh_server_pub);

            my $hash = $kex->kex_hash(
                $ssh->client_version_string,
                $ssh->server_version_string,
                $kex->client_kexinit,
                $kex->server_kexinit,
                $host_key_blob,
                $dh->pub_key,
                $dh_server_pub,
                $shared_secret);

            $ssh->debug("Verifying server signature.");
            croak "Key verification failed for server host key"
                unless $s_host_key->verify($signature, $hash);

            $ssh->session_id($hash);

            $kex->derive_keys($hash, $shared_secret, $ssh->session_id);
            $cb->($ssh);
        });
    };
    use Net::SSH::Perl::AuthMgr;
    no warnings qw(redefine);
    #no strict "refs";
    *Net::SSH::Perl::AuthMgr::new = sub {
        my $class = shift;
        my $ssh = shift;
        my $amgr = bless { ssh => $ssh }, $class;
        weaken $amgr->{ssh};
        $amgr;
    };
    *Net::SSH::Perl::AuthMgr::run = sub {
        my $amgr = shift;
        my $cb = pop @_;
        my($end, @args) = @_;
        Net::SSH::Perl::Packet->read($amgr->{ssh}, sub{
            my ($ssh, $packet) = @_;
            my $code = $amgr->handler_for($packet->type);
            unless (defined $code) {
                $code = $amgr->error_handler ||
                    sub { croak "Protocol error: received type ", $packet->type };
            }
            $code->($amgr, $packet, @args);
            if ($$end) {
                $cb->($amgr);
                return;
            }
            $amgr->run($end, $cb);
        });
    };
    *Net::SSH::Perl::AuthMgr::authenticate = sub {
        package Net::SSH::Perl::AuthMgr;
        my $amgr = shift;
        my $cb   = shift;
        $amgr->init(sub{
            my ($ssh, $amgr) = @_;
            my($packet);
    
            my $valid = 0;
            $amgr->{_done} = 0;
            $amgr->register_handler(SSH2_MSG_USERAUTH_SUCCESS, sub {
                $valid++;
                $amgr->{_done}++
            });
            $amgr->register_handler(SSH2_MSG_USERAUTH_BANNER, sub {
                my $amgr = shift;
                my($packet) = @_;
                if ($amgr->{ssh}->config->get('interactive')) {
                    print $packet->get_str, "\n";
                }
            });
            $amgr->register_handler(SSH2_MSG_USERAUTH_FAILURE, \&auth_failure);
            $amgr->register_error(
                sub { croak "userauth error: bad message during auth" } );