ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Convert-BER-XS/XS.pm
Revision: 1.57
Committed: Thu Apr 25 22:30:21 2019 UTC (5 years ago) by root
Branch: MAIN
CVS Tags: rel-1_2
Changes since 1.56: +48 -3 lines
Log Message:
1.2

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