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.53 by root, Tue Apr 23 20:16:40 2019 UTC vs.
Revision 1.57 by root, Thu Apr 25 22:30:21 2019 UTC

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.11; 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.
478sub _decode_real_decimal {
479 my ($format, $val) = @_;
480
481 $val =~ y/,/./;
482
483 if ($format == 1) {
484 $val =~ /^ \ * [+-]? [0-9]+ \z/x
485 or Carp::croak "BER_TYPE_REAL NR1 value not in NR1 format ($val) (X.690 8.5.8, ECMA-63)";
486 } elsif ($format == 2) {
487 $val =~ /^ \ * [+-]? (?: [0-9]+\.[0-9]* | [0-9]*\.[0-9]+ ) \z/x
488 or Carp::croak "BER_TYPE_REAL NR2 value not in NR2 format ($val) (X.690 8.5.8, ECMA-63)";
489 } elsif ($format == 3) {
490 $val =~ /^ \ * [+-] (?: [0-9]+\.[0-9]* | [0-9]*\.[0-9]+ ) E [+-][0-9]+ \z/x
491 or Carp::croak "BER_TYPE_REAL NR3 value not in NR3 format ($val) (X.690 8.5.8, ECMA-63)";
492 } else {
493 Carp::croak "BER_TYPE_REAL illegal decimal numerical representation format $format";
494 }
495
496 $val
497}
498
499# this is a mess, but perl's support for floating point formatting is nearly nonexistant
500sub _encode_real_decimal {
501 my ($val, $nvdig) = @_;
502
503 $val = sprintf "%.*G", $nvdig + 1, $val;
504
505 if ($val =~ /E/) {
506 $val =~ s/E(?=[^+-])/E+/;
507 $val =~ s/E/.E/ if $val !~ /\./;
508 $val =~ s/^/+/ unless $val =~ /^-/;
509
510 return "\x03$val" # NR3
511 }
512
513 $val =~ /\./
514 ? "\x02$val" # NR2
515 : "\x01$val" # NR1
516}
474 517
475=head2 DEBUGGING 518=head2 DEBUGGING
476 519
477To aid debugging, you cna call the C<ber_dump> function to print a "nice" 520To aid debugging, you can call the C<ber_dump> function to print a "nice"
478representation to STDOUT. 521representation to STDOUT.
479 522
480=over 523=over
481 524
482=item ber_dump $tuple[, $profile[, $prefix]] 525=item ber_dump $tuple[, $profile[, $prefix]]
733 776
734 $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_IPADDRESS , BER_TYPE_IPADDRESS); 777 $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_IPADDRESS , BER_TYPE_IPADDRESS);
735 $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_COUNTER32 , BER_TYPE_INT); 778 $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_COUNTER32 , BER_TYPE_INT);
736 $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_UNSIGNED32, BER_TYPE_INT); 779 $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_UNSIGNED32, BER_TYPE_INT);
737 $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_TIMETICKS , BER_TYPE_INT); 780 $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_TIMETICKS , BER_TYPE_INT);
738 $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_OPAQUE , BER_TYPE_IPADDRESS); 781 $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_OPAQUE , BER_TYPE_BYTES);
739 $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_COUNTER64 , BER_TYPE_INT); 782 $SNMP_PROFILE->set (ASN_APPLICATION, SNMP_COUNTER64 , BER_TYPE_INT);
740 783
741=head2 LIMITATIONS/NOTES 784=head2 LIMITATIONS/NOTES
742 785
743This module can only en-/decode 64 bit signed and unsigned integers, and 786This module can only en-/decode 64 bit signed and unsigned
744only when your perl supports those. So no UUID OIDs for now (unless you 787integers/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>). 788OIDs for now (unless you map the C<OBJECT IDENTIFIER> tag to something
789other than C<BER_TYPE_OID>).
746 790
747This module does not generally care about ranges, i.e. it will happily 791This 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 792de-/encode 64 bit integers into an C<SNMP_UNSIGNED32> value, or a negative
749number into an C<SNMP_COUNTER64>. 793number into an C<SNMP_COUNTER64>.
750 794
751OBJECT IDENTIFIEERs cannot have unlimited length, although the limit is 795OBJECT IDENTIFIEERs cannot have unlimited length, although the limit is
752much larger than e.g. the one imposed by SNMP or other protocols, and is 796much larger than e.g. the one imposed by SNMP or other protocols, and is
753about 4kB. 797about 4kB.
754 798
755Indefinite length encoding is not supported.
756
757Constructed strings are decoded just fine, but there should be a way to 799Constructed strings are decoded just fine, but there should be a way to
758join them for convenience. 800join them for convenience.
759 801
760REAL values are not supported and will currently croak. 802REAL values will always be encoded in decimal form and ssometimes is
761 803forced 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 804
768=head2 ITHREADS SUPPORT 805=head2 ITHREADS SUPPORT
769 806
770This module is unlikely to work when the (officially discouraged) ithreads 807This module is unlikely to work in any other than the loading thread when
771are in use. 808the (officially discouraged) ithreads are in use.
772 809
773=head1 AUTHOR 810=head1 AUTHOR
774 811
775 Marc Lehmann <schmorp@schmorp.de> 812 Marc Lehmann <schmorp@schmorp.de>
776 http://software.schmorp.de/pkg/Convert-BER-XS 813 http://software.schmorp.de/pkg/Convert-BER-XS

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines