| # $Id: Buffer.pm,v 1.9 2001/07/28 06:36:50 btrott Exp $ |
| |
| package Data::Buffer; |
| use strict; |
| |
| use vars qw( $VERSION ); |
| $VERSION = '0.04'; |
| |
| sub new { |
| my $class = shift; |
| my %arg = @_; |
| bless { buf => "", offset => 0, template => "" }, $class; |
| } |
| |
| sub new_with_init { |
| my $class = shift; |
| my $buf = $class->new; |
| $buf->append($_) for @_; |
| $buf; |
| } |
| |
| sub extract { |
| my $buf = shift; |
| my($nbytes) = @_; |
| my $new = ref($buf)->new; |
| $new->append( $buf->get_bytes($nbytes) ); |
| $new; |
| } |
| |
| sub empty { |
| my $buf = shift; |
| $buf->{buf} = ""; |
| $buf->{offset} = 0; |
| $buf->{template} = ""; |
| } |
| |
| sub set_offset { $_[0]->{offset} = $_[1] } |
| sub reset_offset { $_[0]->set_offset(0) } |
| |
| sub insert_template { |
| my $buf = shift; |
| $buf->bytes(0, 0, $buf->{template} . chr(0)); |
| } |
| |
| sub append { |
| my $buf = shift; |
| $buf->{buf} .= $_[0]; |
| } |
| |
| sub bytes { |
| my $buf = shift; |
| my($off, $len, $rep) = @_; |
| $off ||= 0; |
| $len = length $buf->{buf} unless defined $len; |
| return defined $rep ? |
| substr($buf->{buf}, $off, $len, $rep) : |
| substr($buf->{buf}, $off, $len); |
| } |
| |
| sub length { length $_[0]->{buf} } |
| sub offset { $_[0]->{offset} } |
| sub template { $_[0]->{template} } |
| |
| sub dump { |
| my $buf = shift; |
| my @r; |
| for my $c (split //, $buf->bytes(@_)) { |
| push @r, sprintf "%02x", ord $c; |
| push @r, "\n" unless @r % 24; |
| } |
| join ' ', @r |
| } |
| |
| sub get_all { |
| my $buf = shift; |
| my($tmpl, $data) = $buf->{buf} =~ /^([NYaCn\d]+)\0(.+)$/s or |
| die "Buffer $buf does not appear to contain a template"; |
| my $b = __PACKAGE__->new; |
| $b->append($data); |
| my @tmpl = split //, $tmpl; |
| my @data; |
| while (@tmpl) { |
| my $el = shift @tmpl; |
| if ($el eq "N") { |
| next if $tmpl[0] eq "Y"; ## Peek ahead: is it a string? |
| push @data, $b->get_int32; |
| } |
| elsif ($el eq "n") { |
| push @data, $b->get_int16; |
| } |
| elsif ($el eq "C") { |
| push @data, $b->get_int8; |
| } |
| elsif ($el eq "a") { |
| my $len = shift @tmpl; |
| push @data, $b->get_char for 1..$len; |
| } |
| elsif ($el eq "Y") { |
| push @data, $b->get_str; |
| } |
| else { |
| die "Unrecognized template token: $el"; |
| } |
| } |
| @data; |
| } |
| |
| sub get_int8 { |
| my $buf = shift; |
| my $off = defined $_[0] ? shift : $buf->{offset}; |
| $buf->{offset} += 1; |
| unpack "C", $buf->bytes($off, 1); |
| } |
| |
| sub put_int8 { |
| my $buf = shift; |
| $buf->{buf} .= pack "C", $_[0]; |
| $buf->{template} .= "C"; |
| } |
| |
| sub get_int16 { |
| my $buf = shift; |
| my $off = defined $_[0] ? shift : $buf->{offset}; |
| $buf->{offset} += 2; |
| unpack "n", $buf->bytes($off, 2); |
| } |
| |
| sub put_int16 { |
| my $buf = shift; |
| $buf->{buf} .= pack "n", $_[0]; |
| $buf->{template} .= "n"; |
| } |
| |
| sub get_int32 { |
| my $buf = shift; |
| my $off = defined $_[0] ? shift : $buf->{offset}; |
| $buf->{offset} += 4; |
| unpack "N", $buf->bytes($off, 4); |
| } |
| |
| sub put_int32 { |
| my $buf = shift; |
| $buf->{buf} .= pack "N", $_[0]; |
| $buf->{template} .= "N"; |
| } |
| |
| sub get_char { |
| my $buf = shift; |
| my $off = defined $_[0] ? shift : $buf->{offset}; |
| $buf->{offset}++; |
| $buf->bytes($off, 1); |
| } |
| |
| sub put_char { |
| my $buf = shift; |
| $buf->{buf} .= $_[0]; |
| $buf->{template} .= "a" . CORE::length($_[0]); |
| } |
| |
| sub get_bytes { |
| my $buf = shift; |
| my($nbytes) = @_; |
| my $d = $buf->bytes($buf->{offset}, $nbytes); |
| $buf->{offset} += $nbytes; |
| $d; |
| } |
| |
| sub put_bytes { |
| my $buf = shift; |
| my($str, $nbytes) = @_; |
| $buf->{buf} .= $nbytes ? substr($str, 0, $nbytes) : $str; |
| $buf->{template} .= "a" . ($nbytes ? $nbytes : CORE::length($str)); |
| } |
| |
| *put_chars = \&put_char; |
| |
| sub get_str { |
| my $buf = shift; |
| my $off = defined $_[0] ? shift : $buf->{offset}; |
| my $len = $buf->get_int32; |
| $buf->{offset} += $len; |
| $buf->bytes($off+4, $len); |
| } |
| |
| sub put_str { |
| my $buf = shift; |
| my $str = shift; |
| $str = "" unless defined $str; |
| $buf->put_int32(CORE::length($str)); |
| $buf->{buf} .= $str; |
| $buf->{template} .= "Y"; |
| } |
| |
| 1; |
| __END__ |
| |
| =head1 NAME |
| |
| Data::Buffer - Read/write buffer class |
| |
| =head1 SYNOPSIS |
| |
| use Data::Buffer; |
| my $buffer = Data::Buffer->new; |
| |
| ## Add a 32-bit integer. |
| $buffer->put_int32(10932930); |
| |
| ## Get it back. |
| my $int = $buffer->get_int32; |
| |
| =head1 DESCRIPTION |
| |
| I<Data::Buffer> implements a low-level binary buffer in which |
| you can get and put integers, strings, and other data. |
| Internally the implementation is based on C<pack> and C<unpack>, |
| such that I<Data::Buffer> is really a layer on top of those |
| built-in functions. |
| |
| All of the I<get_*> and I<put_*> methods respect the |
| internal offset state in the buffer object. This means that |
| you should read data out of the buffer in the same order that |
| you put it in. For example: |
| |
| $buf->put_int16(24); |
| $buf->put_int32(1233455); |
| $buf->put_int16(99); |
| |
| $buf->get_int16; # 24 |
| $buf->get_int32; # 1233455 |
| $buf->get_int16; # 99 |
| |
| Of course, this assumes that you I<know> the order of the data |
| items in the buffer. If your setup is such that your sending |
| and receiving processes won't necessarily know what's inside |
| the buffers they receive, take a look at the I<TEMPLATE USAGE> |
| section. |
| |
| =head1 USAGE |
| |
| =head2 Data::Buffer->new |
| |
| Creates a new buffer object and returns it. The buffer is |
| initially empty. |
| |
| This method takes no arguments. |
| |
| =head2 Data::Buffer->new_with_init(@strs) |
| |
| Creates a new buffer object and appends to it each of the |
| octet strings in I<@strs>. |
| |
| Returns the new buffer object. |
| |
| =head2 $buffer->get_int8 |
| |
| Returns the next 8-bit integer from the buffer (which |
| is really just the ASCII code for the next character/byte |
| in the buffer). |
| |
| =head2 $buffer->put_int8 |
| |
| Appends an 8-bit integer to the buffer (which is really |
| just the character corresponding to that integer, in |
| ASCII). |
| |
| =head2 $buffer->get_int16 |
| |
| Returns the next 16-bit integer from the buffer. |
| |
| =head2 $buffer->put_int16($integer) |
| |
| Appends a 16-bit integer to the buffer. |
| |
| =head2 $buffer->get_int32 |
| |
| Returns the next 32-bit integer from the buffer. |
| |
| =head2 $buffer->put_int32($integer) |
| |
| Appends a 32-bit integer to the buffer. |
| |
| =head2 $buffer->get_char |
| |
| More appropriately called I<get_byte>, perhaps, this |
| returns the next byte from the buffer. |
| |
| =head2 $buffer->put_char($bytes) |
| |
| Appends a byte (or a sequence of bytes) to the buffer. |
| There is no restriction on the length of the byte |
| string I<$bytes>; if it makes you uncomfortable to call |
| I<put_char> to put multiple bytes, you can instead |
| call this method as I<put_chars>. It's the same thing. |
| |
| =head2 $buffer->get_bytes($n) |
| |
| Grabs I<$n> bytes from the buffer, where I<$n> is a positive |
| integer. Increments the internal offset state by I<$n>. |
| |
| =head2 $buffer->put_bytes($bytes [, $n ]) |
| |
| Appends a sequence of bytes to the buffer; if I<$n> is |
| unspecified, appends the entire length of I<$bytes>. |
| Otherwise appends only the first I<$n> bytes of I<$bytes>. |
| |
| =head2 $buffer->get_str |
| |
| Returns the next "string" from the buffer. A string here |
| is represented as the length of the string (a 32-bit |
| integer) followed by the string itself. |
| |
| =head2 $buffer->put_str($string) |
| |
| Appends a string (32-bit integer length and the string |
| itself) to the buffer. |
| |
| =head2 $buffer->extract($n) |
| |
| Extracts the next I<$n> bytes from the buffer I<$buffer>, |
| increments the offset state in I<$buffer>, and returns a |
| new buffer object containing the extracted bytes. |
| |
| =head1 TEMPLATE USAGE |
| |
| Generally when you use I<Data::Buffer> it's to communicate |
| with another process (perhaps a C program) that bundles up |
| its data into binary buffers. In those cases, it's very likely |
| that the data will be in some well-known order in the buffer: |
| in other words, it might be documented that a certain C program |
| creates a buffer containing: |
| |
| =over 4 |
| |
| =item * an int8 |
| |
| =item * a string |
| |
| =item * an int32 |
| |
| =back |
| |
| In this case, you would presumably know about the order of the |
| data in the buffer, and you could extract it accordingly: |
| |
| $buffer->get_int8; |
| $buffer->get_str; |
| $buffer->get_int32; |
| |
| In other cases, however, there may not be a well-defined order |
| of data items in the buffer. This might be the case if you're |
| inventing your own protocol, and you want your binary buffers |
| to "know" about their contents. In this case, you'll want to |
| use the templating features of I<Data::Buffer>. |
| |
| When you use the I<put_> methods to place data in a buffer, |
| I<Data::Buffer> keeps track of the types of data that you're |
| inserting in a template description of the buffer. This template |
| contains all of the information necessary for a process to |
| receive a buffer and extract the data in the buffer without |
| knowledge of the order of the items. |
| |
| To use this feature, simply use the I<insert_template> method |
| after you've filled your buffer to completion. For example: |
| |
| my $buffer = Data::Buffer->new; |
| $buffer->put_str("foo"); |
| $buffer->put_int32(9999); |
| $buffer->insert_template; |
| |
| ## Ship off the buffer to another process. |
| |
| The receiving process should then invoke the I<get_all> method |
| on the buffer to extract all of the data: |
| |
| my $buffer = Data::Buffer->new; |
| $buffer->append( $received_buffer_data ); |
| my @data = $buffer->get_all; |
| |
| @data will now contain two elements: C<"foo"> and C<9999>. |
| |
| =head1 LOW-LEVEL METHODS |
| |
| =head2 $buffer->append($bytes) |
| |
| Appends raw data I<$bytes> to the end of the in-memory |
| buffer. Generally you don't need to use this method |
| unless you're initializing an empty buffer, because |
| when you need to add data to a buffer you should |
| generally use one of the I<put_*> methods. |
| |
| =head2 $buffer->empty |
| |
| Empties out the buffer object. |
| |
| =head2 $buffer->bytes([ $offset [, $length [, $replacement ]]]) |
| |
| Behaves exactly like the I<substr> built-in function, |
| except on the buffer I<$buffer>. Given no arguments, |
| I<bytes> returns the entire buffer; given one argument |
| I<$offset>, returns everything from that position to |
| the end of the string; given I<$offset> and I<$length>, |
| returns the segment of the buffer starting at I<$offset> |
| and consisting of I<$length> bytes; and given all three |
| arguments, replaces that segment with I<$replacement>. |
| |
| This is a very low-level method, and you generally |
| won't need to use it. |
| |
| Also be warned that you should not intermix use of this |
| method with use of the I<get_*> and I<put_*> methods; |
| the latter classes of methods maintain internal state |
| of the buffer offset where arguments will be gotten from |
| and put, respectively. The I<bytes> method gives no |
| thought to this internal offset state. |
| |
| =head2 $buffer->length |
| |
| Returns the length of the buffer object. |
| |
| =head2 $buffer->offset |
| |
| Returns the internal offset state. |
| |
| If you insist on intermixing calls to I<bytes> with calls |
| to the I<get_*> and I<put_*> methods, you'll probably |
| want to use this method to get some status on that |
| internal offset. |
| |
| =head2 $buffer->set_offset($offset) |
| |
| Sets the internal offset state to I<$offset>. |
| |
| =head2 $buffer->reset_offset |
| |
| Sets the internal offset state to 0. |
| |
| =head2 $buffer->dump(@args) |
| |
| Returns a hex dump of the buffer. The dump is of the I<entire> |
| buffer I<$buffer>; in other words, I<dump> doesn't respect the |
| internal offset pointer. |
| |
| I<@args> is passed directly through to the I<bytes> method, |
| which means that you can supply arguments to emulate support |
| of the internal offset: |
| |
| my $dump = $buffer->dump($buffer->offset); |
| |
| =head2 $buffer->insert_padding |
| |
| A helper method: pads out the buffer so that the length |
| of the transferred packet will be evenly divisible by |
| 8, which is a requirement of the SSH protocol. |
| |
| =head1 AUTHOR & COPYRIGHTS |
| |
| Benjamin Trott, ben@rhumba.pair.com |
| |
| Except where otherwise noted, Data::Buffer is Copyright 2001 |
| Benjamin Trott. All rights reserved. Data::Buffer is free |
| software; you may redistribute it and/or modify it under |
| the same terms as Perl itself. |
| |
| =cut |