view release on metacpan or  search on metacpan

lib/Net/Netconf/Access/ssh.pm  view on Meta::CPAN

    my $ssh2 = Net::SSH2->new();
    croak "Failed to create a new Net::SSH2 object" unless(ref $ssh2);

    $self->trace("Making SSH connection to '$self->{'hostname'}:$port'...");
    $ssh2->connect($self->{'hostname'}, $port);
    croak "SSH connection failed: " . $ssh2->error() if($ssh2->error());
    $self->trace("SSH connection succeeded!");

    $self->trace("Performing SSH authentication");
    $ssh2->auth(username => $self->{'login'},
                password => $self->{'password'});
    croak "SSH authentication failed" if(!$ssh2->auth_ok() or $ssh2->error());
    $self->trace("Authentication succeeded!");

    $self->trace("Requesting SSH channel...");
    my $chan = $ssh2->channel();
    croak "Failed to create SSH channel" if(!ref $chan or $ssh2->error());
    $self->trace("Successfully created SSH channel!");

    $self->trace("Starting subsystem '$self->{'server'}'...");
    my $subsystem = $chan->subsystem($self->{'server'});
    if(!$subsystem) {
        $self->trace("Failed to start '$self->{'server'}' subsystem, trying to exec");
        $chan->exec($self->{'server'})
            or croak "Failed to exec ". $self->{'server'};
	$chan->flush();
	$self->trace("Started server '$self->{'server'}' in exec");
    } else {
        $self->trace("Successfully started subsystem!");
    }

    $self->{'ssh2'} = $ssh2;
    $self->{'chan'} = $chan;
    return $self;
}

# Gracefully disconnect from Netconf server
sub disconnect {
    my $self = shift;

    my $ssh2 = $self->{'ssh2'};
    $ssh2->disconnect("Bye bye from $0 [" . __PACKAGE__ . " v$VERSION]");
    $self->trace("Disconnected from SSH server");

    undef $self;
}

# Writes an XML request to the Netconf server.
sub send {
    my ($self, $xml) = @_;

    $xml .= ']]>]]>';

    my $len = length($xml);

    $self->trace("Will write $len bytes to the SSH channel:");
    $self->trace("$xml");

    # Make the channel blocking, so the write() call below waits until there
    # is available buffer space. Otherwise we'll end up busy-looping.
    $self->{'chan'}->blocking(1);

    my $written = 0;
    while($written != $len) {
        my $nbytes = $self->{'chan'}->write($xml)
            or croak "Failed to write XML data to SSH channel!";
        $written += $nbytes;
        $self->trace("Wrote $nbytes bytes (total written: $written).");
        substr($xml, 0, $nbytes) = '';
    }
    $self->trace("Successfully wrote $written bytes to SSH channel!");
    return 1;
}

# Reads an XML reply from the Netconf server.
sub recv {
    my $self = shift;
    my $ssh2 = $self->{'ssh2'};
    my $chan = $self->{'chan'};

    # Make the channel non-blocking, so that read() below allows for partial
    # reads (as we can't possibly know if the data we're about to receive is an
    # exact multiple of the buffer size argument, and doing it one character at
    # a time instead would be terribly inefficient).
    $chan->blocking(0);

    $self->trace("Reading XML response from Netconf server...");
    my ($resp, $buf);
    my $end_time = time() + 15;
    do {
        # Wait up to 10 seconds for data to become available before attempting
        # to read anything (in order to avoid busy-looping on $chan->read())
        my @poll = ({ handle => $chan, events => 'in' });
        $ssh2->poll(40000, \@poll);

        $nbytes = $chan->read($buf, 65536);

        if (!defined $nbytes || time() > $end_time) {
            croak "Failed to read XML data from SSH channel!";
        }
	if($nbytes > 0){
	    $end_time = time() + 15;
	}
        $self->trace("Read $nbytes bytes from SSH channel: '$buf'");
        $resp .= $buf;
    } until($resp =~ s/]]>]]>$//);
    $self->trace("Received XML response '$resp'");

    return $resp;
}

# Checks if the server sent us an EOF
sub eof {
    my $self = shift;
    return $self->{'chan'}->eof();
}

1;

__END__

=head1 NAME

Net::Netconf::Access::ssh

=head1 SYNOPSIS

The Net::Netconf::Access::ssh module is used internally to provide SSH access to
a Net::Netconf::Access instance, using Net::SSH2.

=head1 DESCRIPTION

This is a subclass of Net::Netconf::Access class that manages an SSH connection
with the destination host. The underlying mechanics for managing the SSH
connection is based on Net::SSH2.

=head1 CONSTRUCTOR

new($ARGS)

Please refer to the constructor of Net::Netconf::Access class.

=head1 SEE ALSO

=over 4

=item *

Net::SSH2

=item *