Net::SSH::Perl::Subsystem::Client - Subsystem client base class

Net-SSH-Perl documentation Contained in the Net-SSH-Perl distribution.

Index

Code Index:

NAME

Top

Net::SSH::Perl::Subsystem::Client - Subsystem client base class

SYNOPSIS

Top

    package My::Subsystem;

    use Net::SSH::Perl::Subsystem::Client;
    @ISA = qw( Net::SSH::Perl::Subsystem::Client );

    use constant MSG_HELLO => 1;

    sub init {
        my $system = shift;
        $system->SUPER::init(@_);

        my $msg = $system->new_msg(MSG_HELLO);
        $msg->put_str("Hello, subsystem server.");
        $msg->send;
    }

    sub subsystem { "mysubsystem" }

DESCRIPTION

Top

Net::SSH::Perl::Subsystem::Client simplifies the process of writing a client for an SSH-2 subsystem. A subsystem is generally a networking protocol that is built on top of an SSH channel--the channel provides transport, connection, encryption, authentication, message integrity, etc. The subsystem client and server communicate over this encrypted, secure channel (a channel built over an insecure network). SSH provides the encrypted transport, and the subsystem is then free to act like a standard networking protocol.

Subsystem::Client is built on top of Net::SSH::Perl, which provides the client end of the services described above (encryption, message integrity checking, authentication, etc.). It is designed to be used with a subsystem server, working with respect to an agreed-upon networking protocol.

SFTP is an example of a subsystem: the underlying transport is set up by Net::SSH::Perl, and on top of that layer, files can be transferred and filesystems managed without knowledge of the secure tunnel.

USAGE

Top

Net::SSH::Perl::Subsystem::Client is intended to be used as a base class for your protocol-specific client. It handles all interaction with Net::SSH::Perl so that your focus can be on sending commands to the subsystem server, etc.

Your subclass will probably be most interested in using and/or overriding the following methods:

$sc->init(%args)

Initializes a new Subsystem::Client object: builds the SSH tunnel using Net::SSH::Perl, then opens up a channel along which the subsystem traffic will be sent. It then opens a connection to the subsystem server.

You can override this method to provide any additional functionality that your client might need; for example, you might wish to use it to send an 'init' message to the subsystem server.

Net-SSH-Perl documentation Contained in the Net-SSH-Perl distribution. 
# $Id: Client.pm,v 1.8 2001/07/11 21:57:35 btrott Exp $

package Net::SSH::Perl::Subsystem::Client;
use strict;

use Net::SSH::Perl::Constants qw(
    SSH2_MSG_CHANNEL_OPEN_CONFIRMATION
    SSH2_MSG_CHANNEL_SUCCESS
    SSH2_MSG_CHANNEL_FAILURE
    CHAN_INPUT_WAIT_DRAIN
    CHAN_INPUT_CLOSED );
use Net::SSH::Perl::Buffer;
use Net::SSH::Perl;

use Carp qw( croak );

sub new {
    my $class = shift;
    my $sc = bless { }, $class;
    $sc->init(@_);
}

sub subsystem { }
sub buffer_class { 'Net::SSH::Perl::Buffer' }

sub debug {
    my $sc = shift;
    if ($sc->{debug}) {
        $sc->{ssh}->debug($sc->subsystem . ": @_");
    }
}

sub init {
    my $sc = shift;
    my($host, %param) = @_;
    $sc->{host} = $host;
    $sc->{debug} = delete $param{debug};
    $param{ssh_args} ||= [];

    $sc->{_msg_id} = 0;

    my $ssh = Net::SSH::Perl->new($sc->{host}, protocol => 2,
        debug => $sc->{debug}, @{ $param{ssh_args} });
    $ssh->login($param{user}, $param{password});
    $sc->{ssh} = $ssh;

    my $channel = $sc->_open_channel;
    $sc->{channel} = $channel;

    $sc;
}

sub close {
    my $sc = shift;
    my $channel = $sc->{channel};
    $channel->{istate} = CHAN_INPUT_WAIT_DRAIN;
    $channel->send_eof;
    $channel->{istate} = CHAN_INPUT_CLOSED;
    $sc->{ssh}->client_loop;
}

sub _open_channel {
    my $sc = shift;
    my $ssh = $sc->{ssh};

    my $channel = $ssh->_session_channel;
    $channel->open;

    my $system = $sc->subsystem or
        croak "Subclass does not define a subsystem name";
    $channel->register_handler(SSH2_MSG_CHANNEL_OPEN_CONFIRMATION, sub {
        my($channel, $packet) = @_;
        $channel->{ssh}->debug("Sending subsystem: " . $system);
        my $r_packet = $channel->request_start("subsystem", 1);
        $r_packet->put_str($system);
        $r_packet->send;
    });

    my $subsystem_reply = sub {
        my($channel, $packet) = @_;
        my $id = $packet->get_int32;
        if ($packet->type == SSH2_MSG_CHANNEL_FAILURE) {
            $channel->{ssh}->fatal_disconnect("Request for " .
                "subsystem '$system' failed on channel '$id'");
        }
        $channel->{ssh}->break_client_loop;
    };

    my $cmgr = $ssh->channel_mgr;
    $cmgr->register_handler(SSH2_MSG_CHANNEL_FAILURE, $subsystem_reply);
    $cmgr->register_handler(SSH2_MSG_CHANNEL_SUCCESS, $subsystem_reply);

    $sc->{incoming} = $sc->buffer_class->new( MP => 'SSH2' );
    $channel->register_handler("_output_buffer", sub {
        my($channel, $buffer) = @_;
        $sc->{incoming}->append($buffer->bytes);
        $channel->{ssh}->break_client_loop;
    });

    ## Get channel confirmation, etc. Break once we get a response
    ## to subsystem execution.
    $ssh->client_loop;

    $channel;
}

## Messaging methods--messages are essentially sub-packets.

sub msg_id { $_[0]->{_msg_id}++ }

sub new_msg {
    my $sc = shift;
    my($code) = @_;
    my $msg = $sc->buffer_class->new( MP => 'SSH2' );
    $msg->put_int8($code);
    $msg;
}

sub new_msg_w_id {
    my $sc = shift;
    my($code, $sid) = @_;
    my $msg = $sc->new_msg($code);
    my $id = defined $sid ? $sid : $sc->msg_id;
    $msg->put_int32($id);
    ($msg, $id);
}

sub send_msg {
    my $sc = shift;
    my($buf) = @_;
    my $b = $sc->buffer_class->new( MP => 'SSH2' );
    $b->put_int32($buf->length);
    $b->append($buf->bytes);
    $sc->{channel}->send_data($b->bytes);
}

sub get_msg {
    my $sc = shift;
    my $buf = $sc->{incoming};
    my $len;
    unless ($buf->length > 4) {
        $sc->{ssh}->client_loop;
        croak "Connection closed" unless $buf->length > 4;
        $len = unpack "N", $buf->bytes(0, 4, '');
        croak "Received message too long $len" if $len > 256 * 1024;
        while ($buf->length < $len) {
            $sc->{ssh}->client_loop;
        }
    }
    my $b = $sc->buffer_class->new( MP => 'SSH2' );
    $b->append( $buf->bytes(0, $len, '') );
    $b;
}

1;
__END__