ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Convert-BER-XS/XS.pm
(Generate patch)

Comparing Convert-BER-XS/XS.pm (file contents):
Revision 1.50 by root, Sun Apr 21 23:10:55 2019 UTC vs.
Revision 1.59 by root, Fri May 3 08:49:01 2019 UTC

… …
108 BER_CLASS BER_TAG BER_FLAGS BER_DATA 108 BER_CLASS BER_TAG BER_FLAGS BER_DATA
109 109
110=item C<:const_asn> 110=item C<:const_asn>
111 111
112ASN class values (these are C<0>, C<1>, C<2> and C<3>, respectively - 112ASN class values (these are C<0>, C<1>, C<2> and C<3>, respectively -
113exactly thw two topmost bits from the identifier octet shifted 6 bits to 113exactly the two topmost bits from the identifier octet shifted 6 bits to
114the right): 114the right):
115 115
116 ASN_UNIVERSAL ASN_APPLICATION ASN_CONTEXT ASN_PRIVATE 116 ASN_UNIVERSAL ASN_APPLICATION ASN_CONTEXT ASN_PRIVATE
117 117
118ASN tag values (some of which are aliases, such as C<ASN_OID>). Their 118ASN tag values (some of which are aliases, such as C<ASN_OID>). Their
… …
296Also, since BER is self-delimited, this can be used to decode multiple BER 296Also, since BER is self-delimited, this can be used to decode multiple BER
297values joined together. 297values joined together.
298 298
299=item $bindata = ber_encode $tuple[, $profile] 299=item $bindata = ber_encode $tuple[, $profile]
300 300
301Encodes the BER tuple into a BER/DER data structure. AS with 301Encodes the BER tuple into a BER/DER data structure. As with
302Cyber_decode>, an optional profile can be given. 302Cyber_decode>, an optional profile can be given.
303 303
304The encoded data should be both BER and DER ("shortest form") compliant 304The encoded data should be both BER and DER ("shortest form") compliant
305unless the input says otherwise (e.g. it uses constructed strings). 305unless the input says otherwise (e.g. it uses constructed strings).
306 306
… …
409use common::sense; 409use common::sense;
410 410
411use XSLoader (); 411use XSLoader ();
412use Exporter qw(import); 412use Exporter qw(import);
413 413
414use Carp ();
415
414our $VERSION; 416our $VERSION;
415 417
416BEGIN { 418BEGIN {
417 $VERSION = 1.1; 419 $VERSION = 1.2;
418 XSLoader::load __PACKAGE__, $VERSION; 420 XSLoader::load __PACKAGE__, $VERSION;
419} 421}
420 422
421our %EXPORT_TAGS = ( 423our %EXPORT_TAGS = (
422 const_index => [qw( 424 const_index => [qw(
… …
468 470
469$SNMP_PROFILE->set (ASN_APPLICATION, SNMP_IPADDRESS , BER_TYPE_IPADDRESS); 471$SNMP_PROFILE->set (ASN_APPLICATION, SNMP_IPADDRESS , BER_TYPE_IPADDRESS);
470$SNMP_PROFILE->set (ASN_APPLICATION, SNMP_COUNTER32 , BER_TYPE_INT); 472$SNMP_PROFILE->set (ASN_APPLICATION, SNMP_COUNTER32 , BER_TYPE_INT);
471$SNMP_PROFILE->set (ASN_APPLICATION, SNMP_UNSIGNED32, BER_TYPE_INT); 473$SNMP_PROFILE->set (ASN_APPLICATION, SNMP_UNSIGNED32, BER_TYPE_INT);
472$SNMP_PROFILE->set (ASN_APPLICATION, SNMP_TIMETICKS , BER_TYPE_INT); 474$SNMP_PROFILE->set (ASN_APPLICATION, SNMP_TIMETICKS , BER_TYPE_INT);
473$SNMP_PROFILE->set (ASN_APPLICATION, SNMP_OPAQUE , BER_TYPE_IPADDRESS); 475
476# decodes REAL values according to ECMA-63
477# this is pretty strict, except it doesn't catch -0.
478# I don't have access to ISO 6093 (or BS 6727, or ANSI X.3-42)), so this is all guesswork.
479sub _decode_real_decimal {
480 my ($format, $val) = @_;
481
482 $val =~ y/,/./; # probably not in ISO-6093
483
484 if ($format == 1) {
485 $val =~ /^ \ * [+-]? [0-9]+ \z/x
486 or Carp::croak "BER_TYPE_REAL NR1 value not in NR1 format ($val) (X.690 8.5.8)";
487 } elsif ($format == 2) {
488 $val =~ /^ \ * [+-]? (?: [0-9]+\.[0-9]* | [0-9]*\.[0-9]+ ) \z/x
489 or Carp::croak "BER_TYPE_REAL NR2 value not in NR2 format ($val) (X.690 8.5.8)";
490 } elsif ($format == 3) {
491 $val =~ /^ \ * [+-] (?: [0-9]+\.[0-9]* | [0-9]*\.[0-9]+ ) [eE] [+-]? [0-9]+ \z/x
492 or Carp::croak "BER_TYPE_REAL NR3 value not in NR3 format ($val) (X.690 8.5.8)";
493 } else {
494 Carp::croak "BER_TYPE_REAL invalid decimal numerical representation format $format";
495 }
496
497 $val
498}
499
500# this is a mess, but perl's support for floating point formatting is nearly nonexistant
501sub _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}
474 518
475=head2 DEBUGGING 519=head2 DEBUGGING
476 520
477To aid debugging, you cna call the C<ber_dump> function to print a "nice" 521To aid debugging, you can call the C<ber_dump> function to print a "nice"
478representation to STDOUT. 522representation to STDOUT.
479 523
480=over 524=over
481 525
482=item ber_dump $tuple[, $profile[, $prefix]] 526=item ber_dump $tuple[, $profile[, $prefix]]
483 527
484In addition to specifying the BER C<$tuple> to dump, youc an also specify 528In addition to specifying the BER C<$tuple> to dump, you can also specify
485a C<$profile> and a C<$prefix> string that is printed in front of each line. 529a C<$profile> and a C<$prefix> string that is printed in front of each line.
486 530
487If C<$profile> is C<$Convert::BER::XS::SNMP_PROFILE>, then C<ber_dump> 531If C<$profile> is C<$Convert::BER::XS::SNMP_PROFILE>, then C<ber_dump>
488will try to improve its output for SNMP data. 532will try to improve its output for SNMP data.
489 533
… …
558 if ($data =~ y/\x20-\x7e//c / (length $data || 1) > 0.2 or $data =~ /\x00./s) { 602 if ($data =~ y/\x20-\x7e//c / (length $data || 1) > 0.2 or $data =~ /\x00./s) {
559 # assume binary 603 # assume binary
560 $data = unpack "H*", $data; 604 $data = unpack "H*", $data;
561 } else { 605 } else {
562 $data =~ s/[^\x20-\x7e]/./g; 606 $data =~ s/[^\x20-\x7e]/./g;
563 $data = "\"$data\"" if $type =~ /string/i || !length $data; 607 $data = "\"$data\"" if $tag =~ /string/i || !length $data;
564 } 608 }
565 609
566 substr $data, 40, 1e9, "..." if 40 < length $data; 610 substr $data, 40, 1e9, "..." if 40 < length $data;
567 611
568 printf "$indent%-16.16s %-6.6s %s\n", $tag, lc $type, $data; 612 printf "$indent%-16.16s %-6.6s %s\n", $tag, lc $type, $data;
… …
733 777
734 $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_IPADDRESS , BER_TYPE_IPADDRESS); 778 $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_IPADDRESS , BER_TYPE_IPADDRESS);
735 $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_COUNTER32 , BER_TYPE_INT); 779 $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_COUNTER32 , BER_TYPE_INT);
736 $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_UNSIGNED32, BER_TYPE_INT); 780 $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_UNSIGNED32, BER_TYPE_INT);
737 $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_TIMETICKS , BER_TYPE_INT); 781 $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_TIMETICKS , BER_TYPE_INT);
738 $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_OPAQUE , BER_TYPE_IPADDRESS); 782 $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_OPAQUE , BER_TYPE_BYTES);
739 $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_COUNTER64 , BER_TYPE_INT); 783 $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_COUNTER64 , BER_TYPE_INT);
740 784
741=head2 LIMITATIONS/NOTES 785=head2 LIMITATIONS/NOTES
742 786
743This module can only en-/decode 64 bit signed and unsigned integers, and 787This module can only en-/decode 64 bit signed and unsigned
744only when your perl supports those. So no UUID OIDs for now (unless you 788integers/tags/lengths, and only when your perl supports those. So no UUID
745map the C<OBJECT IDENTIFIER> tag to something other than C<BER_TYPE_OID>). 789OIDs for now (unless you map the C<OBJECT IDENTIFIER> tag to something
790other than C<BER_TYPE_OID>).
746 791
747This module does not generally care about ranges, i.e. it will happily 792This module does not generally care about ranges, i.e. it will happily
748de-/encode 64 bit integers into an C<ASN_INTEGER> value, or a negative 793de-/encode 64 bit integers into an C<SNMP_UNSIGNED32> value, or a negative
749number into an C<SNMP_COUNTER64>. 794number into an C<SNMP_COUNTER64>.
750 795
751OBJECT IDENTIFIEERs cannot have unlimited length, although the limit is 796OBJECT IDENTIFIEERs cannot have unlimited length, although the limit is
752much larger than e.g. the one imposed by SNMP or other protocols, and is 797much larger than e.g. the one imposed by SNMP or other protocols, and is
753about 4kB. 798about 4kB.
754 799
755Indefinite length encoding is not supported.
756
757Constructed strings are decoded just fine, but there should be a way to 800Constructed strings are decoded just fine, but there should be a way to
758join them for convenience. 801join them for convenience.
759 802
760REAL values are not supported and will currently croak. 803REAL values will always be encoded in decimal form and ssometimes is
761 804forced into a perl "NV" type, potentially losing precision.
762The encoder and decoder tend to accept more formats than should be
763strictly supported - security sensitive applications are strongly advised
764to review the code first.
765
766This module has undergone little to no testing so far.
767 805
768=head2 ITHREADS SUPPORT 806=head2 ITHREADS SUPPORT
769 807
770This module is unlikely to work when the (officially discouraged) ithreads 808This module is unlikely to work in any other than the loading thread when
771are in use. 809the (officially discouraged) ithreads are in use.
772 810
773=head1 AUTHOR 811=head1 AUTHOR
774 812
775 Marc Lehmann <schmorp@schmorp.de> 813 Marc Lehmann <schmorp@schmorp.de>
776 http://software.schmorp.de/pkg/Convert-BER-XS 814 http://software.schmorp.de/pkg/Convert-BER-XS

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines