File Coverage

blib/lib/Convert/BER/XS.pm
Criterion Covered Total %
statement 29 60 48.3
branch 16 38 42.1
condition 0 14 0.0
subroutine 7 10 70.0
pod 1 1 100.0
total 53 123 43.0


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Convert::BER::XS - I 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 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). 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 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 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 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,
205             C, C and C.
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 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 is something like a namespace for Is - there is the
223             C namespace which defines tags common to all ASN.1
224             implementations, the C namespace which defines tags for
225             specific applications (for example, the SNMP C type is in this
226             namespace), a special-purpose context namespace (C, used e.g.
227             for C) and a private namespace (C).
228              
229             The meaning of the I depends on the namespace, and defines a
230             (partial) interpretation of the data value. For example, SNMP defines
231             extra tags in the C 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 namespace are
235             C, C, C, C,
236             C, C, C and
237             C.
238              
239             The most common tags in SNMP's C namespace are
240             C, C, C and
241             C.
242              
243             The I 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 value is either a reference to an array of further tuples
250             (if the value is I), 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 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, 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
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 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 will be ignored, the others will be matched exactly (e.g. as if
332             you used C<==> or C (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 member. If the C<$tuple> is not a
349             sequence it returns C. 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. 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.
385              
386             =back
387              
388             =head3 CONSTRUCTION HELPERS
389              
390             =over
391              
392             =item $tuple = ber_int $value
393              
394             Constructs a new C tuple.
395              
396             =back
397              
398             =head2 RELATIONSHIP TO L and L
399              
400             This module is I the XS version of L, 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 7     7   6952 use common::sense;
  7         48  
  7         29  
410              
411 7     7   299 use XSLoader ();
  7         12  
  7         153  
412 7     7   30 use Exporter qw(import);
  7         10  
  7         286  
413              
414 7     7   44 use Carp ();
  7         9  
  7         430  
415              
416             our $VERSION;
417              
418             BEGIN {
419 7     7   22 $VERSION = 1.21;
420 7         15356 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             # I don't have access to ISO 6093 (or BS 6727, or ANSI X.3-42)), so this is all guesswork.
479             sub _decode_real_decimal {
480 16     16   77 my ($format, $val) = @_;
481              
482 16         23 $val =~ y/,/./; # probably not in ISO-6093
483              
484 16 100       55 if ($format == 1) {
    100          
    50          
485 2 50       8 $val =~ /^ \ * [+-]? [0-9]+ \z/x
486             or Carp::croak "BER_TYPE_REAL NR1 value not in NR1 format ($val) (X.690 8.5.8)";
487             } elsif ($format == 2) {
488 8 50       30 $val =~ /^ \ * [+-]? (?: [0-9]+\.[0-9]* | [0-9]*\.[0-9]+ ) \z/x
489             or Carp::croak "BER_TYPE_REAL NR2 value not in NR2 format ($val) (X.690 8.5.8)";
490             } elsif ($format == 3) {
491 6 50       22 $val =~ /^ \ * [+-] (?: [0-9]+\.[0-9]* | [0-9]*\.[0-9]+ ) [eE] [+-]? [0-9]+ \z/x
492             or Carp::croak "BER_TYPE_REAL NR3 value not in NR3 format ($val) (X.690 8.5.8)";
493             } else {
494 0         0 Carp::croak "BER_TYPE_REAL invalid decimal numerical representation format $format";
495             }
496              
497 16         43 $val
498             }
499              
500             # this is a mess, but perl's support for floating point formatting is nearly nonexistant
501             sub _encode_real_decimal {
502 16     16   7426 my ($val, $nvdig) = @_;
503              
504 16         88 $val = sprintf "%.*G", $nvdig + 1, $val;
505              
506 16 100       41 if ($val =~ /E/) {
507 6         18 $val =~ s/E(?=[^+-])/E+/;
508 6 100       16 $val =~ s/E/.E/ if $val !~ /\./;
509 6 100       29 $val =~ s/^/+/ unless $val =~ /^-/;
510              
511 6         22 return "\x03$val" # NR3
512             }
513              
514 10 100       41 $val =~ /\./
515             ? "\x02$val" # NR2
516             : "\x01$val" # NR1
517             }
518              
519             =head2 DEBUGGING
520              
521             To aid debugging, you can call the C function to print a "nice"
522             representation to STDOUT.
523              
524             =over
525              
526             =item ber_dump $tuple[, $profile[, $prefix]]
527              
528             In addition to specifying the BER C<$tuple> to dump, you can also specify
529             a C<$profile> and a C<$prefix> string that is printed in front of each line.
530              
531             If C<$profile> is C<$Convert::BER::XS::SNMP_PROFILE>, then C
532             will try to improve its output for SNMP data.
533              
534             The output usually contains three columns, the "human readable" tag, the
535             BER type used to decode it, and the data value.
536              
537             This function is somewhat slow and uses a number of heuristics and tricks,
538             so it really is only suitable for debug prints.
539              
540             Example output:
541              
542             SEQUENCE
543             | OCTET_STRING bytes 800063784300454045045400000001
544             | OCTET_STRING bytes
545             | CONTEXT (7) CONSTRUCTED
546             | | INTEGER int 1058588941
547             | | INTEGER int 0
548             | | INTEGER int 0
549             | | SEQUENCE
550             | | | SEQUENCE
551             | | | | OID oid 1.3.6.1.2.1.1.3.0
552             | | | | TIMETICKS int 638085796
553              
554             =back
555              
556             =cut
557              
558             # reverse enum, very slow and ugly hack
559             sub _re {
560 0     0     my ($export_tag, $value) = @_;
561              
562 0           for my $symbol (@{ $EXPORT_TAGS{$export_tag} }) {
  0            
563 0 0         $value == eval $symbol
564             and return $symbol;
565             }
566              
567             "($value)"
568 0           }
569              
570             $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_COUNTER64 , BER_TYPE_INT);
571              
572             sub _ber_dump {
573 0     0     my ($ber, $profile, $indent) = @_;
574              
575 0 0         if (my $seq = ber_is_seq $ber) {
576 0           printf "%sSEQUENCE\n", $indent;
577             &_ber_dump ($_, $profile, "$indent| ")
578 0           for @$seq;
579             } else {
580 0           my $asn = $ber->[BER_CLASS] == ASN_UNIVERSAL;
581              
582 0           my $class = _re const_asn_class => $ber->[BER_CLASS];
583 0 0         my $tag = $asn ? _re const_asn_tag => $ber->[BER_TAG] : $ber->[BER_TAG];
584 0           my $type = _re const_ber_type => $profile->get ($ber->[BER_CLASS], $ber->[BER_TAG]);
585 0           my $data = $ber->[BER_DATA];
586              
587 0 0 0       if ($profile == $SNMP_PROFILE and $ber->[BER_CLASS] == ASN_APPLICATION) {
    0          
588 0           $tag = _re const_snmp => $ber->[BER_TAG];
589             } elsif (!$asn) {
590 0           $tag = "$class ($tag)";
591             }
592              
593 0           $class =~ s/^ASN_//;
594 0           $tag =~ s/^(ASN_|SNMP_)//;
595 0           $type =~ s/^BER_TYPE_//;
596              
597 0 0         if ($ber->[BER_FLAGS]) {
598 0           printf "$indent%-16.16s\n", $tag;
599             &_ber_dump ($_, $profile, "$indent| ")
600 0           for @$data;
601             } else {
602 0 0 0       if ($data =~ y/\x20-\x7e//c / (length $data || 1) > 0.2 or $data =~ /\x00./s) {
      0        
603             # assume binary
604 0           $data = unpack "H*", $data;
605             } else {
606 0           $data =~ s/[^\x20-\x7e]/./g;
607 0 0 0       $data = "\"$data\"" if $tag =~ /string/i || !length $data;
608             }
609              
610 0 0         substr $data, 40, 1e9, "..." if 40 < length $data;
611              
612 0           printf "$indent%-16.16s %-6.6s %s\n", $tag, lc $type, $data;
613             }
614             }
615             }
616              
617             sub ber_dump($;$$) {
618 0   0 0 1   _ber_dump $_[0], $_[1] || $DEFAULT_PROFILE, $_[2];
619             }
620              
621             =head1 PROFILES
622              
623             While any BER data can be correctly encoded and decoded out of the box, it
624             can be inconvenient to have to manually decode some values into a "better"
625             format: for instance, SNMP TimeTicks values are decoded into the raw octet
626             strings of their BER representation, which is quite hard to decode. With
627             profiles, you can change which class/tag combinations map to which decoder
628             function inside C (and of course also which encoder functions
629             are used in C).
630              
631             This works by mapping specific class/tag combinations to an internal "ber
632             type".
633              
634             The default profile supports the standard ASN.1 types, but no
635             application-specific ones. This means that class/tag combinations not in
636             the base set of ASN.1 are decoded into their raw octet strings.
637              
638             C defines two profile variables you can use out of the box:
639              
640             =over
641              
642             =item C<$Convert::BER::XS::DEFAULT_PROFILE>
643              
644             This is the default profile, i.e. the profile that is used when no
645             profile is specified for de-/encoding.
646              
647             You can modify it, but remember that this modifies the defaults for all
648             callers that rely on the default profile.
649              
650             =item C<$Convert::BER::XS::SNMP_PROFILE>
651              
652             A profile with mappings for SNMP-specific application tags added. This is
653             useful when de-/encoding SNMP data.
654              
655             Example:
656              
657             $ber = ber_decode $data, $Convert::BER::XS::SNMP_PROFILE;
658              
659             =back
660              
661             =head2 The Convert::BER::XS::Profile class
662              
663             =over
664              
665             =item $profile = new Convert::BER::XS::Profile
666              
667             Create a new profile. The profile will be identical to the default
668             profile.
669              
670             =item $profile->set ($class, $tag, $type)
671              
672             Sets the mapping for the given C<$class>/C<$tag> combination to C<$type>,
673             which must be one of the C constants.
674              
675             Note that currently, the mapping is stored in a flat array, so large
676             values of C<$tag> will consume large amounts of memory.
677              
678             Example:
679              
680             $profile = new Convert::BER::XS::Profile;
681             $profile->set (ASN_APPLICATION, SNMP_COUNTER32, BER_TYPE_INT);
682             $ber = ber_decode $data, $profile;
683              
684             =item $type = $profile->get ($class, $tag)
685              
686             Returns the BER type mapped to the given C<$class>/C<$tag> combination.
687              
688             =back
689              
690             =head2 BER Types
691              
692             This lists the predefined BER types. BER types are formatters used
693             internally to format and encode BER values. You can assign any C
694             to any C/C combination tgo change how that tag is decoded or
695             encoded.
696              
697             =over
698              
699             =item C
700              
701             The raw octets of the value. This is the default type for unknown tags and
702             de-/encodes the value as if it were an octet string, i.e. by copying the
703             raw bytes.
704              
705             =item C
706              
707             Like C, but decodes the value as if it were a UTF-8 string
708             (without validation!) and encodes a perl unicode string into a UTF-8 BER
709             string.
710              
711             =item C
712              
713             Similar to C, but treats the BER value as UCS-2 encoded
714             string.
715              
716             =item C
717              
718             Similar to C, but treats the BER value as UCS-4 encoded
719             string.
720              
721             =item C
722              
723             Encodes and decodes a BER integer value to a perl integer scalar. This
724             should correctly handle 64 bit signed and unsigned values.
725              
726             =item C
727              
728             Encodes and decodes an OBJECT IDENTIFIER into dotted form without leading
729             dot, e.g. C<1.3.6.1.213>.
730              
731             =item C
732              
733             Same as C but uses relative object identifier
734             encoding: ASN.1 has this hack of encoding the first two OID components
735             into a single integer in a weird attempt to save an insignificant amount
736             of space in an otherwise wasteful encoding, and relative OIDs are
737             basically OIDs without this hack. The practical difference is that the
738             second component of an OID can only have the values 1..40, while relative
739             OIDs do not have this restriction.
740              
741             =item C
742              
743             Decodes an C value into C, and always encodes a
744             C type, regardless of the perl value.
745              
746             =item C
747              
748             Decodes an C value into C<0> or C<1>, and encodes a perl
749             boolean value into an C.
750              
751             =item C
752              
753             Decodes/encodes a BER real value. NOT IMPLEMENTED.
754              
755             =item C
756              
757             Decodes/encodes a four byte string into an IPv4 dotted-quad address string
758             in Perl. Given the obsolete nature of this type, this is a low-effort
759             implementation that simply uses C and C-style conversion,
760             so it won't handle all string forms supported by C for example.
761              
762             =item C
763              
764             Always croaks when encountered during encoding or decoding - the
765             default behaviour when encountering an unknown type is to treat it as
766             C. When you don't want that but instead prefer a hard
767             error for some types, then C is for you.
768              
769             =back
770              
771             =head2 Example Profile
772              
773             The following creates a profile suitable for SNMP - it's exactly identical
774             to the C<$Convert::BER::XS::SNMP_PROFILE> profile.
775              
776             our $SNMP_PROFILE = new Convert::BER::XS::Profile;
777              
778             $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_IPADDRESS , BER_TYPE_IPADDRESS);
779             $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_COUNTER32 , BER_TYPE_INT);
780             $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_UNSIGNED32, BER_TYPE_INT);
781             $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_TIMETICKS , BER_TYPE_INT);
782             $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_OPAQUE , BER_TYPE_BYTES);
783             $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_COUNTER64 , BER_TYPE_INT);
784              
785             =head2 LIMITATIONS/NOTES
786              
787             This module can only en-/decode 64 bit signed and unsigned
788             integers/tags/lengths, and only when your perl supports those. So no UUID
789             OIDs for now (unless you map the C tag to something
790             other than C).
791              
792             This module does not generally care about ranges, i.e. it will happily
793             de-/encode 64 bit integers into an C value, or a negative
794             number into an C.
795              
796             OBJECT IDENTIFIEERs cannot have unlimited length, although the limit is
797             much larger than e.g. the one imposed by SNMP or other protocols, and is
798             about 4kB.
799              
800             Constructed strings are decoded just fine, but there should be a way to
801             join them for convenience.
802              
803             REAL values will always be encoded in decimal form and ssometimes is
804             forced into a perl "NV" type, potentially losing precision.
805              
806             =head2 ITHREADS SUPPORT
807              
808             This module is unlikely to work in any other than the loading thread when
809             the (officially discouraged) ithreads are in use.
810              
811             =head1 AUTHOR
812              
813             Marc Lehmann
814             http://software.schmorp.de/pkg/Convert-BER-XS
815              
816             =cut
817              
818             1;
819