summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Data/Buffer.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Data/Buffer.pm')
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Data/Buffer.pm465
1 files changed, 465 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Data/Buffer.pm b/Master/tlpkg/tlperl/lib/Data/Buffer.pm
new file mode 100755
index 00000000000..0f085ad30d3
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Data/Buffer.pm
@@ -0,0 +1,465 @@
+# $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