ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Convert-BER-XS/XS.pm
Revision: 1.60
Committed: Thu Feb 6 11:51:40 2020 UTC (4 years, 3 months ago) by root
Branch: MAIN
Changes since 1.59: +1 -1 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.7 WARNING: Before release 1.0, the API is not considered stable in any way.
75    
76 root 1.4 This module implements a I<very> low level BER/DER en-/decoder.
77 root 1.1
78 root 1.20 It is tuned for low memory and high speed, while still maintaining some
79 root 1.1 level of user-friendlyness.
80    
81 root 1.19 =head2 EXPORT TAGS AND CONSTANTS
82    
83     By default this module doesn't export any symbols, but if you don't want
84 root 1.23 to break your keyboard, editor or eyesight with extremely long names, I
85 root 1.19 recommend importing the C<:all> tag. Still, you can selectively import
86 root 1.21 things.
87 root 1.19
88     =over
89    
90 root 1.21 =item C<:all>
91 root 1.19
92 root 1.23 All of the below. Really. Recommended for at least first steps, or if you
93 root 1.19 don't care about a few kilobytes of wasted memory (and namespace).
94    
95 root 1.21 =item C<:const>
96 root 1.19
97 root 1.23 All of the strictly ASN.1-related constants defined by this module, the
98 root 1.19 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 root 1.22 =item C<:const_index>
105 root 1.19
106     The BER tuple array index constants:
107    
108 root 1.28 BER_CLASS BER_TAG BER_FLAGS BER_DATA
109 root 1.19
110     =item C<:const_asn>
111    
112 root 1.23 ASN class values (these are C<0>, C<1>, C<2> and C<3>, respectively -
113 root 1.52 exactly the two topmost bits from the identifier octet shifted 6 bits to
114 root 1.19 the right):
115    
116     ASN_UNIVERSAL ASN_APPLICATION ASN_CONTEXT ASN_PRIVATE
117    
118     ASN tag values (some of which are aliases, such as C<ASN_OID>). Their
119     numerical value corresponds exactly to the numbers used in BER/X.690.
120    
121 root 1.36 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 root 1.19 ASN_EMBEDDED_PDV ASN_UTF8_STRING ASN_RELATIVE_OID ASN_SET ASN_NUMERIC_STRING
124     ASN_PRINTABLE_STRING ASN_TELETEX_STRING ASN_T61_STRING ASN_VIDEOTEX_STRING ASN_IA5_STRING
125     ASN_ASCII_STRING ASN_UTC_TIME ASN_GENERALIZED_TIME ASN_GRAPHIC_STRING ASN_VISIBLE_STRING
126     ASN_ISO646_STRING ASN_GENERAL_STRING ASN_UNIVERSAL_STRING ASN_CHARACTER_STRING ASN_BMP_STRING
127    
128     =item C<:const_ber_type>
129    
130     The BER type constants, explained in the PROFILES section.
131    
132     BER_TYPE_BYTES BER_TYPE_UTF8 BER_TYPE_UCS2 BER_TYPE_UCS4 BER_TYPE_INT
133     BER_TYPE_OID BER_TYPE_RELOID BER_TYPE_NULL BER_TYPE_BOOL BER_TYPE_REAL
134     BER_TYPE_IPADDRESS BER_TYPE_CROAK
135    
136     =item C<:const_snmp>
137    
138     Constants only relevant to SNMP. These are the tag values used by SNMP in
139     the C<ASN_APPLICATION> namespace and have the exact numerical value as in
140     BER/RFC 2578.
141    
142 root 1.33 SNMP_IPADDRESS SNMP_COUNTER32 SNMP_UNSIGNED32 SNMP_GAUGE32
143     SNMP_TIMETICKS SNMP_OPAQUE SNMP_COUNTER64
144 root 1.19
145     =item C<:decode>
146    
147     C<ber_decode> and the match helper functions:
148    
149 root 1.34 ber_decode ber-decode_prefix
150     ber_is ber_is_seq ber_is_int ber_is_oid
151 root 1.36 ber_dump
152 root 1.19
153     =item C<:encode>
154    
155     C<ber_encode> and the construction helper functions:
156    
157 root 1.34 ber_encode
158     ber_int
159 root 1.19
160     =back
161    
162 root 1.4 =head2 ASN.1/BER/DER/... BASICS
163    
164 root 1.15 ASN.1 is a strange language that can be used to describe protocols and
165 root 1.4 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 root 1.27 of this module, and is used in SNMP, LDAP or X.509 for example.
168 root 1.4
169     While ASN.1 defines a schema that is useful to interpret encoded data,
170 root 1.12 the BER encoding is actually somewhat self-describing: you might not know
171 root 1.4 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 root 1.15 and also have a flag that says whether a value consists of subvalues (is
177 root 1.4 "constructed") or not (is "primitive").
178    
179 root 1.25 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 root 1.23 string types, but there is no Unsigned32 type for example. Different
182 root 1.4 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 root 1.28 [CLASS, TAG, FLAGS, DATA]
195 root 1.4
196 root 1.23 For example:
197    
198 root 1.25 [ASN_UNIVERSAL, ASN_INTEGER, 0, 177] # the integer 177
199 root 1.23 [ASN_UNIVERSAL, ASN_OCTET_STRING, 0, "john"] # the string "john"
200     [ASN_UNIVERSAL, ASN_OID, 0, "1.3.6.133"] # some OID
201 root 1.24 [ASN_UNIVERSAL, ASN_SEQUENCE, 1, [ [ASN_UNIVERSAL... # a sequence
202 root 1.23
203 root 1.6 To avoid non-descriptive hardcoded array index numbers, this module
204     defines symbolic constants to access these members: C<BER_CLASS>,
205 root 1.28 C<BER_TAG>, C<BER_FLAGS> and C<BER_DATA>.
206 root 1.6
207     Also, the first three members are integers with a little caveat: for
208     performance reasons, these are readonly and shared, so you must not modify
209     them (increment, assign to them etc.) in any way. You may modify the
210     I<DATA> member, and you may re-assign the array itself, e.g.:
211    
212     $ber = ber_decode $binbuf;
213    
214     # the following is NOT legal:
215 root 1.28 $ber->[BER_CLASS] = ASN_PRIVATE; # ERROR, CLASS/TAG/FLAGS are READ ONLY(!)
216 root 1.6
217     # but all of the following are fine:
218     $ber->[BER_DATA] = "string";
219 root 1.25 $ber->[BER_DATA] = [ASN_UNIVERSAL, ASN_INTEGER, 0, 123];
220 root 1.11 @$ber = (ASN_APPLICATION, SNMP_TIMETICKS, 0, 1000);
221 root 1.6
222 root 1.4 I<CLASS> is something like a namespace for I<TAG>s - there is the
223     C<ASN_UNIVERSAL> namespace which defines tags common to all ASN.1
224     implementations, the C<ASN_APPLICATION> namespace which defines tags for
225     specific applications (for example, the SNMP C<Unsigned32> type is in this
226     namespace), a special-purpose context namespace (C<ASN_CONTEXT>, used e.g.
227     for C<CHOICE>) and a private namespace (C<ASN_PRIVATE>).
228    
229     The meaning of the I<TAG> depends on the namespace, and defines a
230 root 1.24 (partial) interpretation of the data value. For example, SNMP defines
231     extra tags in the C<ASN_APPLICATION> namespace, and to take full advantage
232     of these, you need to tell this module how to handle those via profiles.
233 root 1.4
234     The most common tags in the C<ASN_UNIVERSAL> namespace are
235 root 1.25 C<ASN_INTEGER>, C<ASN_BIT_STRING>, C<ASN_NULL>, C<ASN_OCTET_STRING>,
236 root 1.4 C<ASN_OBJECT_IDENTIFIER>, C<ASN_SEQUENCE>, C<ASN_SET> and
237     C<ASN_IA5_STRING>.
238    
239 root 1.24 The most common tags in SNMP's C<ASN_APPLICATION> namespace are
240     C<SNMP_COUNTER32>, C<SNMP_UNSIGNED32>, C<SNMP_TIMETICKS> and
241     C<SNMP_COUNTER64>.
242 root 1.4
243 root 1.28 The I<FLAGS> value is really just a boolean at this time (but might
244     get extended) - if it is C<0>, the value is "primitive" and contains
245     no subvalues, kind of like a non-reference perl scalar. If it is C<1>,
246     then the value is "constructed" which just means it contains a list of
247     subvalues which this module will en-/decode as BER tuples themselves.
248    
249     The I<DATA> value is either a reference to an array of further tuples
250     (if the value is I<FLAGS>), some decoded representation of the value, if
251     this module knows how to decode it (e.g. for the integer types above) or
252     a binary string with the raw octets if this module doesn't know how to
253 root 1.4 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 root 1.7 =head2 DECODING AND ENCODING
261    
262     =over
263    
264 root 1.34 =item $tuple = ber_decode $bindata[, $profile]
265 root 1.7
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 root 1.24 How tags are interpreted is defined by the second argument, which must
271     be a C<Convert::BER::XS::Profile> object. If it is missing, the default
272     profile will be used (C<$Convert::BER::XS::DEFAULT_PROFILE>).
273    
274     In addition to rolling your own, this module provides a
275     C<$Convert::BER::XS::SNMP_PROFILE> that knows about the additional SNMP
276     types.
277 root 1.7
278 root 1.25 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 root 1.34 =item ($tuple, $bytes) = ber_decode_prefix $bindata[, $profile]
288    
289     Works like C<ber_decode>, except it doesn't croak when there is data after
290     the BER data, but instead returns the decoded value and the number of
291     bytes it decoded.
292    
293     This is useful when you have BER data at the start of a buffer and other
294     data after, and you need to find the length.
295    
296     Also, since BER is self-delimited, this can be used to decode multiple BER
297     values joined together.
298    
299 root 1.24 =item $bindata = ber_encode $tuple[, $profile]
300    
301 root 1.52 Encodes the BER tuple into a BER/DER data structure. As with
302 root 1.24 Cyber_decode>, an optional profile can be given.
303 root 1.7
304 root 1.28 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 root 1.7 =back
308    
309 root 1.6 =head2 HELPER FUNCTIONS
310    
311     Working with a 4-tuple for every value can be annoying. Or, rather, I<is>
312     annoying. To reduce this a bit, this module defines a number of helper
313 root 1.24 functions, both to match BER tuples and to construct BER tuples:
314 root 1.6
315     =head3 MATCH HELPERS
316    
317 root 1.24 These functions accept a BER tuple as first argument and either partially
318 root 1.6 or fully match it. They often come in two forms, one which exactly matches
319     a value, and one which only matches the type and returns the value.
320    
321     They do check whether valid tuples are passed in and croak otherwise. As
322     a ease-of-use exception, they usually also accept C<undef> instead of a
323 root 1.24 tuple reference, in which case they silently fail to match.
324 root 1.6
325     =over
326    
327 root 1.29 =item $bool = ber_is $tuple, $class, $tag, $flags, $data
328 root 1.6
329 root 1.24 This takes a BER C<$tuple> and matches its elements against the provided
330 root 1.6 values, all of which are optional - values that are either missing or
331     C<undef> will be ignored, the others will be matched exactly (e.g. as if
332     you used C<==> or C<eq> (for C<$data>)).
333    
334     Some examples:
335    
336     ber_is $tuple, ASN_UNIVERSAL, ASN_SEQUENCE, 1
337     orf die "tuple is not an ASN SEQUENCE";
338    
339     ber_is $tuple, ASN_UNIVERSAL, ASN_NULL
340     or die "tuple is not an ASN NULL value";
341    
342 root 1.25 ber_is $tuple, ASN_UNIVERSAL, ASN_INTEGER, 0, 50
343 root 1.6 or die "BER integer must be 50";
344    
345     =item $seq = ber_is_seq $tuple
346    
347     Returns the sequence members (the array of subvalues) if the C<$tuple> is
348     an ASN SEQUENCE, i.e. the C<BER_DATA> member. If the C<$tuple> is not a
349     sequence it returns C<undef>. For example, SNMP version 1/2c/3 packets all
350     consist of an outer SEQUENCE value:
351    
352     my $ber = ber_decode $snmp_data;
353    
354     my $snmp = ber_is_seq $ber
355     or die "SNMP packet invalid: does not start with SEQUENCE";
356    
357     # now we know $snmp is a sequence, so decode the SNMP version
358    
359 root 1.25 my $version = ber_is_int $snmp->[0]
360 root 1.6 or die "SNMP packet invalid: does not start with version number";
361    
362 root 1.25 =item $bool = ber_is_int $tuple, $int
363 root 1.6
364 root 1.25 Returns a true value if the C<$tuple> represents an ASN INTEGER with
365     the value C<$int>.
366 root 1.6
367 root 1.25 =item $int = ber_is_int $tuple
368 root 1.6
369 root 1.25 Returns true (and extracts the integer value) if the C<$tuple> is an
370     C<ASN_INTEGER>. For C<0>, this function returns a special value that is 0
371     but true.
372 root 1.6
373     =item $bool = ber_is_oid $tuple, $oid_string
374    
375     Returns true if the C<$tuple> represents an ASN_OBJECT_IDENTIFIER
376 root 1.12 that exactly matches C<$oid_string>. Example:
377 root 1.6
378     ber_is_oid $tuple, "1.3.6.1.4"
379     or die "oid must be 1.3.6.1.4";
380    
381     =item $oid = ber_is_oid $tuple
382    
383     Returns true (and extracts the OID string) if the C<$tuple> is an ASN
384     OBJECT IDENTIFIER. Otherwise, it returns C<undef>.
385    
386     =back
387    
388     =head3 CONSTRUCTION HELPERS
389    
390     =over
391    
392 root 1.25 =item $tuple = ber_int $value
393 root 1.6
394 root 1.25 Constructs a new C<ASN_INTEGER> tuple.
395 root 1.6
396     =back
397    
398 root 1.2 =head2 RELATIONSHIP TO L<Convert::BER> and L<Convert::ASN1>
399    
400     This module is I<not> the XS version of L<Convert::BER>, but a different
401     take at doing the same thing. I imagine this module would be a good base
402 root 1.4 for speeding up either of these, or write a similar module, or write your
403 root 1.2 own LDAP or SNMP module for example.
404    
405 root 1.1 =cut
406    
407     package Convert::BER::XS;
408    
409     use common::sense;
410    
411     use XSLoader ();
412     use Exporter qw(import);
413    
414 root 1.57 use Carp ();
415    
416 root 1.13 our $VERSION;
417 root 1.1
418 root 1.13 BEGIN {
419 root 1.60 $VERSION = 1.21;
420 root 1.13 XSLoader::load __PACKAGE__, $VERSION;
421     }
422 root 1.1
423     our %EXPORT_TAGS = (
424 root 1.19 const_index => [qw(
425 root 1.28 BER_CLASS BER_TAG BER_FLAGS BER_DATA
426 root 1.19 )],
427 root 1.36 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 root 1.13 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 root 1.19 )],
438     const_ber_type => [qw(
439 root 1.13 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 root 1.33 SNMP_IPADDRESS SNMP_COUNTER32 SNMP_GAUGE32 SNMP_UNSIGNED32
445     SNMP_TIMETICKS SNMP_OPAQUE SNMP_COUNTER64
446 root 1.4 )],
447 root 1.19 decode => [qw(
448 root 1.34 ber_decode ber_decode_prefix
449 root 1.25 ber_is ber_is_seq ber_is_int ber_is_oid
450 root 1.36 ber_dump
451 root 1.4 )],
452 root 1.19 encode => [qw(
453 root 1.4 ber_encode
454 root 1.25 ber_int
455 root 1.1 )],
456     );
457    
458     our @EXPORT_OK = map @$_, values %EXPORT_TAGS;
459    
460 root 1.36 $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 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     $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_COUNTER64 , BER_TYPE_INT);
571    
572     sub _ber_dump {
573     my ($ber, $profile, $indent) = @_;
574    
575     if (my $seq = ber_is_seq $ber) {
576     printf "%sSEQUENCE\n", $indent;
577     &_ber_dump ($_, $profile, "$indent| ")
578     for @$seq;
579     } else {
580     my $asn = $ber->[BER_CLASS] == ASN_UNIVERSAL;
581    
582     my $class = _re const_asn_class => $ber->[BER_CLASS];
583     my $tag = $asn ? _re const_asn_tag => $ber->[BER_TAG] : $ber->[BER_TAG];
584     my $type = _re const_ber_type => $profile->get ($ber->[BER_CLASS], $ber->[BER_TAG]);
585     my $data = $ber->[BER_DATA];
586    
587     if ($profile == $SNMP_PROFILE and $ber->[BER_CLASS] == ASN_APPLICATION) {
588     $tag = _re const_snmp => $ber->[BER_TAG];
589 root 1.38 } elsif (!$asn) {
590     $tag = "$class ($tag)";
591 root 1.36 }
592    
593     $class =~ s/^ASN_//;
594     $tag =~ s/^(ASN_|SNMP_)//;
595     $type =~ s/^BER_TYPE_//;
596    
597     if ($ber->[BER_FLAGS]) {
598 root 1.50 printf "$indent%-16.16s\n", $tag;
599 root 1.36 &_ber_dump ($_, $profile, "$indent| ")
600     for @$data;
601     } else {
602 root 1.40 if ($data =~ y/\x20-\x7e//c / (length $data || 1) > 0.2 or $data =~ /\x00./s) {
603 root 1.36 # assume binary
604     $data = unpack "H*", $data;
605     } else {
606     $data =~ s/[^\x20-\x7e]/./g;
607 root 1.51 $data = "\"$data\"" if $tag =~ /string/i || !length $data;
608 root 1.36 }
609    
610 root 1.41 substr $data, 40, 1e9, "..." if 40 < length $data;
611    
612 root 1.36 printf "$indent%-16.16s %-6.6s %s\n", $tag, lc $type, $data;
613     }
614     }
615     }
616    
617     sub ber_dump($;$$) {
618     _ber_dump $_[0], $_[1] || $DEFAULT_PROFILE, $_[2];
619     }
620 root 1.4
621 root 1.13 =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<ber_decode> (and of course also which encoder functions
629     are used in C<ber_encode>).
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 root 1.15 C<Convert::BER::XS> defines two profile variables you can use out of the box:
639 root 1.13
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 root 1.15 You can modify it, but remember that this modifies the defaults for all
648     callers that rely on the default profile.
649 root 1.13
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 root 1.15
657 root 1.13 $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<BER_TYPE_*> 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 root 1.15
680 root 1.13 $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 root 1.44 =head2 BER Types
691 root 1.13
692 root 1.44 This lists the predefined BER types. BER types are formatters used
693     internally to format and encode BER values. You can assign any C<BER_TYPE>
694     to any C<CLASS>/C<TAG> combination tgo change how that tag is decoded or
695     encoded.
696 root 1.13
697     =over
698    
699     =item C<BER_TYPE_BYTES>
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<BER_TYPE_UTF8>
706    
707     Like C<BER_TYPE_BYTES>, 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<BER_TYPE_UCS2>
712    
713     Similar to C<BER_TYPE_UTF8>, but treats the BER value as UCS-2 encoded
714 root 1.14 string.
715 root 1.13
716     =item C<BER_TYPE_UCS4>
717    
718     Similar to C<BER_TYPE_UTF8>, but treats the BER value as UCS-4 encoded
719 root 1.14 string.
720 root 1.13
721     =item C<BER_TYPE_INT>
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<BER_TYPE_OID>
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<BER_TYPE_RELOID>
732    
733 root 1.15 Same as C<BER_TYPE_OID> 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 root 1.13
741     =item C<BER_TYPE_NULL>
742    
743     Decodes an C<ASN_NULL> value into C<undef>, and always encodes a
744     C<ASN_NULL> type, regardless of the perl value.
745    
746     =item C<BER_TYPE_BOOL>
747    
748     Decodes an C<ASN_BOOLEAN> value into C<0> or C<1>, and encodes a perl
749     boolean value into an C<ASN_BOOLEAN>.
750    
751     =item C<BER_TYPE_REAL>
752    
753     Decodes/encodes a BER real value. NOT IMPLEMENTED.
754    
755     =item C<BER_TYPE_IPADDRESS>
756    
757 root 1.15 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 root 1.13 implementation that simply uses C<sprintf> and C<sscanf>-style conversion,
760 root 1.15 so it won't handle all string forms supported by C<inet_aton> for example.
761 root 1.13
762     =item C<BER_TYPE_CROAK>
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<BER_TYPE_BYTES>. When you don't want that but instead prefer a hard
767 root 1.16 error for some types, then C<BER_TYPE_CROAK> is for you.
768 root 1.13
769     =back
770    
771 root 1.30 =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 root 1.54 $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_OPAQUE , BER_TYPE_BYTES);
783 root 1.30 $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_COUNTER64 , BER_TYPE_INT);
784    
785 root 1.19 =head2 LIMITATIONS/NOTES
786 root 1.13
787 root 1.56 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<OBJECT IDENTIFIER> tag to something
790     other than C<BER_TYPE_OID>).
791 root 1.4
792 root 1.19 This module does not generally care about ranges, i.e. it will happily
793 root 1.55 de-/encode 64 bit integers into an C<SNMP_UNSIGNED32> value, or a negative
794 root 1.19 number into an C<SNMP_COUNTER64>.
795    
796 root 1.16 OBJECT IDENTIFIEERs cannot have unlimited length, although the limit is
797 root 1.45 much larger than e.g. the one imposed by SNMP or other protocols, and is
798 root 1.19 about 4kB.
799 root 1.4
800 root 1.28 Constructed strings are decoded just fine, but there should be a way to
801     join them for convenience.
802    
803 root 1.57 REAL values will always be encoded in decimal form and ssometimes is
804     forced into a perl "NV" type, potentially losing precision.
805 root 1.14
806 root 1.17 =head2 ITHREADS SUPPORT
807    
808 root 1.56 This module is unlikely to work in any other than the loading thread when
809     the (officially discouraged) ithreads are in use.
810 root 1.17
811 root 1.1 =head1 AUTHOR
812    
813     Marc Lehmann <schmorp@schmorp.de>
814     http://software.schmorp.de/pkg/Convert-BER-XS
815    
816     =cut
817    
818 root 1.36 1;
819