view release on metacpan or  search on metacpan

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

# $Id: SSH2.pm,v 1.47 2009/01/26 01:50:38 turnstep Exp $
package AnyEvent::SSH2;
use strict;
use AE;
use AnyEvent::Handle;
use Net::SSH::Perl::Kex;
use Net::SSH::Perl::ChannelMgr;
use Net::SSH::Perl::Packet;
use Net::SSH::Perl::Buffer;
use Net::SSH::Perl::Constants qw( :protocol :msg2 :compat :hosts :channels :proposal :kex
                                  CHAN_INPUT_CLOSED CHAN_INPUT_WAIT_DRAIN );
use Net::SSH::Perl::Cipher;
use Net::SSH::Perl::AuthMgr;
use Net::SSH::Perl::Comp;
use Net::SSH::Perl::Util qw(:hosts);
use Scalar::Util qw(blessed weaken);
use Carp qw( croak );

use base qw( Net::SSH::Perl );
our $VERSION = '0.04';

use Errno qw( EAGAIN EWOULDBLOCK );
use vars qw( $VERSION $CONFIG $HOSTNAME @PROPOSAL );
use vars qw( @PROPOSAL );
@PROPOSAL = ( 
        KEX_DEFAULT_KEX,
        KEX_DEFAULT_PK_ALG,
        KEX_DEFAULT_ENCRYPT,
        KEX_DEFAULT_ENCRYPT,
        KEX_DEFAULT_MAC,
        KEX_DEFAULT_MAC,
        KEX_DEFAULT_COMP,
        KEX_DEFAULT_COMP,
        KEX_DEFAULT_LANG,
        KEX_DEFAULT_LANG,
        );

$CONFIG = {};

BEGIN {
    use Net::SSH::Perl::Packet;
    no warnings qw(redefine);
    *Net::SSH::Perl::Packet::send_ssh2 = sub  {
        my $pack = shift;
        my $buffer = shift || $pack->{data};
        my $ssh = $pack->{ssh};

        my $kex = $ssh->kex;
        my($ciph, $mac, $comp);
        if ($kex) {
            $ciph = $kex->send_cipher;
            $mac  = $kex->send_mac;
            $comp = $kex->send_comp;
        }
        my $block_size = 8;

        if ($comp && $comp->enabled) {
            my $compressed = $comp->compress($buffer->bytes);
            $buffer->empty;
            $buffer->append($compressed);
        }

        my $len = $buffer->length + 4 + 1;
        my $padlen = $block_size - ($len % $block_size);
        $padlen += $block_size if $padlen < 4;
        my $junk = $ciph ? (join '', map chr rand 255, 1..$padlen) : ("\0" x $padlen);
        $buffer->append($junk);

        my $packet_len = $buffer->length + 1;
        $buffer->bytes(0, 0, pack("N", $packet_len) . pack("c", $padlen));

        my($macbuf);
        if ($mac && $mac->enabled) {
            $macbuf = $mac->hmac(pack("N", $ssh->{session}{seqnr_out}) . $buffer->bytes);
        }
        my $output = Net::SSH::Perl::Buffer->new( MP => 'SSH2' );

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

    *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" } );
            $amgr->run( \$amgr->{_done}, sub{
                my ($amgr) = shift;
                $amgr->{agent}->close_socket if $amgr->{agent};
    
                $cb->($ssh, $amgr, $valid);
            } );
    
        });
    };

    *Net::SSH::Perl::AuthMgr::init = sub {
        package Net::SSH::Perl::AuthMgr;
        my $amgr = shift;
        my $cb   = shift;
        my $ssh = $amgr->{ssh};