ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Convert-BER-XS/XS.pm
Revision: 1.62
Committed: Thu Feb 6 23:15:44 2020 UTC (4 years, 3 months ago) by root
Branch: MAIN
Changes since 1.61: +0 -2 lines
Log Message:
*** empty log message ***

File Contents

# Content
1 =head1 NAME
2
3 Convert::BER::XS - I<very> low level BER en-/decoding
4
5 =head1 SYNOPSIS
6
7 use Convert::BER::XS ':all';
8
9 my $ber = ber_decode $buf, $Convert::BER::XS::SNMP_PROFILE
10 or die "unable to decode SNMP message";
11
12 # The above results in a data structure consisting of
13 # (class, tag, flags, data)
14 # tuples. Below is such a message, SNMPv1 trap
15 # with a Cisco mac change notification.
16 # Did you know that Cisco is in the news almost
17 # every week because of some backdoor password
18 # or other extremely stupid security bug?
19
20 [ ASN_UNIVERSAL, ASN_SEQUENCE, 1,
21 [
22 [ ASN_UNIVERSAL, ASN_INTEGER, 0, 0 ], # snmp version 1
23 [ ASN_UNIVERSAL, 4, 0, "public" ], # community
24 [ ASN_CONTEXT, 4, 1, # CHOICE, constructed - trap PDU
25 [
26 [ ASN_UNIVERSAL, ASN_OBJECT_IDENTIFIER, 0, "1.3.6.1.4.1.9.9.215.2" ], # enterprise oid
27 [ ASN_APPLICATION, SNMP_IPADDRESS, 0, "10.0.0.1" ], # SNMP IpAddress
28 [ ASN_UNIVERSAL, ASN_INTEGER, 0, 6 ], # generic trap
29 [ ASN_UNIVERSAL, ASN_INTEGER, 0, 1 ], # specific trap
30 [ ASN_APPLICATION, SNMP_TIMETICKS, 0, 1817903850 ], # SNMP TimeTicks
31 [ ASN_UNIVERSAL, ASN_SEQUENCE, 1, # the varbindlist
32 [
33 [ ASN_UNIVERSAL, ASN_SEQUENCE, 1, # a single varbind, "key value" pair
34 [
35 [ ASN_UNIVERSAL, ASN_OBJECT_IDENTIFIER, 0, "1.3.6.1.4.1.9.9.215.1.1.8.1.2.1" ],
36 [ ASN_UNIVERSAL, ASN_OCTET_STRING, 0, "...data..." # the value
37 ]
38 ]
39 ],
40 ...
41 # let's dump it, for debugging
42
43 ber_dump $ber, $Convert::BER::XS::SNMP_PROFILE;
44
45 # let's decode it a bit with some helper functions
46
47 my $msg = ber_is_seq $ber
48 or die "SNMP message does not start with a sequence";
49
50 ber_is $msg->[0], ASN_UNIVERSAL, ASN_INTEGER, 0
51 or die "SNMP message does not start with snmp version\n";
52
53 # message is SNMP v1 or v2c?
54 if ($msg->[0][BER_DATA] == 0 || $msg->[0][BER_DATA] == 1) {
55
56 # message is v1 trap?
57 if (ber_is $msg->[2], ASN_CONTEXT, 4, 1) {
58 my $trap = $msg->[2][BER_DATA];
59
60 # check whether trap is a cisco mac notification mac changed message
61 if (
62 (ber_is_oid $trap->[0], "1.3.6.1.4.1.9.9.215.2") # cmnInterfaceObjects
63 and (ber_is_int $trap->[2], 6)
64 and (ber_is_int $trap->[3], 1) # mac changed msg
65 ) {
66 ... and so on
67
68 # finally, let's encode it again and hope it results in the same bit pattern
69
70 my $buf = ber_encode $ber, $Convert::BER::XS::SNMP_PROFILE;
71
72 =head1 DESCRIPTION
73
74 This module implements a I<very> low level BER/DER en-/decoder.
75
76 It is tuned for low memory and high speed, while still maintaining some
77 level of user-friendlyness.
78
79 =head2 EXPORT TAGS AND CONSTANTS
80
81 By default this module doesn't export any symbols, but if you don't want
82 to break your keyboard, editor or eyesight with extremely long names, I
83 recommend importing the C<:all> tag. Still, you can selectively import
84 things.
85
86 =over
87
88 =item C<:all>
89
90 All of the below. Really. Recommended for at least first steps, or if you
91 don't care about a few kilobytes of wasted memory (and namespace).
92
93 =item C<:const>
94
95 All of the strictly ASN.1-related constants defined by this module, the
96 same as C<:const_asn :const_index>. Notably, this does not contain
97 C<:const_ber_type> and C<:const_snmp>.
98
99 A good set to get everything you need to decode and match BER data would be
100 C<:decode :const>.
101
102 =item C<:const_index>
103
104 The BER tuple array index constants:
105
106 BER_CLASS BER_TAG BER_FLAGS BER_DATA
107
108 =item C<:const_asn>
109
110 ASN class values (these are C<0>, C<1>, C<2> and C<3>, respectively -
111 exactly the two topmost bits from the identifier octet shifted 6 bits to
112 the right):
113
114 ASN_UNIVERSAL ASN_APPLICATION ASN_CONTEXT ASN_PRIVATE
115
116 ASN tag values (some of which are aliases, such as C<ASN_OID>). Their
117 numerical value corresponds exactly to the numbers used in BER/X.690.
118
119 ASN_BOOLEAN ASN_INTEGER ASN_BIT_STRING ASN_OCTET_STRING ASN_NULL ASN_OID
120 ASN_OBJECT_IDENTIFIER ASN_OBJECT_DESCRIPTOR ASN_EXTERNAL ASN_REAL ASN_SEQUENCE ASN_ENUMERATED
121 ASN_EMBEDDED_PDV ASN_UTF8_STRING ASN_RELATIVE_OID ASN_SET ASN_NUMERIC_STRING
122 ASN_PRINTABLE_STRING ASN_TELETEX_STRING ASN_T61_STRING ASN_VIDEOTEX_STRING ASN_IA5_STRING
123 ASN_ASCII_STRING ASN_UTC_TIME ASN_GENERALIZED_TIME ASN_GRAPHIC_STRING ASN_VISIBLE_STRING
124 ASN_ISO646_STRING ASN_GENERAL_STRING ASN_UNIVERSAL_STRING ASN_CHARACTER_STRING ASN_BMP_STRING
125
126 =item C<:const_ber_type>
127
128 The BER type constants, explained in the PROFILES section.
129
130 BER_TYPE_BYTES BER_TYPE_UTF8 BER_TYPE_UCS2 BER_TYPE_UCS4 BER_TYPE_INT
131 BER_TYPE_OID BER_TYPE_RELOID BER_TYPE_NULL BER_TYPE_BOOL BER_TYPE_REAL
132 BER_TYPE_IPADDRESS BER_TYPE_CROAK
133
134 =item C<:const_snmp>
135
136 Constants only relevant to SNMP. These are the tag values used by SNMP in
137 the C<ASN_APPLICATION> namespace and have the exact numerical value as in
138 BER/RFC 2578.
139
140 SNMP_IPADDRESS SNMP_COUNTER32 SNMP_UNSIGNED32 SNMP_GAUGE32
141 SNMP_TIMETICKS SNMP_OPAQUE SNMP_COUNTER64
142
143 =item C<:decode>
144
145 C<ber_decode> and the match helper functions:
146
147 ber_decode ber-decode_prefix
148 ber_is ber_is_seq ber_is_int ber_is_oid
149 ber_dump
150
151 =item C<:encode>
152
153 C<ber_encode> and the construction helper functions:
154
155 ber_encode
156 ber_int
157
158 =back
159
160 =head2 ASN.1/BER/DER/... BASICS
161
162 ASN.1 is a strange language that can be used to describe protocols and
163 data structures. It supports various mappings to JSON, XML, but most
164 importantly, to a various binary encodings such as BER, that is the topic
165 of this module, and is used in SNMP, LDAP or X.509 for example.
166
167 While ASN.1 defines a schema that is useful to interpret encoded data,
168 the BER encoding is actually somewhat self-describing: you might not know
169 whether something is a string or a number or a sequence or something else,
170 but you can nevertheless decode the overall structure, even if you end up
171 with just a binary blob for the actual value.
172
173 This works because BER values are tagged with a type and a namespace,
174 and also have a flag that says whether a value consists of subvalues (is
175 "constructed") or not (is "primitive").
176
177 Tags are simple integers, and ASN.1 defines a somewhat weird assortment
178 of those - for example, you have one integers and 16(!) different
179 string types, but there is no Unsigned32 type for example. Different
180 applications work around this in different ways, for example, SNMP defines
181 application-specific Gauge32, Counter32 and Unsigned32, which are mapped
182 to two different tags: you can distinguish between Counter32 and the
183 others, but not between Gause32 and Unsigned32, without the ASN.1 schema.
184
185 Ugh.
186
187 =head2 DECODED BER REPRESENTATION
188
189 This module represents every BER value as a 4-element tuple (actually an
190 array-reference):
191
192 [CLASS, TAG, FLAGS, DATA]
193
194 For example:
195
196 [ASN_UNIVERSAL, ASN_INTEGER, 0, 177] # the integer 177
197 [ASN_UNIVERSAL, ASN_OCTET_STRING, 0, "john"] # the string "john"
198 [ASN_UNIVERSAL, ASN_OID, 0, "1.3.6.133"] # some OID
199 [ASN_UNIVERSAL, ASN_SEQUENCE, 1, [ [ASN_UNIVERSAL... # a sequence
200
201 To avoid non-descriptive hardcoded array index numbers, this module
202 defines symbolic constants to access these members: C<BER_CLASS>,
203 C<BER_TAG>, C<BER_FLAGS> and C<BER_DATA>.
204
205 Also, the first three members are integers with a little caveat: for
206 performance reasons, these are readonly and shared, so you must not modify
207 them (increment, assign to them etc.) in any way. You may modify the
208 I<DATA> member, and you may re-assign the array itself, e.g.:
209
210 $ber = ber_decode $binbuf;
211
212 # the following is NOT legal:
213 $ber->[BER_CLASS] = ASN_PRIVATE; # ERROR, CLASS/TAG/FLAGS are READ ONLY(!)
214
215 # but all of the following are fine:
216 $ber->[BER_DATA] = "string";
217 $ber->[BER_DATA] = [ASN_UNIVERSAL, ASN_INTEGER, 0, 123];
218 @$ber = (ASN_APPLICATION, SNMP_TIMETICKS, 0, 1000);
219
220 I<CLASS> is something like a namespace for I<TAG>s - there is the
221 C<ASN_UNIVERSAL> namespace which defines tags common to all ASN.1
222 implementations, the C<ASN_APPLICATION> namespace which defines tags for
223 specific applications (for example, the SNMP C<Unsigned32> type is in this
224 namespace), a special-purpose context namespace (C<ASN_CONTEXT>, used e.g.
225 for C<CHOICE>) and a private namespace (C<ASN_PRIVATE>).
226
227 The meaning of the I<TAG> depends on the namespace, and defines a
228 (partial) interpretation of the data value. For example, SNMP defines
229 extra tags in the C<ASN_APPLICATION> namespace, and to take full advantage
230 of these, you need to tell this module how to handle those via profiles.
231
232 The most common tags in the C<ASN_UNIVERSAL> namespace are
233 C<ASN_INTEGER>, C<ASN_BIT_STRING>, C<ASN_NULL>, C<ASN_OCTET_STRING>,
234 C<ASN_OBJECT_IDENTIFIER>, C<ASN_SEQUENCE>, C<ASN_SET> and
235 C<ASN_IA5_STRING>.
236
237 The most common tags in SNMP's C<ASN_APPLICATION> namespace are
238 C<SNMP_COUNTER32>, C<SNMP_UNSIGNED32>, C<SNMP_TIMETICKS> and
239 C<SNMP_COUNTER64>.
240
241 The I<FLAGS> value is really just a boolean at this time (but might
242 get extended) - if it is C<0>, the value is "primitive" and contains
243 no subvalues, kind of like a non-reference perl scalar. If it is C<1>,
244 then the value is "constructed" which just means it contains a list of
245 subvalues which this module will en-/decode as BER tuples themselves.
246
247 The I<DATA> value is either a reference to an array of further tuples
248 (if the value is I<FLAGS>), some decoded representation of the value, if
249 this module knows how to decode it (e.g. for the integer types above) or
250 a binary string with the raw octets if this module doesn't know how to
251 interpret the namespace/tag.
252
253 Thus, you can always decode a BER data structure and at worst you get a
254 string in place of some nice decoded value.
255
256 See the SYNOPSIS for an example of such an encoded tuple representation.
257
258 =head2 DECODING AND ENCODING
259
260 =over
261
262 =item $tuple = ber_decode $bindata[, $profile]
263
264 Decodes binary BER data in C<$bindata> and returns the resulting BER
265 tuple. Croaks on any decoding error, so the returned C<$tuple> is always
266 valid.
267
268 How tags are interpreted is defined by the second argument, which must
269 be a C<Convert::BER::XS::Profile> object. If it is missing, the default
270 profile will be used (C<$Convert::BER::XS::DEFAULT_PROFILE>).
271
272 In addition to rolling your own, this module provides a
273 C<$Convert::BER::XS::SNMP_PROFILE> that knows about the additional SNMP
274 types.
275
276 Example: decode a BER blob using the default profile - SNMP values will be
277 decided as raw strings.
278
279 $tuple = ber_decode $data;
280
281 Example: as above, but use the provided SNMP profile.
282
283 $tuple = ber_encode $data, $Convert::BER::XS::SNMP_PROFILE;
284
285 =item ($tuple, $bytes) = ber_decode_prefix $bindata[, $profile]
286
287 Works like C<ber_decode>, except it doesn't croak when there is data after
288 the BER data, but instead returns the decoded value and the number of
289 bytes it decoded.
290
291 This is useful when you have BER data at the start of a buffer and other
292 data after, and you need to find the length.
293
294 Also, since BER is self-delimited, this can be used to decode multiple BER
295 values joined together.
296
297 =item $bindata = ber_encode $tuple[, $profile]
298
299 Encodes the BER tuple into a BER/DER data structure. As with
300 Cyber_decode>, an optional profile can be given.
301
302 The encoded data should be both BER and DER ("shortest form") compliant
303 unless the input says otherwise (e.g. it uses constructed strings).
304
305 =back
306
307 =head2 HELPER FUNCTIONS
308
309 Working with a 4-tuple for every value can be annoying. Or, rather, I<is>
310 annoying. To reduce this a bit, this module defines a number of helper
311 functions, both to match BER tuples and to construct BER tuples:
312
313 =head3 MATCH HELPERS
314
315 These functions accept a BER tuple as first argument and either partially
316 or fully match it. They often come in two forms, one which exactly matches
317 a value, and one which only matches the type and returns the value.
318
319 They do check whether valid tuples are passed in and croak otherwise. As
320 a ease-of-use exception, they usually also accept C<undef> instead of a
321 tuple reference, in which case they silently fail to match.
322
323 =over
324
325 =item $bool = ber_is $tuple, $class, $tag, $flags, $data
326
327 This takes a BER C<$tuple> and matches its elements against the provided
328 values, all of which are optional - values that are either missing or
329 C<undef> will be ignored, the others will be matched exactly (e.g. as if
330 you used C<==> or C<eq> (for C<$data>)).
331
332 Some examples:
333
334 ber_is $tuple, ASN_UNIVERSAL, ASN_SEQUENCE, 1
335 orf die "tuple is not an ASN SEQUENCE";
336
337 ber_is $tuple, ASN_UNIVERSAL, ASN_NULL
338 or die "tuple is not an ASN NULL value";
339
340 ber_is $tuple, ASN_UNIVERSAL, ASN_INTEGER, 0, 50
341 or die "BER integer must be 50";
342
343 =item $seq = ber_is_seq $tuple
344
345 Returns the sequence members (the array of subvalues) if the C<$tuple> is
346 an ASN SEQUENCE, i.e. the C<BER_DATA> member. If the C<$tuple> is not a
347 sequence it returns C<undef>. For example, SNMP version 1/2c/3 packets all
348 consist of an outer SEQUENCE value:
349
350 my $ber = ber_decode $snmp_data;
351
352 my $snmp = ber_is_seq $ber
353 or die "SNMP packet invalid: does not start with SEQUENCE";
354
355 # now we know $snmp is a sequence, so decode the SNMP version
356
357 my $version = ber_is_int $snmp->[0]
358 or die "SNMP packet invalid: does not start with version number";
359
360 =item $bool = ber_is_int $tuple, $int
361
362 Returns a true value if the C<$tuple> represents an ASN INTEGER with
363 the value C<$int>.
364
365 =item $int = ber_is_int $tuple
366
367 Returns true (and extracts the integer value) if the C<$tuple> is an
368 C<ASN_INTEGER>. For C<0>, this function returns a special value that is 0
369 but true.
370
371 =item $bool = ber_is_oid $tuple, $oid_string
372
373 Returns true if the C<$tuple> represents an ASN_OBJECT_IDENTIFIER
374 that exactly matches C<$oid_string>. Example:
375
376 ber_is_oid $tuple, "1.3.6.1.4"
377 or die "oid must be 1.3.6.1.4";
378
379 =item $oid = ber_is_oid $tuple
380
381 Returns true (and extracts the OID string) if the C<$tuple> is an ASN
382 OBJECT IDENTIFIER. Otherwise, it returns C<undef>.
383
384 =back
385
386 =head3 CONSTRUCTION HELPERS
387
388 =over
389
390 =item $tuple = ber_int $value
391
392 Constructs a new C<ASN_INTEGER> tuple.
393
394 =back
395
396 =head2 RELATIONSHIP TO L<Convert::BER> and L<Convert::ASN1>
397
398 This module is I<not> the XS version of L<Convert::BER>, but a different
399 take at doing the same thing. I imagine this module would be a good base
400 for speeding up either of these, or write a similar module, or write your
401 own LDAP or SNMP module for example.
402
403 =cut
404
405 package Convert::BER::XS;
406
407 use common::sense;
408
409 use XSLoader ();
410 use Exporter qw(import);
411
412 use Carp ();
413
414 our $VERSION;
415
416 BEGIN {
417 $VERSION = 1.21;
418 XSLoader::load __PACKAGE__, $VERSION;
419 }
420
421 our %EXPORT_TAGS = (
422 const_index => [qw(
423 BER_CLASS BER_TAG BER_FLAGS BER_DATA
424 )],
425 const_asn_class => [qw(
426 ASN_UNIVERSAL ASN_APPLICATION ASN_CONTEXT ASN_PRIVATE
427 )],
428 const_asn_tag => [qw(
429 ASN_BOOLEAN ASN_INTEGER ASN_BIT_STRING ASN_OCTET_STRING ASN_NULL ASN_OID ASN_OBJECT_IDENTIFIER
430 ASN_OBJECT_DESCRIPTOR ASN_EXTERNAL ASN_REAL ASN_SEQUENCE ASN_ENUMERATED
431 ASN_EMBEDDED_PDV ASN_UTF8_STRING ASN_RELATIVE_OID ASN_SET ASN_NUMERIC_STRING
432 ASN_PRINTABLE_STRING ASN_TELETEX_STRING ASN_T61_STRING ASN_VIDEOTEX_STRING ASN_IA5_STRING
433 ASN_ASCII_STRING ASN_UTC_TIME ASN_GENERALIZED_TIME ASN_GRAPHIC_STRING ASN_VISIBLE_STRING
434 ASN_ISO646_STRING ASN_GENERAL_STRING ASN_UNIVERSAL_STRING ASN_CHARACTER_STRING ASN_BMP_STRING
435 )],
436 const_ber_type => [qw(
437 BER_TYPE_BYTES BER_TYPE_UTF8 BER_TYPE_UCS2 BER_TYPE_UCS4 BER_TYPE_INT
438 BER_TYPE_OID BER_TYPE_RELOID BER_TYPE_NULL BER_TYPE_BOOL BER_TYPE_REAL
439 BER_TYPE_IPADDRESS BER_TYPE_CROAK
440 )],
441 const_snmp => [qw(
442 SNMP_IPADDRESS SNMP_COUNTER32 SNMP_GAUGE32 SNMP_UNSIGNED32
443 SNMP_TIMETICKS SNMP_OPAQUE SNMP_COUNTER64
444 )],
445 decode => [qw(
446 ber_decode ber_decode_prefix
447 ber_is ber_is_seq ber_is_int ber_is_oid
448 ber_dump
449 )],
450 encode => [qw(
451 ber_encode
452 ber_int
453 )],
454 );
455
456 our @EXPORT_OK = map @$_, values %EXPORT_TAGS;
457
458 $EXPORT_TAGS{all} = \@EXPORT_OK;
459 $EXPORT_TAGS{const_asn} = [map @{ $EXPORT_TAGS{$_} }, qw(const_asn_class const_asn_tag)];
460 $EXPORT_TAGS{const} = [map @{ $EXPORT_TAGS{$_} }, qw(const_index const_asn)];
461
462 our $DEFAULT_PROFILE = new Convert::BER::XS::Profile;
463
464 $DEFAULT_PROFILE->_set_default;
465
466 # additional SNMP application types
467 our $SNMP_PROFILE = new Convert::BER::XS::Profile;
468
469 $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_IPADDRESS , BER_TYPE_IPADDRESS);
470 $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_COUNTER32 , BER_TYPE_INT);
471 $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_UNSIGNED32, BER_TYPE_INT);
472 $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_TIMETICKS , BER_TYPE_INT);
473
474 # decodes REAL values according to ECMA-63
475 # this is pretty strict, except it doesn't catch -0.
476 # I don't have access to ISO 6093 (or BS 6727, or ANSI X.3-42)), so this is all guesswork.
477 sub _decode_real_decimal {
478 my ($format, $val) = @_;
479
480 $val =~ y/,/./; # probably not in ISO-6093
481
482 if ($format == 1) {
483 $val =~ /^ \ * [+-]? [0-9]+ \z/x
484 or Carp::croak "BER_TYPE_REAL NR1 value not in NR1 format ($val) (X.690 8.5.8)";
485 } elsif ($format == 2) {
486 $val =~ /^ \ * [+-]? (?: [0-9]+\.[0-9]* | [0-9]*\.[0-9]+ ) \z/x
487 or Carp::croak "BER_TYPE_REAL NR2 value not in NR2 format ($val) (X.690 8.5.8)";
488 } elsif ($format == 3) {
489 $val =~ /^ \ * [+-] (?: [0-9]+\.[0-9]* | [0-9]*\.[0-9]+ ) [eE] [+-]? [0-9]+ \z/x
490 or Carp::croak "BER_TYPE_REAL NR3 value not in NR3 format ($val) (X.690 8.5.8)";
491 } else {
492 Carp::croak "BER_TYPE_REAL invalid decimal numerical representation format $format";
493 }
494
495 $val
496 }
497
498 # this is a mess, but perl's support for floating point formatting is nearly nonexistant
499 sub _encode_real_decimal {
500 my ($val, $nvdig) = @_;
501
502 $val = sprintf "%.*G", $nvdig + 1, $val;
503
504 if ($val =~ /E/) {
505 $val =~ s/E(?=[^+-])/E+/;
506 $val =~ s/E/.E/ if $val !~ /\./;
507 $val =~ s/^/+/ unless $val =~ /^-/;
508
509 return "\x03$val" # NR3
510 }
511
512 $val =~ /\./
513 ? "\x02$val" # NR2
514 : "\x01$val" # NR1
515 }
516
517 =head2 DEBUGGING
518
519 To aid debugging, you can call the C<ber_dump> function to print a "nice"
520 representation to STDOUT.
521
522 =over
523
524 =item ber_dump $tuple[, $profile[, $prefix]]
525
526 In addition to specifying the BER C<$tuple> to dump, you can also specify
527 a C<$profile> and a C<$prefix> string that is printed in front of each line.
528
529 If C<$profile> is C<$Convert::BER::XS::SNMP_PROFILE>, then C<ber_dump>
530 will try to improve its output for SNMP data.
531
532 The output usually contains three columns, the "human readable" tag, the
533 BER type used to decode it, and the data value.
534
535 This function is somewhat slow and uses a number of heuristics and tricks,
536 so it really is only suitable for debug prints.
537
538 Example output:
539
540 SEQUENCE
541 | OCTET_STRING bytes 800063784300454045045400000001
542 | OCTET_STRING bytes
543 | CONTEXT (7) CONSTRUCTED
544 | | INTEGER int 1058588941
545 | | INTEGER int 0
546 | | INTEGER int 0
547 | | SEQUENCE
548 | | | SEQUENCE
549 | | | | OID oid 1.3.6.1.2.1.1.3.0
550 | | | | TIMETICKS int 638085796
551
552 =back
553
554 =cut
555
556 # reverse enum, very slow and ugly hack
557 sub _re {
558 my ($export_tag, $value) = @_;
559
560 for my $symbol (@{ $EXPORT_TAGS{$export_tag} }) {
561 $value == eval $symbol
562 and return $symbol;
563 }
564
565 "($value)"
566 }
567
568 $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_COUNTER64 , BER_TYPE_INT);
569
570 sub _ber_dump {
571 my ($ber, $profile, $indent) = @_;
572
573 if (my $seq = ber_is_seq $ber) {
574 printf "%sSEQUENCE\n", $indent;
575 &_ber_dump ($_, $profile, "$indent| ")
576 for @$seq;
577 } else {
578 my $asn = $ber->[BER_CLASS] == ASN_UNIVERSAL;
579
580 my $class = _re const_asn_class => $ber->[BER_CLASS];
581 my $tag = $asn ? _re const_asn_tag => $ber->[BER_TAG] : $ber->[BER_TAG];
582 my $type = _re const_ber_type => $profile->get ($ber->[BER_CLASS], $ber->[BER_TAG]);
583 my $data = $ber->[BER_DATA];
584
585 if ($profile == $SNMP_PROFILE and $ber->[BER_CLASS] == ASN_APPLICATION) {
586 $tag = _re const_snmp => $ber->[BER_TAG];
587 } elsif (!$asn) {
588 $tag = "$class ($tag)";
589 }
590
591 $class =~ s/^ASN_//;
592 $tag =~ s/^(ASN_|SNMP_)//;
593 $type =~ s/^BER_TYPE_//;
594
595 if ($ber->[BER_FLAGS]) {
596 printf "$indent%-16.16s\n", $tag;
597 &_ber_dump ($_, $profile, "$indent| ")
598 for @$data;
599 } else {
600 if ($data =~ y/\x20-\x7e//c / (length $data || 1) > 0.2 or $data =~ /\x00./s) {
601 # assume binary
602 $data = unpack "H*", $data;
603 } else {
604 $data =~ s/[^\x20-\x7e]/./g;
605 $data = "\"$data\"" if $tag =~ /string/i || !length $data;
606 }
607
608 substr $data, 40, 1e9, "..." if 40 < length $data;
609
610 printf "$indent%-16.16s %-6.6s %s\n", $tag, lc $type, $data;
611 }
612 }
613 }
614
615 sub ber_dump($;$$) {
616 _ber_dump $_[0], $_[1] || $DEFAULT_PROFILE, $_[2];
617 }
618
619 =head1 PROFILES
620
621 While any BER data can be correctly encoded and decoded out of the box, it
622 can be inconvenient to have to manually decode some values into a "better"
623 format: for instance, SNMP TimeTicks values are decoded into the raw octet
624 strings of their BER representation, which is quite hard to decode. With
625 profiles, you can change which class/tag combinations map to which decoder
626 function inside C<ber_decode> (and of course also which encoder functions
627 are used in C<ber_encode>).
628
629 This works by mapping specific class/tag combinations to an internal "ber
630 type".
631
632 The default profile supports the standard ASN.1 types, but no
633 application-specific ones. This means that class/tag combinations not in
634 the base set of ASN.1 are decoded into their raw octet strings.
635
636 C<Convert::BER::XS> defines two profile variables you can use out of the box:
637
638 =over
639
640 =item C<$Convert::BER::XS::DEFAULT_PROFILE>
641
642 This is the default profile, i.e. the profile that is used when no
643 profile is specified for de-/encoding.
644
645 You can modify it, but remember that this modifies the defaults for all
646 callers that rely on the default profile.
647
648 =item C<$Convert::BER::XS::SNMP_PROFILE>
649
650 A profile with mappings for SNMP-specific application tags added. This is
651 useful when de-/encoding SNMP data.
652
653 Example:
654
655 $ber = ber_decode $data, $Convert::BER::XS::SNMP_PROFILE;
656
657 =back
658
659 =head2 The Convert::BER::XS::Profile class
660
661 =over
662
663 =item $profile = new Convert::BER::XS::Profile
664
665 Create a new profile. The profile will be identical to the default
666 profile.
667
668 =item $profile->set ($class, $tag, $type)
669
670 Sets the mapping for the given C<$class>/C<$tag> combination to C<$type>,
671 which must be one of the C<BER_TYPE_*> constants.
672
673 Note that currently, the mapping is stored in a flat array, so large
674 values of C<$tag> will consume large amounts of memory.
675
676 Example:
677
678 $profile = new Convert::BER::XS::Profile;
679 $profile->set (ASN_APPLICATION, SNMP_COUNTER32, BER_TYPE_INT);
680 $ber = ber_decode $data, $profile;
681
682 =item $type = $profile->get ($class, $tag)
683
684 Returns the BER type mapped to the given C<$class>/C<$tag> combination.
685
686 =back
687
688 =head2 BER Types
689
690 This lists the predefined BER types. BER types are formatters used
691 internally to format and encode BER values. You can assign any C<BER_TYPE>
692 to any C<CLASS>/C<TAG> combination tgo change how that tag is decoded or
693 encoded.
694
695 =over
696
697 =item C<BER_TYPE_BYTES>
698
699 The raw octets of the value. This is the default type for unknown tags and
700 de-/encodes the value as if it were an octet string, i.e. by copying the
701 raw bytes.
702
703 =item C<BER_TYPE_UTF8>
704
705 Like C<BER_TYPE_BYTES>, but decodes the value as if it were a UTF-8 string
706 (without validation!) and encodes a perl unicode string into a UTF-8 BER
707 string.
708
709 =item C<BER_TYPE_UCS2>
710
711 Similar to C<BER_TYPE_UTF8>, but treats the BER value as UCS-2 encoded
712 string.
713
714 =item C<BER_TYPE_UCS4>
715
716 Similar to C<BER_TYPE_UTF8>, but treats the BER value as UCS-4 encoded
717 string.
718
719 =item C<BER_TYPE_INT>
720
721 Encodes and decodes a BER integer value to a perl integer scalar. This
722 should correctly handle 64 bit signed and unsigned values.
723
724 =item C<BER_TYPE_OID>
725
726 Encodes and decodes an OBJECT IDENTIFIER into dotted form without leading
727 dot, e.g. C<1.3.6.1.213>.
728
729 =item C<BER_TYPE_RELOID>
730
731 Same as C<BER_TYPE_OID> but uses relative object identifier
732 encoding: ASN.1 uses some hack encoding of the first two OID components
733 into a single integer in a weird attempt to save an insignificant amount
734 of space in an otherwise wasteful encoding, and relative OIDs are
735 basically OIDs without this hack. The practical difference is that the
736 second component of an OID can only have the values 1..40, while relative
737 OIDs do not have this restriction.
738
739 =item C<BER_TYPE_NULL>
740
741 Decodes an C<ASN_NULL> value into C<undef>, and always encodes a
742 C<ASN_NULL> type, regardless of the perl value.
743
744 =item C<BER_TYPE_BOOL>
745
746 Decodes an C<ASN_BOOLEAN> value into C<0> or C<1>, and encodes a perl
747 boolean value into an C<ASN_BOOLEAN>.
748
749 =item C<BER_TYPE_REAL>
750
751 Decodes/encodes a BER real value. NOT IMPLEMENTED.
752
753 =item C<BER_TYPE_IPADDRESS>
754
755 Decodes/encodes a four byte string into an IPv4 dotted-quad address string
756 in Perl. Given the obsolete nature of this type, this is a low-effort
757 implementation that simply uses C<sprintf> and C<sscanf>-style conversion,
758 so it won't handle all string forms supported by C<inet_aton> for example.
759
760 =item C<BER_TYPE_CROAK>
761
762 Always croaks when encountered during encoding or decoding - the
763 default behaviour when encountering an unknown type is to treat it as
764 C<BER_TYPE_BYTES>. When you don't want that but instead prefer a hard
765 error for some types, then C<BER_TYPE_CROAK> is for you.
766
767 =back
768
769 =head2 Example Profile
770
771 The following creates a profile suitable for SNMP - it's exactly identical
772 to the C<$Convert::BER::XS::SNMP_PROFILE> profile.
773
774 our $SNMP_PROFILE = new Convert::BER::XS::Profile;
775
776 $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_IPADDRESS , BER_TYPE_IPADDRESS);
777 $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_COUNTER32 , BER_TYPE_INT);
778 $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_UNSIGNED32, BER_TYPE_INT);
779 $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_TIMETICKS , BER_TYPE_INT);
780 $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_OPAQUE , BER_TYPE_BYTES);
781 $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_COUNTER64 , BER_TYPE_INT);
782
783 =head2 LIMITATIONS/NOTES
784
785 This module can only en-/decode 64 bit signed and unsigned
786 integers/tags/lengths, and only when your perl supports those. So no UUID
787 OIDs for now (unless you map the C<OBJECT IDENTIFIER> tag to something
788 other than C<BER_TYPE_OID>).
789
790 This module does not generally care about ranges, i.e. it will happily
791 de-/encode 64 bit integers into an C<SNMP_UNSIGNED32> value, or a negative
792 number into an C<SNMP_COUNTER64>.
793
794 OBJECT IDENTIFIEERs cannot have unlimited length, although the limit is
795 much larger than e.g. the one imposed by SNMP or other protocols, and is
796 about 4kB.
797
798 Constructed strings are decoded just fine, but there should be a way to
799 join them for convenience.
800
801 REAL values will always be encoded in decimal form and ssometimes is
802 forced into a perl "NV" type, potentially losing precision.
803
804 =head2 ITHREADS SUPPORT
805
806 This module is unlikely to work in any other than the loading thread when
807 the (officially discouraged) ithreads are in use.
808
809 =head1 AUTHOR
810
811 Marc Lehmann <schmorp@schmorp.de>
812 http://software.schmorp.de/pkg/Convert-BER-XS
813
814 =cut
815
816 1;
817