summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl0/lib/Data/Buffer.pm
blob: 0f085ad30d3e33b39dd0c46fac2adc314174bcc4 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
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