view release on metacpan or  search on metacpan

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

    $dup;
}

sub version_string {
    my $class = shift;
    sprintf "Net::SSH::Perl Version %s, protocol version %s.%s.",
        $class->VERSION, PROTOCOL_MAJOR_2, PROTOCOL_MINOR_2;
}

sub _exchange_identification {
    my $ssh = shift;
    my $remote_id = $ssh->_read_version(@_); 
    ($ssh->{server_version_string} = $remote_id) =~ s/\cM?$//;
    my($remote_major, $remote_minor, $remote_version) = $remote_id =~
        /^SSH-(\d+)\.(\d+)-([^\n]+)$/;
    $ssh->debug("Remote protocol version $remote_major.$remote_minor, remote software version $remote_version");

    my $proto = $ssh->config->get('protocol');
    my($mismatch, $set_proto);
    if ($remote_major == 1) {
        if ($remote_minor == 99 && $proto & PROTOCOL_SSH2 &&
            !($proto & PROTOCOL_SSH1_PREFERRED)) {
            $set_proto = PROTOCOL_SSH2;
        }
        elsif (!($proto & PROTOCOL_SSH1)) {
            $mismatch = 1;
        }
        else {
            $set_proto = PROTOCOL_SSH1;
        }
    }
    elsif ($remote_major == 2) {
        if ($proto & PROTOCOL_SSH2) {
            $set_proto = PROTOCOL_SSH2;
        }
    }
    if ($mismatch) {
        croak sprintf "Protocol major versions differ: %d vs. %d",
            ($proto & PROTOCOL_SSH2) ? PROTOCOL_MAJOR_2 :
            PROTOCOL_MAJOR_1, $remote_major;
    }
    my $compat20 = $set_proto == PROTOCOL_SSH2;
    my $buf = sprintf "SSH-%d.%d-%s\n",
        $compat20 ? PROTOCOL_MAJOR_2 : PROTOCOL_MAJOR_1,
        $compat20 ? PROTOCOL_MINOR_2 : PROTOCOL_MINOR_1,
        $VERSION;
    $ssh->{client_version_string} = substr $buf, 0, -1;
    my $handle = $ssh->{session}{sock};
    $handle->push_write($buf);
    $ssh->set_protocol($set_proto);
    $ssh->_compat_init($remote_version);
}

sub _proto_init {
    my $ssh = shift;
    my $home = $ENV{HOME} || (getpwuid($>))[7];
    unless ($ssh->{config}->get('user_known_hosts')) {
        defined $home or croak "Cannot determine home directory, please set the environment variable HOME";
        $ssh->{config}->set('user_known_hosts', "$home/.ssh/known_hosts2");
    }
    unless ($ssh->{config}->get('global_known_hosts')) {
        $ssh->{config}->set('global_known_hosts', "/etc/ssh_known_hosts2");
    }
    unless (my $if = $ssh->{config}->get('identity_files')) {
        defined $home or croak "Cannot determine home directory, please set the environment variable HOME";
        $ssh->{config}->set('identity_files', [ "$home/.ssh/id_dsa" ]);
    }

    for my $a (qw( password dsa kbd_interactive )) {
        $ssh->{config}->set("auth_$a", 1)
            unless defined $ssh->{config}->get("auth_$a");
    }
}

sub kex { $_[0]->{kex} }

sub register_handler {
    my($ssh, $type, $sub, @extra) = @_;
    $ssh->{client_handlers}{$type} = { code => $sub, extra => \@extra };
}

sub connect {
    my $ssh = shift;
    my($type, @args) = @_;
    $ssh->{session}{sock} = new AnyEvent::Handle
        connect  => [
          $ssh->{host} => $ssh->{config}->get('port') || 'ssh'
        ],
        on_error => sub {
            my ($hdl, $fatal, $msg) = @_;
            $ssh->debug("Can't connect to $ssh->{host}, port $ssh->{config}->get('port'): $msg");
            $hdl->destroy;
        },
        on_connect_error => sub {
            $ssh->debug("Can't connect to $ssh->{host}, port $ssh->{config}->get('port'): $!");
        }, 
        on_eof   => sub {
            shift->destroy; # explicitly destroy handle
        };
    $ssh->{session}{sock}->push_read( line => sub {
        my ($handle, $line) = @_;
        $ssh->_exchange_identification($line);
        $ssh->debug("Connection established.");
        $ssh->_login();


    });
}

sub _login {
    my $ssh = shift;

    my $kex = Net::SSH::Perl::Kex->new($ssh);
    $kex->exchange(undef, sub{
        my $ssh = shift;
        my $amgr = Net::SSH::Perl::AuthMgr->new($ssh);
        $amgr->authenticate(sub{
            my ($ssh, $amgr, $valid) = @_; 
            $ssh->debug("Login completed, opening dummy shell channel.");
            my $cmgr = $ssh->channel_mgr;
            my $channel = $cmgr->new_channel(
                ctype => 'session', local_window => 0,