Net::SSH::Perl::Packet - Packet layer of SSH protocol

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

Index

Code Index:

NAME

Top

Net::SSH::Perl::Packet - Packet layer of SSH protocol

SYNOPSIS

Top

    use Net::SSH::Perl::Packet;

    # Send a packet to an ssh daemon.
    my $pack = Net::SSH::Perl::Packet->new($ssh, type => SSH_MSG_NONE);
    $pack->send;

    # Receive a packet.
    my $pack = Net::SSH::Perl::Packet->read($ssh);

DESCRIPTION

Top

Net::SSH::Perl::Packet implements the packet-layer piece of the SSH protocol. Messages between server and client are sent as binary data packets, which are encrypted (once the two sides have agreed on the encryption cipher, that is).

Packets are made up primarily of a packet type, which describes the type of message and data contained therein, and the data itself. In addition, each packet: indicates its length in a 32-bit unsigned integer; contains padding to pad the length of the packet to a multiple of 8 bytes; and is verified by a 32-bit crc checksum.

Refer to the SSH RFC for more details on the packet protocol and the SSH protocol in general.

USAGE

Top

Net::SSH::Perl::Packet->new($ssh, %params)

Creates/starts a new packet in memory. $ssh is a Net::SSH::Perl object, which should already be connected to an ssh daemon. %params can contain the following keys:

* type

The message type of this packet. This should be one of the values exported by Net::SSH::Perl::Constants from the msg tag; for example, SSH_MSG_NONE.

* data

A Net::SSH::Perl::Buffer object containing the data in this packet. Realistically, there aren't many times you'll need to supply this argument: when sending a packet, it will be created automatically; and when receiving a packet, the read method (see below) will create the buffer automatically, as well.

Net::SSH::Perl::Packet->read($ssh)

Reads a packet from the ssh daemon and returns that packet.

This method will block until an entire packet has been read. The socket itself is non-blocking, but the method waits (using select) for data on the incoming socket, then processes that data when it comes in. If the data makes up a complete packet, the packet is returned to the caller. Otherwise read continues to try to read more data.

Net::SSH::Perl::Packet->read_poll($ssh)

Checks the data that's been read from the sshd to see if that data comprises a complete packet. If so, that packet is returned. If not, returns undef.

This method does not block.

Net::SSH::Perl::Packet->read_expect($ssh, $type)

Reads the next packet from the daemon and dies if the packet type does not match $type. Otherwise returns the read packet.

$packet->send([ $data ])

Sends a packet to the ssh daemon. $data is optional, and if supplied specifies the buffer to be sent in the packet (should be a Net::SSH::Perl::Buffer object). In addition, $data, if specified, must include the packed message type.

If $data is not specified, send sends the buffer internal to the packet, which you've presumably filled by calling the put_* methods (see below).

$packet->type

Returns the message type of the packet $packet.

$packet->data

Returns the message buffer from the packet $packet; a Net::SSH::Perl::Buffer object.

Net::SSH::Perl::Buffer methods

Calling methods from the Net::SSH::Perl::Buffer class on your Net::SSH::Perl::Packet object will automatically invoke those methods on the buffer object internal to your packet object (which is created when your object is constructed). For example, if you executed the following code:

    my $packet = Net::SSH::Perl::Packet->new($ssh, type => SSH_CMSG_USER);
    $packet->put_str($user);

this would construct a new packet object $packet, then fill its internal buffer by calling the put_str method on it.

Refer to the Net::SSH::Perl::Buffer documentation (the GET AND PUT METHODS section) for more details on those methods.

AUTHOR & COPYRIGHTS

Top

Please see the Net::SSH::Perl manpage for author, copyright, and license information.

Net-SSH-Perl documentation Contained in the Net-SSH-Perl distribution. 
# $Id: Packet.pm,v 1.25 2008/09/24 19:21:20 turnstep Exp $

package Net::SSH::Perl::Packet;

use strict;
use Carp qw( croak );
use IO::Select;
use POSIX qw( :errno_h );

use Net::SSH::Perl;
use Net::SSH::Perl::Constants qw(
    :protocol
    SSH_MSG_DISCONNECT
    SSH_MSG_DEBUG
    SSH_MSG_IGNORE
    SSH2_MSG_DISCONNECT
    SSH2_MSG_DEBUG
    SSH2_MSG_IGNORE
    MAX_PACKET_SIZE );
use Net::SSH::Perl::Buffer;

use Scalar::Util qw(weaken);

sub new {
    my $class = shift;
    my $ssh   = shift;
    my $pack  = bless { ssh => $ssh, @_ }, $class;
    weaken $pack->{ssh};
    unless ($pack->{data}) {
        $pack->{data} = Net::SSH::Perl::Buffer->new(
            MP => $ssh->protocol == PROTOCOL_SSH2 ? 'SSH2' : 'SSH1');
        if ($pack->{type}) {
            $pack->{data}->put_int8($pack->{type});
        }
    }
    $pack;
}

sub read {
    my $class = shift;
    my $ssh = shift;
    my $sock = $ssh->sock;

    while (1) {
        if (my $packet = $class->read_poll($ssh)) {
            return $packet;
        }
        my $s = IO::Select->new( $sock );
        my @ready = $s->can_read;
        my $buf;
        my $len = sysread $sock, $buf, 8192;
        croak "Connection closed by remote host." if $len == 0;
        if (!defined $len) {
            next if $! == EAGAIN || $! == EWOULDBLOCK;
            croak "Read from socket failed: $!";
        }

        ## Untaint data read from sshd. This is binary data,
        ## so there's nothing to taint-check against/for.
        ($buf) = $buf =~ /(.*)/s;
        $ssh->incoming_data->append($buf);
    }
}

sub read_poll {
    my $class = shift;
    my $ssh = shift;

    my($packet, $debug, $ignore);
    if ($ssh->protocol == PROTOCOL_SSH2) {
        $packet = $class->read_poll_ssh2($ssh);
        ($debug, $ignore) = (SSH2_MSG_DEBUG, SSH2_MSG_IGNORE);
    }
    else {
        $packet = $class->read_poll_ssh1($ssh);
        ($debug, $ignore) = (SSH_MSG_DEBUG, SSH_MSG_IGNORE);
    }
    return unless $packet;

    my $type = $packet->type;
    if ($ssh->protocol == PROTOCOL_SSH2) {   ## Handle DISCONNECT msg
        if ($type == SSH2_MSG_DISCONNECT) {
            $packet->get_int32;   ## reason
            croak "Received disconnect message: ", $packet->get_str, "\n";
        }
    }
    else {
        if ($type == SSH_MSG_DISCONNECT) {
            croak "Received disconnect message: ", $packet->get_str, "\n";
        }
    }

    if ($type == $debug) {
        $ssh->debug("Remote: " . $packet->get_str);
    }
    elsif ($type == $ignore) { }
    else {
        return $packet;
    }
    return $class->read_poll($ssh);
}

sub read_poll_ssh1 {
    my $class = shift;
    my $ssh = shift;

    unless (defined &_crc32) {
        eval "use Net::SSH::Perl::Util qw( _crc32 );";
        die $@ if $@;
    }

    my $incoming = $ssh->incoming_data;
    return if $incoming->length < 4 + 8;

    my $len = unpack "N", $incoming->bytes(0, 4);
    $len = 0 unless defined $len;
    my $pad_len = ($len + 8) & ~7;
    return if $incoming->length < 4 + $pad_len;

    my $buffer = Net::SSH::Perl::Buffer->new( MP => 'SSH1' );
    $buffer->append($incoming->bytes(0, $pad_len+4, ''));

    $buffer->bytes(0, 4, "");

    if (my $cipher = $ssh->receive_cipher) {
        my $decrypted = $cipher->decrypt($buffer->bytes);
        $buffer->empty;
        $buffer->append($decrypted);
    }

    my $crc = _crc32($buffer->bytes(0, -4));
    $buffer->bytes(0, 8 - $len % 8, "");

    my $stored_crc = unpack "N", $buffer->bytes(-4, 4);
    $ssh->fatal_disconnect("Corrupted check bytes on input")
        unless $crc == $stored_crc;

    $buffer->bytes(-4, 4, "");  ## Cut off checksum.

    if (my $comp = $ssh->compression) {
        my $inflated = $comp->uncompress($buffer->bytes);
        $buffer->empty;
        $buffer->append($inflated);
    }

    my $type = unpack "c", $buffer->bytes(0, 1, "");
    $class->new($ssh,
        type => $type,
        data => $buffer);
}

sub read_poll_ssh2 {
    my $class = shift;
    my $ssh = shift;
    my $kex = $ssh->kex;

    my($ciph, $mac, $comp);
    if ($kex) {
        $ciph = $kex->receive_cipher;
        $mac  = $kex->receive_mac;
        $comp = $kex->receive_comp;
    }
    my $maclen = $mac && $mac->enabled ? $mac->len : 0;
    my $block_size = 8;

    my $incoming = $ssh->incoming_data;
    if (!$ssh->{session}{_last_packet_length}) {
        return if $incoming->length < $block_size;
        my $b = Net::SSH::Perl::Buffer->new( MP => 'SSH2' );
        $b->append( $ciph && $ciph->enabled ?
            $ciph->decrypt($incoming->bytes(0, $block_size)) : $incoming->bytes(0, $block_size)
        );
        $incoming->bytes(0, $block_size, $b->bytes);
        my $plen = $ssh->{session}{_last_packet_length} = $b->get_int32;
        if ($plen < 1 + 4 || $plen > 256 * 1024) {
            $ssh->fatal_disconnect("Bad packet length $plen");
        }
    }
    my $need = 4 + $ssh->{session}{_last_packet_length} - $block_size;
    croak "padding error: need $need block $block_size"
        if $need % $block_size;
    return if $incoming->length < $need + $block_size + $maclen;

    my $buffer = Net::SSH::Perl::Buffer->new( MP => 'SSH2' );
    $buffer->append( $incoming->bytes(0, $block_size, '') );
    my $p_str = $incoming->bytes(0, $need, '');
    $buffer->append( $ciph && $ciph->enabled ?
        $ciph->decrypt($p_str) : $p_str );
    my($macbuf);
    if ($mac && $mac->enabled) {
        $macbuf = $mac->hmac(pack("N", $ssh->{session}{seqnr_in}) . $buffer->bytes);
        my $stored_mac = $incoming->bytes(0, $maclen, '');
        $ssh->fatal_disconnect("Corrupted MAC on input")
            unless $macbuf eq $stored_mac;
    }
    $ssh->{session}{seqnr_in}++;

    my $padlen = unpack "c", $buffer->bytes(4, 1);
    $ssh->fatal_disconnect("Corrupted padlen $padlen on input")
        unless $padlen >= 4;

    ## Cut off packet size + padlen, discard padding */
    $buffer->bytes(0, 5, '');
    $buffer->bytes(-$padlen, $padlen, '');

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

    my $type = unpack "c", $buffer->bytes(0, 1, '');
    $ssh->{session}{_last_packet_length} = 0;
    $class->new($ssh, type => $type, data => $buffer);
}

sub read_expect {
    my $class = shift;
    my($ssh, $type) = @_;
    my $pack = $class->read($ssh);
    if ($pack->type != $type) {
        $ssh->fatal_disconnect(sprintf
          "Protocol error: expected packet type %d, got %d",
            $type, $pack->type);
    }
    $pack;
}

sub send {
    my $pack = shift;
    if ($pack->{ssh}->protocol == PROTOCOL_SSH2) {
        $pack->send_ssh2(@_);
    }
    else {
        $pack->send_ssh1(@_);
    }
}

sub send_ssh1 {
    my $pack = shift;
    my $buffer = shift || $pack->{data};
    my $ssh = $pack->{ssh};

    unless (defined &_crc32) {
        eval "use Net::SSH::Perl::Util qw( _crc32 );";
    }

    if ($buffer->length >= MAX_PACKET_SIZE - 30) {
        $ssh->fatal_disconnect(sprintf
            "Sending too big a packet: size %d, limit %d",
            $buffer->length, MAX_PACKET_SIZE);
    }

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

    my $len = $buffer->length + 4;

    my $cipher = $ssh->send_cipher;
    #if ($cipher) {
        $buffer->insert_padding;
    #}

    my $crc = _crc32($buffer->bytes);
    $buffer->put_int32($crc);

    my $output = Net::SSH::Perl::Buffer->new( MP => 'SSH1' );
    $output->put_int32($len);
    my $data = $cipher ? $cipher->encrypt($buffer->bytes) : $buffer->bytes;
    $output->put_chars($data);

    my $sock = $ssh->sock;
    syswrite $sock, $output->bytes, $output->length;
}

sub send_ssh2 {
    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' );
    $output->append( $ciph && $ciph->enabled ? $ciph->encrypt($buffer->bytes) : $buffer->bytes );
    $output->append($macbuf) if $mac && $mac->enabled;

    $ssh->{session}{seqnr_out}++;

    my $sock = $ssh->sock;
    syswrite $sock, $output->bytes, $output->length;
}

sub type {
    my $pack = shift;
    $pack->{type} = shift if @_;
    $pack->{type};
}

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

use vars qw( $AUTOLOAD );
sub AUTOLOAD {
    my $pack = shift;
    (my $meth = $AUTOLOAD) =~ s/.*://;
    return if $meth eq "DESTROY";

    if ( $pack->{data}->can($meth) ) {
        $pack->{data}->$meth(@_);
    }
    else {
        croak "Can't dispatch method $meth to Net::SSH::Perl::Buffer object.";
    }
}

1;
__END__