home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / Packet.pm < prev    next >
Encoding:
Perl POD Document  |  2003-12-19  |  13.3 KB  |  481 lines
  1. # $Id: Packet.pm,v 1.24 2003/12/20 04:39:25 autarch Exp $
  2.  
  3. package Net::SSH::Perl::Packet;
  4.  
  5. use strict;
  6. use Carp qw( croak );
  7. use IO::Select;
  8. use POSIX qw( :errno_h );
  9.  
  10. use Net::SSH::Perl;
  11. use Net::SSH::Perl::Constants qw(
  12.     :protocol
  13.     SSH_MSG_DISCONNECT
  14.     SSH_MSG_DEBUG
  15.     SSH_MSG_IGNORE
  16.     SSH2_MSG_DISCONNECT
  17.     SSH2_MSG_DEBUG
  18.     SSH2_MSG_IGNORE
  19.     MAX_PACKET_SIZE );
  20. use Net::SSH::Perl::Buffer;
  21.  
  22. use Scalar::Util qw(weaken);
  23.  
  24. sub new {
  25.     my $class = shift;
  26.     my $ssh   = shift;
  27.     my $pack  = bless { ssh => $ssh, @_ }, $class;
  28.     weaken $pack->{ssh};
  29.     unless ($pack->{data}) {
  30.         $pack->{data} = Net::SSH::Perl::Buffer->new(
  31.             MP => $ssh->protocol == PROTOCOL_SSH2 ? 'SSH2' : 'SSH1');
  32.         if ($pack->{type}) {
  33.             $pack->{data}->put_int8($pack->{type});
  34.         }
  35.     }
  36.     $pack;
  37. }
  38.  
  39. sub read {
  40.     my $class = shift;
  41.     my $ssh = shift;
  42.     my $sock = $ssh->sock;
  43.  
  44.     while (1) {
  45.         if (my $packet = $class->read_poll($ssh)) {
  46.             return $packet;
  47.         }
  48.         my $s = IO::Select->new( $sock );
  49.         my @ready = $s->can_read;
  50.         my $buf;
  51.         my $len = sysread $sock, $buf, 8192;
  52.         croak "Connection closed by remote host." if $len == 0;
  53.         if (!defined $len) {
  54.             next if $! == EAGAIN || $! == EWOULDBLOCK;
  55.             croak "Read from socket failed: $!";
  56.         }
  57.  
  58.         ## Untaint data read from sshd. This is binary data,
  59.         ## so there's nothing to taint-check against/for.
  60.         ($buf) = $buf =~ /(.*)/s;
  61.         $ssh->incoming_data->append($buf);
  62.     }
  63. }
  64.  
  65. sub read_poll {
  66.     my $class = shift;
  67.     my $ssh = shift;
  68.  
  69.     my($packet, $debug, $ignore);
  70.     if ($ssh->protocol == PROTOCOL_SSH2) {
  71.         $packet = $class->read_poll_ssh2($ssh);
  72.         ($debug, $ignore) = (SSH2_MSG_DEBUG, SSH2_MSG_IGNORE);
  73.     }
  74.     else {
  75.         $packet = $class->read_poll_ssh1($ssh);
  76.     ($debug, $ignore) = (SSH_MSG_DEBUG, SSH_MSG_IGNORE);
  77.     }
  78.     return unless $packet;
  79.  
  80.     my $type = $packet->type;
  81.     if ($ssh->protocol == PROTOCOL_SSH2) {   ## Handle DISCONNECT msg
  82.         if ($type == SSH2_MSG_DISCONNECT) {
  83.             $packet->get_int32;   ## reason
  84.             croak "Received disconnect message: ", $packet->get_str, "\n";
  85.         }
  86.     }
  87.     else {
  88.         if ($type == SSH_MSG_DISCONNECT) {
  89.             croak "Received disconnect message: ", $packet->get_str, "\n";
  90.         }
  91.     }
  92.  
  93.     if ($type == $debug) {
  94.         $ssh->debug("Remote: " . $packet->get_str);
  95.     }
  96.     elsif ($type == $ignore) { }
  97.     else {
  98.         return $packet;
  99.     }
  100.     return $class->read_poll($ssh);
  101. }
  102.  
  103. sub read_poll_ssh1 {
  104.     my $class = shift;
  105.     my $ssh = shift;
  106.  
  107.     unless (defined &_crc32) {
  108.         eval "use Net::SSH::Perl::Util qw( _crc32 );";
  109.         die $@ if $@;
  110.     }
  111.  
  112.     my $incoming = $ssh->incoming_data;
  113.     return if $incoming->length < 4 + 8;
  114.  
  115.     my $len = unpack "N", $incoming->bytes(0, 4);
  116.     $len = 0 unless defined $len;
  117.     my $pad_len = ($len + 8) & ~7;
  118.     return if $incoming->length < 4 + $pad_len;
  119.  
  120.     my $buffer = Net::SSH::Perl::Buffer->new( MP => 'SSH1' );
  121.     $buffer->append($incoming->bytes(0, $pad_len+4, ''));
  122.  
  123.     $buffer->bytes(0, 4, "");
  124.  
  125.     if (my $cipher = $ssh->receive_cipher) {
  126.         my $decrypted = $cipher->decrypt($buffer->bytes);
  127.         $buffer->empty;
  128.         $buffer->append($decrypted);
  129.     }
  130.  
  131.     my $crc = _crc32($buffer->bytes(0, -4));
  132.     $buffer->bytes(0, 8 - $len % 8, "");
  133.  
  134.     my $stored_crc = unpack "N", $buffer->bytes(-4, 4);
  135.     $ssh->fatal_disconnect("Corrupted check bytes on input")
  136.         unless $crc == $stored_crc;
  137.  
  138.     $buffer->bytes(-4, 4, "");  ## Cut off checksum.
  139.  
  140.     if (my $comp = $ssh->compression) {
  141.         my $inflated = $comp->uncompress($buffer->bytes);
  142.         $buffer->empty;
  143.         $buffer->append($inflated);
  144.     }
  145.  
  146.     my $type = unpack "c", $buffer->bytes(0, 1, "");
  147.     $class->new($ssh,
  148.         type => $type,
  149.         data => $buffer);
  150. }
  151.  
  152. sub read_poll_ssh2 {
  153.     my $class = shift;
  154.     my $ssh = shift;
  155.     my $kex = $ssh->kex;
  156.  
  157.     my($ciph, $mac, $comp);
  158.     if ($kex) {
  159.         $ciph = $kex->receive_cipher;
  160.         $mac  = $kex->receive_mac;
  161.         $comp = $kex->receive_comp;
  162.     }
  163.     my $maclen = $mac && $mac->enabled ? $mac->len : 0;
  164.     my $block_size = 8;
  165.  
  166.     my $incoming = $ssh->incoming_data;
  167.     if (!$ssh->{session}{_last_packet_length}) {
  168.         return if $incoming->length < $block_size;
  169.         my $b = Net::SSH::Perl::Buffer->new( MP => 'SSH2' );
  170.         $b->append( $ciph && $ciph->enabled ?
  171.             $ciph->decrypt($incoming->bytes(0, $block_size)) : $incoming->bytes(0, $block_size)
  172.         );
  173.         $incoming->bytes(0, $block_size, $b->bytes);
  174.         my $plen = $ssh->{session}{_last_packet_length} = $b->get_int32;
  175.         if ($plen < 1 + 4 || $plen > 256 * 1024) {
  176.             $ssh->fatal_disconnect("Bad packet length $plen");
  177.         }
  178.     }
  179.     my $need = 4 + $ssh->{session}{_last_packet_length} - $block_size;
  180.     croak "padding error: need $need block $block_size"
  181.         if $need % $block_size;
  182.     return if $incoming->length < $need + $block_size + $maclen;
  183.  
  184.     my $buffer = Net::SSH::Perl::Buffer->new( MP => 'SSH2' );
  185.     $buffer->append( $incoming->bytes(0, $block_size, '') );
  186.     my $p_str = $incoming->bytes(0, $need, '');
  187.     $buffer->append( $ciph && $ciph->enabled ?
  188.         $ciph->decrypt($p_str) : $p_str );
  189.     my($macbuf);
  190.     if ($mac && $mac->enabled) {
  191.         $macbuf = $mac->hmac(pack("N", $ssh->{session}{seqnr_in}) . $buffer->bytes);
  192.         my $stored_mac = $incoming->bytes(0, $maclen, '');
  193.         $ssh->fatal_disconnect("Corrupted MAC on input")
  194.             unless $macbuf eq $stored_mac;
  195.     }
  196.     $ssh->{session}{seqnr_in}++;
  197.  
  198.     my $padlen = unpack "c", $buffer->bytes(4, 1);
  199.     $ssh->fatal_disconnect("Corrupted padlen $padlen on input")
  200.         unless $padlen >= 4;
  201.  
  202.     ## Cut off packet size + padlen, discard padding */
  203.     $buffer->bytes(0, 5, '');
  204.     $buffer->bytes(-$padlen, $padlen, '');
  205.  
  206.     if ($comp && $comp->enabled) {
  207.         my $inflated = $comp->uncompress($buffer->bytes);
  208.         $buffer->empty;
  209.         $buffer->append($inflated);
  210.     }
  211.  
  212.     my $type = unpack "c", $buffer->bytes(0, 1, '');
  213.     $ssh->{session}{_last_packet_length} = 0;
  214.     $class->new($ssh, type => $type, data => $buffer);
  215. }
  216.  
  217. sub read_expect {
  218.     my $class = shift;
  219.     my($ssh, $type) = @_;
  220.     my $pack = $class->read($ssh);
  221.     if ($pack->type != $type) {
  222.         $ssh->fatal_disconnect(sprintf
  223.           "Protocol error: expected packet type %d, got %d",
  224.             $type, $pack->type);
  225.     }
  226.     $pack;
  227. }
  228.  
  229. sub send {
  230.     my $pack = shift;
  231.     if ($pack->{ssh}->protocol == PROTOCOL_SSH2) {
  232.         $pack->send_ssh2(@_);
  233.     }
  234.     else {
  235.         $pack->send_ssh1(@_);
  236.     }
  237. }
  238.  
  239. sub send_ssh1 {
  240.     my $pack = shift;
  241.     my $buffer = shift || $pack->{data};
  242.     my $ssh = $pack->{ssh};
  243.  
  244.     unless (defined &_crc32) {
  245.         eval "use Net::SSH::Perl::Util qw( _crc32 );";
  246.     }
  247.  
  248.     if ($buffer->length >= MAX_PACKET_SIZE - 30) {
  249.         $ssh->fatal_disconnect(sprintf
  250.             "Sending too big a packet: size %d, limit %d",
  251.             $buffer->length, MAX_PACKET_SIZE);
  252.     }
  253.  
  254.     if (my $comp = $ssh->compression) {
  255.         my $compressed = $comp->compress($buffer->bytes);
  256.         $buffer->empty;
  257.         $buffer->append($compressed);
  258.     }
  259.  
  260.     my $len = $buffer->length + 4;
  261.  
  262.     my $cipher = $ssh->send_cipher;
  263.     #if ($cipher) {
  264.         $buffer->insert_padding;
  265.     #}
  266.  
  267.     my $crc = _crc32($buffer->bytes);
  268.     $buffer->put_int32($crc);
  269.  
  270.     my $output = Net::SSH::Perl::Buffer->new( MP => 'SSH1' );
  271.     $output->put_int32($len);
  272.     my $data = $cipher ? $cipher->encrypt($buffer->bytes) : $buffer->bytes;
  273.     $output->put_chars($data);
  274.  
  275.     my $sock = $ssh->sock;
  276.     syswrite $sock, $output->bytes, $output->length;
  277. }
  278.  
  279. sub send_ssh2 {
  280.     my $pack = shift;
  281.     my $buffer = shift || $pack->{data};
  282.     my $ssh = $pack->{ssh};
  283.  
  284.     my $kex = $ssh->kex;
  285.     my($ciph, $mac, $comp);
  286.     if ($kex) {
  287.         $ciph = $kex->send_cipher;
  288.         $mac  = $kex->send_mac;
  289.         $comp = $kex->send_comp;
  290.     }
  291.     my $block_size = 8;
  292.  
  293.     if ($comp && $comp->enabled) {
  294.         my $compressed = $comp->compress($buffer->bytes);
  295.         $buffer->empty;
  296.         $buffer->append($compressed);
  297.     }
  298.  
  299.     my $len = $buffer->length + 4 + 1;
  300.     my $padlen = $block_size - ($len % $block_size);
  301.     $padlen += $block_size if $padlen < 4;
  302.     my $junk = $ciph ? (join '', map chr rand 255, 1..$padlen) : ("\0" x $padlen);
  303.     $buffer->append($junk);
  304.  
  305.     my $packet_len = $buffer->length + 1;
  306.     $buffer->bytes(0, 0, pack("N", $packet_len) . pack("c", $padlen));
  307.  
  308.     my($macbuf);
  309.     if ($mac && $mac->enabled) {
  310.         $macbuf = $mac->hmac(pack("N", $ssh->{session}{seqnr_out}) . $buffer->bytes);
  311.     }
  312.     my $output = Net::SSH::Perl::Buffer->new( MP => 'SSH2' );
  313.     $output->append( $ciph && $ciph->enabled ? $ciph->encrypt($buffer->bytes) : $buffer->bytes );
  314.     $output->append($macbuf) if $mac && $mac->enabled;
  315.  
  316.     $ssh->{session}{seqnr_out}++;
  317.  
  318.     my $sock = $ssh->sock;
  319.     syswrite $sock, $output->bytes, $output->length;
  320. }
  321.  
  322. sub type {
  323.     my $pack = shift;
  324.     $pack->{type} = shift if @_;
  325.     $pack->{type};
  326. }
  327.  
  328. sub data { $_[0]->{data} }
  329.  
  330. use vars qw( $AUTOLOAD );
  331. sub AUTOLOAD {
  332.     my $pack = shift;
  333.     (my $meth = $AUTOLOAD) =~ s/.*://;
  334.     return if $meth eq "DESTROY";
  335.  
  336.     if ( $pack->{data}->can($meth) ) {
  337.         $pack->{data}->$meth(@_);
  338.     }
  339.     else {
  340.         croak "Can't dispatch method $meth to Net::SSH::Perl::Buffer object.";
  341.     }
  342. }
  343.  
  344. 1;
  345. __END__
  346.  
  347. =head1 NAME
  348.  
  349. Net::SSH::Perl::Packet - Packet layer of SSH protocol
  350.  
  351. =head1 SYNOPSIS
  352.  
  353.     use Net::SSH::Perl::Packet;
  354.  
  355.     # Send a packet to an ssh daemon.
  356.     my $pack = Net::SSH::Perl::Packet->new($ssh, type => SSH_MSG_NONE);
  357.     $pack->send;
  358.  
  359.     # Receive a packet.
  360.     my $pack = Net::SSH::Perl::Packet->read($ssh);
  361.  
  362. =head1 DESCRIPTION
  363.  
  364. I<Net::SSH::Perl::Packet> implements the packet-layer piece
  365. of the SSH protocol. Messages between server and client
  366. are sent as binary data packets, which are encrypted
  367. (once the two sides have agreed on the encryption
  368. cipher, that is).
  369.  
  370. Packets are made up primarily of a packet type, which
  371. describes the type of message and data contained
  372. therein, and the data itself. In addition, each packet:
  373. indicates its length in a 32-bit unsigned integer;
  374. contains padding to pad the length of the packet to
  375. a multiple of 8 bytes; and is verified by a 32-bit crc
  376. checksum.
  377.  
  378. Refer to the SSH RFC for more details on the packet
  379. protocol and the SSH protocol in general.
  380.  
  381. =head1 USAGE
  382.  
  383. =head2 Net::SSH::Perl::Packet->new($ssh, %params)
  384.  
  385. Creates/starts a new packet in memory. I<$ssh> is
  386. a I<Net::SSH::Perl> object, which should already be connected
  387. to an ssh daemon. I<%params> can contain the following
  388. keys:
  389.  
  390. =over 4
  391.  
  392. =item * type
  393.  
  394. The message type of this packet. This should be one of
  395. the values exported by I<Net::SSH::Perl::Constants> from the
  396. I<msg> tag; for example, I<SSH_MSG_NONE>.
  397.  
  398. =item * data
  399.  
  400. A I<Net::SSH::Perl::Buffer> object containing the data in this
  401. packet. Realistically, there aren't many times you'll need
  402. to supply this argument: when sending a packet, it will be
  403. created automatically; and when receiving a packet, the
  404. I<read> method (see below) will create the buffer
  405. automatically, as well.
  406.  
  407. =back
  408.  
  409. =head2 Net::SSH::Perl::Packet->read($ssh)
  410.  
  411. Reads a packet from the ssh daemon and returns that packet.
  412.  
  413. This method will block until an entire packet has been read.
  414. The socket itself is non-blocking, but the method waits (using
  415. I<select>) for data on the incoming socket, then processes
  416. that data when it comes in. If the data makes up a complete
  417. packet, the packet is returned to the caller. Otherwise I<read>
  418. continues to try to read more data.
  419.  
  420. =head2 Net::SSH::Perl::Packet->read_poll($ssh)
  421.  
  422. Checks the data that's been read from the sshd to see if that
  423. data comprises a complete packet. If so, that packet is
  424. returned. If not, returns C<undef>.
  425.  
  426. This method does not block.
  427.  
  428. =head2 Net::SSH::Perl::Packet->read_expect($ssh, $type)
  429.  
  430. Reads the next packet from the daemon and dies if the
  431. packet type does not match I<$type>. Otherwise returns
  432. the read packet.
  433.  
  434. =head2 $packet->send([ $data ])
  435.  
  436. Sends a packet to the ssh daemon. I<$data> is optional,
  437. and if supplied specifies the buffer to be sent in
  438. the packet (should be a I<Net::SSH::Perl::Buffer> object).
  439. In addition, I<$data>, if specified, I<must> include
  440. the packed message type.
  441.  
  442. If I<$data> is not specified, I<send> sends the buffer
  443. internal to the packet, which you've presumably filled
  444. by calling the I<put_*> methods (see below).
  445.  
  446. =head2 $packet->type
  447.  
  448. Returns the message type of the packet I<$packet>.
  449.  
  450. =head2 $packet->data
  451.  
  452. Returns the message buffer from the packet I<$packet>;
  453. a I<Net::SSH::Perl::Buffer> object.
  454.  
  455. =head2 Net::SSH::Perl::Buffer methods
  456.  
  457. Calling methods from the I<Net::SSH::Perl::Buffer> class on
  458. your I<Net::SSH::Perl::Packet> object will automatically
  459. invoke those methods on the buffer object internal
  460. to your packet object (which is created when your
  461. object is constructed). For example, if you executed
  462. the following code:
  463.  
  464.     my $packet = Net::SSH::Perl::Packet->new($ssh, type => SSH_CMSG_USER);
  465.     $packet->put_str($user);
  466.  
  467. this would construct a new packet object I<$packet>,
  468. then fill its internal buffer by calling the
  469. I<put_str> method on it.
  470.  
  471. Refer to the I<Net::SSH::Perl::Buffer> documentation
  472. (the I<GET AND PUT METHODS> section) for more details
  473. on those methods.
  474.  
  475. =head1 AUTHOR & COPYRIGHTS
  476.  
  477. Please see the Net::SSH::Perl manpage for author, copyright,
  478. and license information.
  479.  
  480. =cut
  481.