This file is indexed.

/usr/share/perl5/Net/AMQP/Common.pm is in libnet-amqp-perl 0.06~dfsg-2.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  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
package Net::AMQP::Common;
use 5.006;

=head1 NAME

Net::AMQP::Common - A collection of exportable tools for AMQP (de)serialization

=head1 SYNOPSIS

  use Net::AMQP::Common qw(:all)

=head1 EXPORTABLE METHODS

The following are available for exporting by name or by ':all'.  All the 'pack_*' methods take a single argument and return a binary string.  All the 'unpack_*' methods take a scalar ref and return a perl data structure of some type, consuming some data from the scalar ref.

=over 4

=item I<pack_octet>

=item I<unpack_octet>

=item I<pack_short_integer>

=item I<unpack_short_integer>

=item I<pack_long_integer>

=item I<unpack_long_integer>

=item I<pack_long_long_integer>

=item I<unpack_long_long_integer>

=item I<pack_unsigned_short_integer>

=item I<unpack_unsigned_short_integer>

=item I<pack_unsigned_long_integer>

=item I<unpack_unsigned_long_integer>

=item I<pack_unsigned_long_long_integer>

=item I<unpack_unsigned_long_long_integer>

=item I<pack_timestamp>

=item I<unpack_timestamp>

=item I<pack_boolean>

=item I<unpack_boolean>

=item I<pack_short_string>

=item I<unpack_short_string>

=item I<pack_field_table>

=item I<unpack_field_table>

=item I<pack_field_array>

Tables and arrays sometimes require explicit typing.  See
L<Net::AMQP::Value>.  Also, in tables and arrays booleans from the
L<boolean> module are sent as AMQP booleans.

=item I<unpack_field_array>

=item I<%data_type_map>

A mapping of the XML spec's data type names to our names ('longstr' => 'long_string')

=item I<show_ascii>

A helper routine that, given a binary string, returns a string of each byte represented by '\###', base 10 numbering.

=back

=cut

use strict;
use warnings;
use Scalar::Util qw( blessed reftype );
use Net::AMQP::Value;
use base qw(Exporter);

BEGIN {
    *_big = (pack('n', 1) eq pack('s', 1))
      ? sub { shift }
      : sub { scalar reverse shift };
}

our @EXPORT_OK = qw(
    pack_octet                      unpack_octet
    pack_short_integer              unpack_short_integer
    pack_long_integer               unpack_long_integer
    pack_long_long_integer          unpack_long_long_integer
    pack_unsigned_short_integer     unpack_unsigned_short_integer
    pack_unsigned_long_integer      unpack_unsigned_long_integer
    pack_unsigned_long_long_integer unpack_unsigned_long_long_integer
    pack_timestamp                  unpack_timestamp
    pack_boolean                    unpack_boolean
    pack_short_string               unpack_short_string
    pack_long_string                unpack_long_string
    pack_field_table                unpack_field_table
    pack_field_array                unpack_field_array
    show_ascii
    %data_type_map
);

our %EXPORT_TAGS = (
    'all' => [@EXPORT_OK],
);

# The XML spec uses a abbreviated name; map this to my name
our %data_type_map = (
    bit       => 'bit',
    octet     => 'octet',
    short     => 'short_integer',
    long      => 'long_integer',
    longlong  => 'long_long_integer',
    shortstr  => 'short_string',
    longstr   => 'long_string',
    timestamp => 'timestamp',
    table     => 'field_table',
    array     => 'field_array',
);

sub pack_boolean                       {      pack 'C', shift() ? 1 : 0 }
sub pack_octet                         {      pack 'C', shift || 0 }
sub pack_short_integer                 { _big pack 's', shift || 0 }
sub pack_long_integer                  { _big pack 'l', shift || 0 }
sub pack_long_long_integer             { _big pack 'q', shift || 0 }
sub pack_unsigned_short_integer        {      pack 'n', shift || 0 }
sub pack_unsigned_long_integer         {      pack 'N', shift || 0 }
sub pack_unsigned_long_long_integer    { _big pack 'Q', shift || 0 }

sub unpack_boolean                     { unpack 'C',      substr ${+shift}, 0, 1, '' }
sub unpack_octet                       { unpack 'C',      substr ${+shift}, 0, 1, '' }
sub unpack_short_integer               { unpack 's', _big substr ${+shift}, 0, 2, '' }
sub unpack_long_integer                { unpack 'l', _big substr ${+shift}, 0, 4, '' }
sub unpack_long_long_integer           { unpack 'q', _big substr ${+shift}, 0, 8, '' }
sub unpack_unsigned_short_integer      { unpack 'n',      substr ${+shift}, 0, 2, '' }
sub unpack_unsigned_long_integer       { unpack 'N',      substr ${+shift}, 0, 4, '' }
sub unpack_unsigned_long_long_integer  { unpack 'Q', _big substr ${+shift}, 0, 8, '' }

sub pack_timestamp   { goto &pack_unsigned_long_long_integer }
sub unpack_timestamp { goto &unpack_unsigned_long_long_integer }

sub pack_short_string {
    my $str = shift;
    $str = '' unless defined $str;
    return pack('C', length $str) . $str;
}

sub unpack_short_string {
    my $input_ref = shift;
    my $string_length = unpack 'C', substr $$input_ref, 0, 1, '';
    return substr $$input_ref, 0, $string_length, '';
}

sub pack_long_string {
    if (ref $_[0] && ref $_[0] eq 'HASH') {
        # It appears that, for fields that are long-string, in some cases it's
        # necessary to pass a field-table object, which behaves similarly.
        # Here for Connection::StartOk->response
        return pack_field_table(@_);
    }
    my $str = shift;
    $str = '' unless defined $str;
    return pack('N', length $str) . $str;
}

sub unpack_long_string {
    my $input_ref = shift;
    my $string_length = unpack 'N', substr $$input_ref, 0, 4, '';
    return substr $$input_ref, 0, $string_length, '';
}

sub pack_field_table {
    my $table = shift;
    $table = {} unless defined $table;

    my $table_packed = '';
    foreach my $key (sort keys %$table) { # sort so I can compare raw frames
        my $value = $table->{$key};
        $table_packed .= pack_short_string($key);
        $table_packed .= _pack_field_value($table->{$key});
    }
    return pack('N', length $table_packed) . $table_packed;
}

sub pack_field_array {
    my $array = shift;
    $array = [] unless defined $array;

    my $array_packed = '';
    foreach my $value (@$array) {
        $array_packed .= _pack_field_value($value);
    }

    return pack('N', length $array_packed) . $array_packed;
}

sub _pack_field_value {
    my ($value) = @_;
    if (not defined $value) {
        'V'
    }
    elsif (not ref $value) {
        if ($value =~ /^-?\d+\z/) {
            'I' . pack_long_integer($value);
        } else {
            # FIXME - assuming that all other values are string values
            'S' . pack_long_string($value);
        }
    }
    elsif (ref($value) eq 'HASH') {
        'F' . pack_field_table($value);
    }
    elsif (ref($value) eq 'ARRAY') {
        'A' . pack_field_array($value);
    }
    elsif (ref($value) eq 'boolean') {
        't' . pack_boolean($value);
    }
    elsif (blessed($value) && $value->isa('Net::AMQP::Value')) {
        $value->field_packed;
    }
    else {
        die "No way to pack $value into AMQP array or table";
    }
}

my %_unpack_field_types = (
    V => sub { undef },
    S => \&unpack_long_string,
    I => \&unpack_long_integer,
    D => sub {
        my $input_ref = shift;
        my $exp = unpack_octet($input_ref);
        my $num = unpack_long_integer($input_ref);
        $num / 10.0 ** $exp;
    },
    F => \&unpack_field_table,
    A => \&unpack_field_array,
    T => \&unpack_timestamp,
    t => \&unpack_boolean,
);

sub unpack_field_table {
    my $input_ref = shift;

    my ($table_length) = unpack 'N', substr $$input_ref, 0, 4, '';

    my $table_input = substr $$input_ref, 0, $table_length, '';

    my %table;
    while (length $table_input) {
        my $field_name = unpack_short_string(\$table_input);

        my ($field_value_type) = substr $table_input, 0, 1, '';
        my $field_value_subref = $_unpack_field_types{$field_value_type};
        die "No way to unpack field '$field_name' type '$field_value_type'" unless defined $field_value_subref;

        my $field_value = $field_value_subref->(\$table_input);
        die "Failed to unpack field '$field_name' type '$field_value_type' ('$table_input')" unless defined $field_value;

        $table{ $field_name } = $field_value;
    }

    return \%table;
}

sub unpack_field_array {
    my $input_ref = shift;

    my ($array_length) = unpack 'N', substr $$input_ref, 0, 4, '';

    my $array_input = substr $$input_ref, 0, $array_length, '';

    my @array;
    while (length $array_input) {
        my $field_value_type = substr $array_input, 0, 1, '';
        my $field_value_subref = $_unpack_field_types{$field_value_type};
        die "No way to unpack field array element ".@array." type '$field_value_type'" unless defined $field_value_subref;

        my $field_value = $field_value_subref->(\$array_input);
        die "Failed to unpack field array element ".@array." type '$field_value_type' ('$array_input')" unless defined $field_value;

        push @array, $field_value;
    }

    return \@array;
}

sub show_ascii {
    my $input = shift;

    my $return = '';

    foreach my $char (split(//, $input)) {
        my $num = unpack 'C', $char;
        if (0 && $char =~ m{^[0-9A-Za-z]$}) {
            $return .= $char;
        }
        else {
            $return .= sprintf '\%03d', $num;
        }
    }

    return $return;
}

=head1 SEE ALSO

L<Net::AMQP>

=head1 COPYRIGHT

Copyright (c) 2009 Eric Waters and XMission LLC (http://www.xmission.com/).  All rights reserved.  This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

The full text of the license can be found in the LICENSE file included with this module.

=head1 AUTHOR

Eric Waters <ewaters@gmail.com>

=cut

1;