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

# User Rev Content
1 root 1.1 =head1 NAME
2    
3 root 1.4 Convert::BER::XS - I<very> low level BER en-/decoding
4 root 1.1
5     =head1 SYNOPSIS
6    
7     use Convert::BER::XS ':all';
8    
9 root 1.20 my $ber = ber_decode $buf, $Convert::BER::XS::SNMP_PROFILE
10 root 1.6 or die "unable to decode SNMP message";
11 root 1.1
12 root 1.13 # The above results in a data structure consisting of
13 root 1.46 # (class, tag, flags, data)
14 root 1.13 # tuples. Below is such a message, SNMPv1 trap
15 root 1.6 # with a Cisco mac change notification.
16 root 1.13 # Did you know that Cisco is in the news almost
17 root 1.20 # every week because of some backdoor password
18 root 1.13 # or other extremely stupid security bug?
19 root 1.3
20     [ ASN_UNIVERSAL, ASN_SEQUENCE, 1,
21     [
22 root 1.25 [ ASN_UNIVERSAL, ASN_INTEGER, 0, 0 ], # snmp version 1
23 root 1.3 [ ASN_UNIVERSAL, 4, 0, "public" ], # community
24 root 1.6 [ ASN_CONTEXT, 4, 1, # CHOICE, constructed - trap PDU
25 root 1.3 [
26     [ ASN_UNIVERSAL, ASN_OBJECT_IDENTIFIER, 0, "1.3.6.1.4.1.9.9.215.2" ], # enterprise oid
27 root 1.20 [ ASN_APPLICATION, SNMP_IPADDRESS, 0, "10.0.0.1" ], # SNMP IpAddress
28 root 1.25 [ ASN_UNIVERSAL, ASN_INTEGER, 0, 6 ], # generic trap
29     [ ASN_UNIVERSAL, ASN_INTEGER, 0, 1 ], # specific trap
30 root 1.20 [ ASN_APPLICATION, SNMP_TIMETICKS, 0, 1817903850 ], # SNMP TimeTicks
31 root 1.3 [ ASN_UNIVERSAL, ASN_SEQUENCE, 1, # the varbindlist
32     [
33     [ ASN_UNIVERSAL, ASN_SEQUENCE, 1, # a single varbind, "key value" pair
34     [
35 root 1.8 [ ASN_UNIVERSAL, ASN_OBJECT_IDENTIFIER, 0, "1.3.6.1.4.1.9.9.215.1.1.8.1.2.1" ],
36 root 1.3 [ ASN_UNIVERSAL, ASN_OCTET_STRING, 0, "...data..." # the value
37     ]
38     ]
39     ],
40     ...
41 root 1.36 # let's dump it, for debugging
42    
43     ber_dump $ber, $Convert::BER::XS::SNMP_PROFILE;
44 root 1.3
45     # let's decode it a bit with some helper functions
46    
47 root 1.1 my $msg = ber_is_seq $ber
48     or die "SNMP message does not start with a sequence";
49    
50 root 1.25 ber_is $msg->[0], ASN_UNIVERSAL, ASN_INTEGER, 0
51 root 1.1 or die "SNMP message does not start with snmp version\n";
52    
53 root 1.3 # message is SNMP v1 or v2c?
54 root 1.1 if ($msg->[0][BER_DATA] == 0 || $msg->[0][BER_DATA] == 1) {
55    
56 root 1.3 # message is v1 trap?
57 root 1.1 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 root 1.25 and (ber_is_int $trap->[2], 6)
64     and (ber_is_int $trap->[3], 1) # mac changed msg
65 root 1.1 ) {
66     ... and so on
67    
68 root 1.4 # finally, let's encode it again and hope it results in the same bit pattern
69    
70 root 1.20 my $buf = ber_encode $ber, $Convert::BER::XS::SNMP_PROFILE;
71 root 1.4
72 root 1.1 =head1 DESCRIPTION
73    
74 root 1.4 This module implements a I<very> low level BER/DER en-/decoder.
75 root 1.1
76 root 1.20 It is tuned for low memory and high speed, while still maintaining some
77 root 1.1 level of user-friendlyness.
78    
79 root 1.19 =head2 EXPORT TAGS AND CONSTANTS
80    
81     By default this module doesn't export any symbols, but if you don't want
82 root 1.23 to break your keyboard, editor or eyesight with extremely long names, I
83 root 1.19 recommend importing the C<:all> tag. Still, you can selectively import
84 root 1.21 things.
85 root 1.19
86     =over
87    
88 root 1.21 =item C<:all>
89 root 1.19
90 root 1.23 All of the below. Really. Recommended for at least first steps, or if you
91 root 1.19 don't care about a few kilobytes of wasted memory (and namespace).
92    
93 root 1.21 =item C<:const>
94 root 1.19
95 root 1.23 All of the strictly ASN.1-related constants defined by this module, the
96 root 1.19 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 root 1.22 =item C<:const_index>
103 root 1.19
104     The BER tuple array index constants:
105    
106 root 1.28 BER_CLASS BER_TAG BER_FLAGS BER_DATA
107 root 1.19
108     =item C<:const_asn>
109    
110 root 1.23 ASN class values (these are C<0>, C<1>, C<2> and C<3>, respectively -
111 root 1.52 exactly the two topmost bits from the identifier octet shifted 6 bits to
112 root 1.19 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 root 1.36 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 root 1.19 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 root 1.33 SNMP_IPADDRESS SNMP_COUNTER32 SNMP_UNSIGNED32 SNMP_GAUGE32
141     SNMP_TIMETICKS SNMP_OPAQUE SNMP_COUNTER64
142 root 1.19
143     =item C<:decode>
144    
145     C<ber_decode> and the match helper functions:
146    
147 root 1.34 ber_decode ber-decode_prefix
148     ber_is ber_is_seq ber_is_int ber_is_oid
149 root 1.36 ber_dump
150 root 1.19
151     =item C<:encode>
152    
153     C<ber_encode> and the construction helper functions:
154    
155 root 1.34 ber_encode
156     ber_int
157 root 1.19
158     =back
159    
160 root 1.4 =head2 ASN.1/BER/DER/... BASICS
161    
162 root 1.15 ASN.1 is a strange language that can be used to describe protocols and
163 root 1.4 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 root 1.27 of this module, and is used in SNMP, LDAP or X.509 for example.
166 root 1.4
167     While ASN.1 defines a schema that is useful to interpret encoded data,
168 root 1.12 the BER encoding is actually somewhat self-describing: you might not know
169 root 1.4 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 root 1.15 and also have a flag that says whether a value consists of subvalues (is
175 root 1.4 "constructed") or not (is "primitive").
176    
177 root 1.25 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 root 1.23 string types, but there is no Unsigned32 type for example. Different
180 root 1.4 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 root 1.28 [CLASS, TAG, FLAGS, DATA]
193 root 1.4
194 root 1.23 For example:
195    
196 root 1.25 [ASN_UNIVERSAL, ASN_INTEGER, 0, 177] # the integer 177
197 root 1.23 [ASN_UNIVERSAL, ASN_OCTET_STRING, 0, "john"] # the string "john"
198     [ASN_UNIVERSAL, ASN_OID, 0, "1.3.6.133"] # some OID
199 root 1.24 [ASN_UNIVERSAL, ASN_SEQUENCE, 1, [ [ASN_UNIVERSAL... # a sequence
200 root 1.23
201 root 1.6 To avoid non-descriptive hardcoded array index numbers, this module
202     defines symbolic constants to access these members: C<BER_CLASS>,
203 root 1.28 C<BER_TAG>, C<BER_FLAGS> and C<BER_DATA>.
204 root 1.6
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 root 1.28 $ber->[BER_CLASS] = ASN_PRIVATE; # ERROR, CLASS/TAG/FLAGS are READ ONLY(!)
214 root 1.6
215     # but all of the following are fine:
216     $ber->[BER_DATA] = "string";
217 root 1.25 $ber->[BER_DATA] = [ASN_UNIVERSAL, ASN_INTEGER, 0, 123];
218 root 1.11 @$ber = (ASN_APPLICATION, SNMP_TIMETICKS, 0, 1000);
219 root 1.6
220 root 1.4 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 root 1.24 (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 root 1.4
232     The most common tags in the C<ASN_UNIVERSAL> namespace are
233 root 1.25 C<ASN_INTEGER>, C<ASN_BIT_STRING>, C<ASN_NULL>, C<ASN_OCTET_STRING>,
234 root 1.4 C<ASN_OBJECT_IDENTIFIER>, C<ASN_SEQUENCE>, C<ASN_SET> and
235     C<ASN_IA5_STRING>.
236    
237 root 1.24 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 root 1.4
241 root 1.28 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 root 1.4 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 root 1.7 =head2 DECODING AND ENCODING
259    
260     =over
261    
262 root 1.34 =item $tuple = ber_decode $bindata[, $profile]
263 root 1.7
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 root 1.24 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 root 1.7
276 root 1.25 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 root 1.34 =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 root 1.24 =item $bindata = ber_encode $tuple[, $profile]
298    
299 root 1.52 Encodes the BER tuple into a BER/DER data structure. As with
300 root 1.24 Cyber_decode>, an optional profile can be given.
301 root 1.7
302 root 1.28 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 root 1.7 =back
306    
307 root 1.6 =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 root 1.24 functions, both to match BER tuples and to construct BER tuples:
312 root 1.6
313     =head3 MATCH HELPERS
314    
315 root 1.24 These functions accept a BER tuple as first argument and either partially
316 root 1.6 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 root 1.24 tuple reference, in which case they silently fail to match.
322 root 1.6
323     =over
324    
325 root 1.29 =item $bool = ber_is $tuple, $class, $tag, $flags, $data
326 root 1.6
327 root 1.24 This takes a BER C<$tuple> and matches its elements against the provided
328 root 1.6 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 root 1.25 ber_is $tuple, ASN_UNIVERSAL, ASN_INTEGER, 0, 50
341 root 1.6 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 root 1.25 my $version = ber_is_int $snmp->[0]
358 root 1.6 or die "SNMP packet invalid: does not start with version number";
359    
360 root 1.25 =item $bool = ber_is_int $tuple, $int
361 root 1.6
362 root 1.25 Returns a true value if the C<$tuple> represents an ASN INTEGER with
363     the value C<$int>.
364 root 1.6
365 root 1.25 =item $int = ber_is_int $tuple
366 root 1.6
367 root 1.25 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 root 1.6
371     =item $bool = ber_is_oid $tuple, $oid_string
372    
373     Returns true if the C<$tuple> represents an ASN_OBJECT_IDENTIFIER
374 root 1.12 that exactly matches C<$oid_string>. Example:
375 root 1.6
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 root 1.25 =item $tuple = ber_int $value
391 root 1.6
392 root 1.25 Constructs a new C<ASN_INTEGER> tuple.
393 root 1.6
394     =back
395    
396 root 1.2 =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 root 1.4 for speeding up either of these, or write a similar module, or write your
401 root 1.2 own LDAP or SNMP module for example.
402    
403 root 1.1 =cut
404    
405     package Convert::BER::XS;
406    
407     use common::sense;
408    
409     use XSLoader ();
410     use Exporter qw(import);
411    
412 root 1.57 use Carp ();
413    
414 root 1.13 our $VERSION;
415 root 1.1
416 root 1.13 BEGIN {
417 root 1.60 $VERSION = 1.21;
418 root 1.13 XSLoader::load __PACKAGE__, $VERSION;
419     }
420 root 1.1
421     our %EXPORT_TAGS = (
422 root 1.19 const_index => [qw(
423 root 1.28 BER_CLASS BER_TAG BER_FLAGS BER_DATA
424 root 1.19 )],
425 root 1.36 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 root 1.13 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 root 1.19 )],
436     const_ber_type => [qw(
437 root 1.13 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 root 1.33 SNMP_IPADDRESS SNMP_COUNTER32 SNMP_GAUGE32 SNMP_UNSIGNED32
443     SNMP_TIMETICKS SNMP_OPAQUE SNMP_COUNTER64
444 root 1.4 )],
445 root 1.19 decode => [qw(
446 root 1.34 ber_decode ber_decode_prefix
447 root 1.25 ber_is ber_is_seq ber_is_int ber_is_oid
448 root 1.36 ber_dump
449 root 1.4 )],
450 root 1.19 encode => [qw(
451 root 1.4 ber_encode
452 root 1.25 ber_int
453 root 1.1 )],
454     );
455    
456     our @EXPORT_OK = map @$_, values %EXPORT_TAGS;
457    
458 root 1.36 $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 root 1.57 # decodes REAL values according to ECMA-63
475     # this is pretty strict, except it doesn't catch -0.
476 root 1.58 # I don't have access to ISO 6093 (or BS 6727, or ANSI X.3-42)), so this is all guesswork.
477 root 1.57 sub _decode_real_decimal {
478     my ($format, $val) = @_;
479    
480 root 1.58 $val =~ y/,/./; # probably not in ISO-6093
481 root 1.57
482     if ($format == 1) {
483     $val =~ /^ \ * [+-]? [0-9]+ \z/x
484 root 1.58 or Carp::croak "BER_TYPE_REAL NR1 value not in NR1 format ($val) (X.690 8.5.8)";
485 root 1.57 } elsif ($format == 2) {
486     $val =~ /^ \ * [+-]? (?: [0-9]+\.[0-9]* | [0-9]*\.[0-9]+ ) \z/x
487 root 1.58 or Carp::croak "BER_TYPE_REAL NR2 value not in NR2 format ($val) (X.690 8.5.8)";
488 root 1.57 } elsif ($format == 3) {
489 root 1.58 $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 root 1.57 } else {
492 root 1.59 Carp::croak "BER_TYPE_REAL invalid decimal numerical representation format $format";
493 root 1.57 }
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 root 1.36 =head2 DEBUGGING
518    
519 root 1.57 To aid debugging, you can call the C<ber_dump> function to print a "nice"
520 root 1.36 representation to STDOUT.
521    
522     =over
523    
524 root 1.37 =item ber_dump $tuple[, $profile[, $prefix]]
525 root 1.36
526 root 1.52 In addition to specifying the BER C<$tuple> to dump, you can also specify
527 root 1.36 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 root 1.49 | CONTEXT (7) CONSTRUCTED
544 root 1.36 | | 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 root 1.42 =back
553    
554 root 1.36 =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 root 1.38 } elsif (!$asn) {
588     $tag = "$class ($tag)";
589 root 1.36 }
590    
591     $class =~ s/^ASN_//;
592     $tag =~ s/^(ASN_|SNMP_)//;
593     $type =~ s/^BER_TYPE_//;
594    
595     if ($ber->[BER_FLAGS]) {
596 root 1.50 printf "$indent%-16.16s\n", $tag;
597 root 1.36 &_ber_dump ($_, $profile, "$indent| ")
598     for @$data;
599     } else {
600 root 1.40 if ($data =~ y/\x20-\x7e//c / (length $data || 1) > 0.2 or $data =~ /\x00./s) {
601 root 1.36 # assume binary
602     $data = unpack "H*", $data;
603     } else {
604     $data =~ s/[^\x20-\x7e]/./g;
605 root 1.51 $data = "\"$data\"" if $tag =~ /string/i || !length $data;
606 root 1.36 }
607    
608 root 1.41 substr $data, 40, 1e9, "..." if 40 < length $data;
609    
610 root 1.36 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 root 1.4
619 root 1.13 =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 root 1.15 C<Convert::BER::XS> defines two profile variables you can use out of the box:
637 root 1.13
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 root 1.15 You can modify it, but remember that this modifies the defaults for all
646     callers that rely on the default profile.
647 root 1.13
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 root 1.15
655 root 1.13 $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 root 1.15
678 root 1.13 $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 root 1.44 =head2 BER Types
689 root 1.13
690 root 1.44 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 root 1.13
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 root 1.14 string.
713 root 1.13
714     =item C<BER_TYPE_UCS4>
715    
716     Similar to C<BER_TYPE_UTF8>, but treats the BER value as UCS-4 encoded
717 root 1.14 string.
718 root 1.13
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 root 1.15 Same as C<BER_TYPE_OID> but uses relative object identifier
732 root 1.61 encoding: ASN.1 uses some hack encoding of the first two OID components
733 root 1.15 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 root 1.13
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 root 1.15 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 root 1.13 implementation that simply uses C<sprintf> and C<sscanf>-style conversion,
758 root 1.15 so it won't handle all string forms supported by C<inet_aton> for example.
759 root 1.13
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 root 1.16 error for some types, then C<BER_TYPE_CROAK> is for you.
766 root 1.13
767     =back
768    
769 root 1.30 =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 root 1.54 $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_OPAQUE , BER_TYPE_BYTES);
781 root 1.30 $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_COUNTER64 , BER_TYPE_INT);
782    
783 root 1.19 =head2 LIMITATIONS/NOTES
784 root 1.13
785 root 1.56 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 root 1.4
790 root 1.19 This module does not generally care about ranges, i.e. it will happily
791 root 1.55 de-/encode 64 bit integers into an C<SNMP_UNSIGNED32> value, or a negative
792 root 1.19 number into an C<SNMP_COUNTER64>.
793    
794 root 1.16 OBJECT IDENTIFIEERs cannot have unlimited length, although the limit is
795 root 1.45 much larger than e.g. the one imposed by SNMP or other protocols, and is
796 root 1.19 about 4kB.
797 root 1.4
798 root 1.28 Constructed strings are decoded just fine, but there should be a way to
799     join them for convenience.
800    
801 root 1.57 REAL values will always be encoded in decimal form and ssometimes is
802     forced into a perl "NV" type, potentially losing precision.
803 root 1.14
804 root 1.17 =head2 ITHREADS SUPPORT
805    
806 root 1.56 This module is unlikely to work in any other than the loading thread when
807     the (officially discouraged) ithreads are in use.
808 root 1.17
809 root 1.1 =head1 AUTHOR
810    
811     Marc Lehmann <schmorp@schmorp.de>
812     http://software.schmorp.de/pkg/Convert-BER-XS
813    
814     =cut
815    
816 root 1.36 1;
817