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