[ViewVC] Diff of: cvs/Convert-BER-XS/XS.pm

Comparing Convert-BER-XS/XS.pm (file contents):
Revision 1.40 by root, Sun Apr 21 00:42:15 2019 UTC vs.
Revision 1.63 by root, Wed Mar 3 05:30:23 2021 UTC

…		…
4		4
5	=head1 SYNOPSIS	5	=head1 SYNOPSIS
6		6
7	use Convert::BER::XS ':all';	7	use Convert::BER::XS ':all';
8		8
		9	# decode a binary BER data structure using the SNMP profile
9	my $ber = ber_decode $buf, $Convert::BER::XS::SNMP_PROFILE	10	my $ber = ber_decode $buf, $Convert::BER::XS::SNMP_PROFILE
10	or die "unable to decode SNMP message";	11	or die "unable to decode SNMP message";
11		12
12	# The above results in a data structure consisting of	13	# The above results in a data structure consisting of
13	# (class, tag, flags, data)	14	# (class, tag, flags, data)
14	# tuples. Below is such a message, SNMPv1 trap	15	# tuples. Below is such a message, an SNMPv1 trap
15	# with a Cisco mac change notification.	16	# with a Cisco mac change notification.
16	# Did you know that Cisco is in the news almost	17	# (Did you know that Cisco is in the news almost
17	# every week because of some backdoor password	18	# every week because of some backdoor password
18	# or other extremely stupid security bug?	19	# or other extremely stupid security bug?)
19		20
20	[ ASN_UNIVERSAL, ASN_SEQUENCE, 1,	21	[ ASN_UNIVERSAL, ASN_SEQUENCE, 1,
21	[	22	[
22	[ ASN_UNIVERSAL, ASN_INTEGER, 0, 0 ], # snmp version 1	23	[ ASN_UNIVERSAL, ASN_INTEGER, 0, 0 ], # snmp version 1
23	[ ASN_UNIVERSAL, 4, 0, "public" ], # community	24	[ ASN_UNIVERSAL, 4, 0, "public" ], # community
…		…
36	[ ASN_UNIVERSAL, ASN_OCTET_STRING, 0, "...data..." # the value	37	[ ASN_UNIVERSAL, ASN_OCTET_STRING, 0, "...data..." # the value
37	]	38	]
38	]	39	]
39	],	40	],
40	...	41	...
		42
41	# let's dump it, for debugging	43	# let's dump the above structure, for debugging
42
43	ber_dump $ber, $Convert::BER::XS::SNMP_PROFILE;	44	ber_dump $ber, $Convert::BER::XS::SNMP_PROFILE;
44		45
45	# let's decode it a bit with some helper functions	46	# let's decode it a bit with some helper functions.
46		47	# first check whether it starts with a sequence
47	my $msg = ber_is_seq $ber	48	my $msg = ber_is_seq $ber
48	or die "SNMP message does not start with a sequence";	49	or die "SNMP message does not start with a sequence";
49		50
		51	# then check if its some kind of integer
50	ber_is $msg->[0], ASN_UNIVERSAL, ASN_INTEGER, 0	52	ber_is $msg->[0], ASN_UNIVERSAL, ASN_INTEGER, 0
51	or die "SNMP message does not start with snmp version\n";	53	or die "SNMP message does not start with snmp version";
52		54
53	# message is SNMP v1 or v2c?	55	# message is SNMP v1 or v2c?
54	if ($msg->[0][BER_DATA] == 0 \|\| $msg->[0][BER_DATA] == 1) {	56	if ($msg->[0][BER_DATA] == 0 \|\| $msg->[0][BER_DATA] == 1) {
55		57
56	# message is v1 trap?	58	# message is v1 trap?
…		…
64	and (ber_is_int $trap->[3], 1) # mac changed msg	66	and (ber_is_int $trap->[3], 1) # mac changed msg
65	) {	67	) {
66	... and so on	68	... and so on
67		69
68	# finally, let's encode it again and hope it results in the same bit pattern	70	# finally, let's encode it again and hope it results in the same bit pattern
69
70	my $buf = ber_encode $ber, $Convert::BER::XS::SNMP_PROFILE;	71	my $buf = ber_encode $ber, $Convert::BER::XS::SNMP_PROFILE;
71		72
72	=head1 DESCRIPTION	73	=head1 DESCRIPTION
73
74	WARNING: Before release 1.0, the API is not considered stable in any way.
75		74
76	This module implements a I<very> low level BER/DER en-/decoder.	75	This module implements a I<very> low level BER/DER en-/decoder.
77		76
78	It is tuned for low memory and high speed, while still maintaining some	77	It is tuned for low memory and high speed, while still maintaining some
79	level of user-friendlyness.	78	level of user-friendlyness.
…		…
108	BER_CLASS BER_TAG BER_FLAGS BER_DATA	107	BER_CLASS BER_TAG BER_FLAGS BER_DATA
109		108
110	=item C<:const_asn>	109	=item C<:const_asn>
111		110
112	ASN class values (these are C<0>, C<1>, C<2> and C<3>, respectively -	111	ASN class values (these are C<0>, C<1>, C<2> and C<3>, respectively -
113	exactly thw two topmost bits from the identifier octet shifted 6 bits to	112	exactly the two topmost bits from the identifier octet shifted 6 bits to
114	the right):	113	the right):
115		114
116	ASN_UNIVERSAL ASN_APPLICATION ASN_CONTEXT ASN_PRIVATE	115	ASN_UNIVERSAL ASN_APPLICATION ASN_CONTEXT ASN_PRIVATE
117		116
118	ASN tag values (some of which are aliases, such as C<ASN_OID>). Their	117	ASN tag values (some of which are aliases, such as C<ASN_OID>). Their
…		…
175	This works because BER values are tagged with a type and a namespace,	174	This works because BER values are tagged with a type and a namespace,
176	and also have a flag that says whether a value consists of subvalues (is	175	and also have a flag that says whether a value consists of subvalues (is
177	"constructed") or not (is "primitive").	176	"constructed") or not (is "primitive").
178		177
179	Tags are simple integers, and ASN.1 defines a somewhat weird assortment	178	Tags are simple integers, and ASN.1 defines a somewhat weird assortment
180	of those - for example, you have one integers and 16(!) different	179	of those - for example, you have one integer but 16(!) different
181	string types, but there is no Unsigned32 type for example. Different	180	string types, but there is no Unsigned32 type for example. Different
182	applications work around this in different ways, for example, SNMP defines	181	applications work around this in different ways, for example, SNMP defines
183	application-specific Gauge32, Counter32 and Unsigned32, which are mapped	182	application-specific Gauge32, Counter32 and Unsigned32, which are mapped
184	to two different tags: you can distinguish between Counter32 and the	183	to two different tags: you can distinguish between Counter32 and the
185	others, but not between Gause32 and Unsigned32, without the ASN.1 schema.	184	others, but not between Gause32 and Unsigned32, without the ASN.1 schema.
…		…
296	Also, since BER is self-delimited, this can be used to decode multiple BER	295	Also, since BER is self-delimited, this can be used to decode multiple BER
297	values joined together.	296	values joined together.
298		297
299	=item $bindata = ber_encode $tuple[, $profile]	298	=item $bindata = ber_encode $tuple[, $profile]
300		299
301	Encodes the BER tuple into a BER/DER data structure. AS with	300	Encodes the BER tuple into a BER/DER data structure. As with
302	Cyber_decode>, an optional profile can be given.	301	Cyber_decode>, an optional profile can be given.
303		302
304	The encoded data should be both BER and DER ("shortest form") compliant	303	The encoded data should be both BER and DER ("shortest form") compliant
305	unless the input says otherwise (e.g. it uses constructed strings).	304	unless the input says otherwise (e.g. it uses constructed strings).
306		305
…		…
409	use common::sense;	408	use common::sense;
410		409
411	use XSLoader ();	410	use XSLoader ();
412	use Exporter qw(import);	411	use Exporter qw(import);
413		412
		413	use Carp ();
		414
414	our $VERSION;	415	our $VERSION;
415		416
416	BEGIN {	417	BEGIN {
417	$VERSION = '1.0';	418	$VERSION = 1.21;
418	XSLoader::load __PACKAGE__, $VERSION;	419	XSLoader::load __PACKAGE__, $VERSION;
419	}	420	}
420		421
421	our %EXPORT_TAGS = (	422	our %EXPORT_TAGS = (
422	const_index => [qw(	423	const_index => [qw(
…		…
466	# additional SNMP application types	467	# additional SNMP application types
467	our $SNMP_PROFILE = new Convert::BER::XS::Profile;	468	our $SNMP_PROFILE = new Convert::BER::XS::Profile;
468		469
469	$SNMP_PROFILE->set (ASN_APPLICATION, SNMP_IPADDRESS , BER_TYPE_IPADDRESS);	470	$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_COUNTER32 , BER_TYPE_INT);
		472	$SNMP_PROFILE->set (ASN_APPLICATION, SNMP_COUNTER64 , 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.
		479	sub _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
		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	}
474		518
475	=head2 DEBUGGING	519	=head2 DEBUGGING
476		520
477	To aid debugging, you cna call the C<ber_dump> function to print a "nice"	521	To aid debugging, you can call the C<ber_dump> function to print a "nice"
478	representation to STDOUT.	522	representation 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
484	In addition to specifying the BER C<$tuple> to dump, youc an also specify	528	In addition to specifying the BER C<$tuple> to dump, you can also specify
485	a C<$profile> and a C<$prefix> string that is printed in front of each line.	529	a C<$profile> and a C<$prefix> string that is printed in front of each line.
486		530
487	If C<$profile> is C<$Convert::BER::XS::SNMP_PROFILE>, then C<ber_dump>	531	If C<$profile> is C<$Convert::BER::XS::SNMP_PROFILE>, then C<ber_dump>
488	will try to improve its output for SNMP data.	532	will try to improve its output for SNMP data.
489		533
…		…
496	Example output:	540	Example output:
497		541
498	SEQUENCE	542	SEQUENCE
499	\| OCTET_STRING bytes 800063784300454045045400000001	543	\| OCTET_STRING bytes 800063784300454045045400000001
500	\| OCTET_STRING bytes	544	\| OCTET_STRING bytes
501	\| CONTEXT (7) bytes CONSTRUCTED	545	\| CONTEXT (7) CONSTRUCTED
502	\| \| INTEGER int 1058588941	546	\| \| INTEGER int 1058588941
503	\| \| INTEGER int 0	547	\| \| INTEGER int 0
504	\| \| INTEGER int 0	548	\| \| INTEGER int 0
505	\| \| SEQUENCE	549	\| \| SEQUENCE
506	\| \| \| SEQUENCE	550	\| \| \| SEQUENCE
507	\| \| \| \| OID oid 1.3.6.1.2.1.1.3.0	551	\| \| \| \| OID oid 1.3.6.1.2.1.1.3.0
508	\| \| \| \| TIMETICKS int 638085796	552	\| \| \| \| TIMETICKS int 638085796
509		553
		554	=back
		555
510	=cut	556	=cut
511		557
512	# reverse enum, very slow and ugly hack	558	# reverse enum, very slow and ugly hack
513	sub _re {	559	sub _re {
514	my ($export_tag, $value) = @_;	560	my ($export_tag, $value) = @_;
…		…
518	and return $symbol;	564	and return $symbol;
519	}	565	}
520		566
521	"($value)"	567	"($value)"
522	}	568	}
523
524	$SNMP_PROFILE->set (ASN_APPLICATION, SNMP_COUNTER64 , BER_TYPE_INT);
525		569
526	sub _ber_dump {	570	sub _ber_dump {
527	my ($ber, $profile, $indent) = @_;	571	my ($ber, $profile, $indent) = @_;
528		572
529	if (my $seq = ber_is_seq $ber) {	573	if (my $seq = ber_is_seq $ber) {
…		…
547	$class =~ s/^ASN_//;	591	$class =~ s/^ASN_//;
548	$tag =~ s/^(ASN_\|SNMP_)//;	592	$tag =~ s/^(ASN_\|SNMP_)//;
549	$type =~ s/^BER_TYPE_//;	593	$type =~ s/^BER_TYPE_//;
550		594
551	if ($ber->[BER_FLAGS]) {	595	if ($ber->[BER_FLAGS]) {
552	printf "$indent%-16.16s %-6.6s CONSTRUCTED\n", $tag, lc $type;	596	printf "$indent%-16.16s\n", $tag;
553	&_ber_dump ($_, $profile, "$indent\| ")	597	&_ber_dump ($_, $profile, "$indent\| ")
554	for @$data;	598	for @$data;
555	} else {	599	} else {
556	if ($data =~ y/\x20-\x7e//c / (length $data \|\| 1) > 0.2 or $data =~ /\x00./s) {	600	if ($data =~ y/\x20-\x7e//c / (length $data \|\| 1) > 0.2 or $data =~ /\x00./s) {
557	# assume binary	601	# assume binary
558	$data = unpack "H*", $data;	602	$data = unpack "H*", $data;
559	substr $data, 40, 1e9, "..." if 40 < length $data;
560	} else {	603	} else {
561	$data =~ s/[^\x20-\x7e]/./g;	604	$data =~ s/[^\x20-\x7e]/./g;
562	$data = "\"$data\"" if $type =~ /string/i;	605	$data = "\"$data\"" if $tag =~ /string/i \|\| !length $data;
563	substr $data, 40, 1e9, "..." if 40 < length $data;
564	}	606	}
		607
		608	substr $data, 40, 1e9, "..." if 40 < length $data;
565		609
566	printf "$indent%-16.16s %-6.6s %s\n", $tag, lc $type, $data;	610	printf "$indent%-16.16s %-6.6s %s\n", $tag, lc $type, $data;
567	}	611	}
568	}	612	}
569	}	613	}
…		…
604	=item C<$Convert::BER::XS::SNMP_PROFILE>	648	=item C<$Convert::BER::XS::SNMP_PROFILE>
605		649
606	A profile with mappings for SNMP-specific application tags added. This is	650	A profile with mappings for SNMP-specific application tags added. This is
607	useful when de-/encoding SNMP data.	651	useful when de-/encoding SNMP data.
608		652
		653	The L<Example Profile> section, below, shows how this profile is being
		654	constructed.
		655
609	Example:	656	Example:
610		657
611	$ber = ber_decode $data, $Convert::BER::XS::SNMP_PROFILE;	658	$ber = ber_decode $data, $Convert::BER::XS::SNMP_PROFILE;
612		659
613	=back	660	=back
…		…
639		686
640	Returns the BER type mapped to the given C<$class>/C<$tag> combination.	687	Returns the BER type mapped to the given C<$class>/C<$tag> combination.
641		688
642	=back	689	=back
643		690
644	=head2 BER TYPES	691	=head2 BER Types
645		692
646	This lists the predefined BER types - you can map any C<CLASS>/C<TAG>	693	This lists the predefined BER types. BER types are formatters used
647	combination to any C<BER_TYPE_*>.	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.
648		697
649	=over	698	=over
650		699
651	=item C<BER_TYPE_BYTES>	700	=item C<BER_TYPE_BYTES>
652		701
…		…
681	dot, e.g. C<1.3.6.1.213>.	730	dot, e.g. C<1.3.6.1.213>.
682		731
683	=item C<BER_TYPE_RELOID>	732	=item C<BER_TYPE_RELOID>
684		733
685	Same as C<BER_TYPE_OID> but uses relative object identifier	734	Same as C<BER_TYPE_OID> but uses relative object identifier
686	encoding: ASN.1 has this hack of encoding the first two OID components	735	encoding: ASN.1 uses some hack encoding of the first two OID components
687	into a single integer in a weird attempt to save an insignificant amount	736	into a single integer in a weird attempt to save an insignificant amount
688	of space in an otherwise wasteful encoding, and relative OIDs are	737	of space in an otherwise wasteful encoding, and relative OIDs are
689	basically OIDs without this hack. The practical difference is that the	738	basically OIDs without this hack. The practical difference is that the
690	second component of an OID can only have the values 1..40, while relative	739	second component of an OID can only have the values 1..40, while relative
691	OIDs do not have this restriction.	740	OIDs do not have this restriction.
…		…
729		778
730	$SNMP_PROFILE->set (ASN_APPLICATION, SNMP_IPADDRESS , BER_TYPE_IPADDRESS);	779	$SNMP_PROFILE->set (ASN_APPLICATION, SNMP_IPADDRESS , BER_TYPE_IPADDRESS);
731	$SNMP_PROFILE->set (ASN_APPLICATION, SNMP_COUNTER32 , BER_TYPE_INT);	780	$SNMP_PROFILE->set (ASN_APPLICATION, SNMP_COUNTER32 , BER_TYPE_INT);
732	$SNMP_PROFILE->set (ASN_APPLICATION, SNMP_UNSIGNED32, BER_TYPE_INT);	781	$SNMP_PROFILE->set (ASN_APPLICATION, SNMP_UNSIGNED32, BER_TYPE_INT);
733	$SNMP_PROFILE->set (ASN_APPLICATION, SNMP_TIMETICKS , BER_TYPE_INT);	782	$SNMP_PROFILE->set (ASN_APPLICATION, SNMP_TIMETICKS , BER_TYPE_INT);
734	$SNMP_PROFILE->set (ASN_APPLICATION, SNMP_OPAQUE , BER_TYPE_IPADDRESS);	783	$SNMP_PROFILE->set (ASN_APPLICATION, SNMP_OPAQUE , BER_TYPE_BYTES);
735	$SNMP_PROFILE->set (ASN_APPLICATION, SNMP_COUNTER64 , BER_TYPE_INT);	784	$SNMP_PROFILE->set (ASN_APPLICATION, SNMP_COUNTER64 , BER_TYPE_INT);
736		785
737	=head2 LIMITATIONS/NOTES	786	=head2 LIMITATIONS/NOTES
738		787
739	This module can only en-/decode 64 bit signed and unsigned integers, and	788	This module can only en-/decode 64 bit signed and unsigned
740	only when your perl supports those.	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>).
741		792
742	This module does not generally care about ranges, i.e. it will happily	793	This module does not generally care about ranges, i.e. it will happily
743	de-/encode 64 bit integers into an C<ASN_INTEGER> value, or a negative	794	de-/encode 64 bit integers into an C<SNMP_UNSIGNED32> value, or a negative
744	number into an C<SNMP_COUNTER64>.	795	number into an C<SNMP_COUNTER64>.
745		796
746	OBJECT IDENTIFIEERs cannot have unlimited length, although the limit is	797	OBJECT IDENTIFIEERs cannot have unlimited length, although the limit is
747	much larger than e.g. the one imposed by SNMP or other protocols,a nd is	798	much larger than e.g. the one imposed by SNMP or other protocols, and is
748	about 4kB.	799	about 4kB.
749
750	Indefinite length encoding is not supported.
751		800
752	Constructed strings are decoded just fine, but there should be a way to	801	Constructed strings are decoded just fine, but there should be a way to
753	join them for convenience.	802	join them for convenience.
754		803
755	REAL values are not supported and will currently croak.	804	REAL values will always be encoded in decimal form and ssometimes is
756		805	forced into a perl "NV" type, potentially losing precision.
757	The encoder and decoder tend to accept more formats than should be
758	strictly supported.
759
760	This module has undergone little to no testing so far.
761		806
762	=head2 ITHREADS SUPPORT	807	=head2 ITHREADS SUPPORT
763		808
764	This module is unlikely to work when the (officially discouraged) ithreads	809	This module is unlikely to work in any other than the loading thread when
765	are in use.	810	the (officially discouraged) ithreads are in use.
766		811
767	=head1 AUTHOR	812	=head1 AUTHOR
768		813
769	Marc Lehmann <schmorp@schmorp.de>	814	Marc Lehmann <schmorp@schmorp.de>
770	http://software.schmorp.de/pkg/Convert-BER-XS	815	http://software.schmorp.de/pkg/Convert-BER-XS

Diff Legend

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

Comparing Convert-BER-XS/XS.pm (file contents): Revision 1.40 by root, Sun Apr 21 00:42:15 2019 UTC vs. Revision 1.63 by root, Wed Mar 3 05:30:23 2021 UTC

Diff Legend

Comparing Convert-BER-XS/XS.pm (file contents):
Revision 1.40 by root, Sun Apr 21 00:42:15 2019 UTC vs.
Revision 1.63 by root, Wed Mar 3 05:30:23 2021 UTC