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

Comparing Convert-BER-XS/XS.pm (file contents):
Revision 1.54 by root, Tue Apr 23 21:03:12 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.
…		…
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.
…		…
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.11;	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		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	}
		518
474	=head2 DEBUGGING	519	=head2 DEBUGGING
475		520
476	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"
477	representation to STDOUT.	522	representation to STDOUT.
478		523
479	=over	524	=over
480		525
481	=item ber_dump $tuple[, $profile[, $prefix]]	526	=item ber_dump $tuple[, $profile[, $prefix]]
…		…
519	and return $symbol;	564	and return $symbol;
520	}	565	}
521		566
522	"($value)"	567	"($value)"
523	}	568	}
524
525	$SNMP_PROFILE->set (ASN_APPLICATION, SNMP_COUNTER64 , BER_TYPE_INT);
526		569
527	sub _ber_dump {	570	sub _ber_dump {
528	my ($ber, $profile, $indent) = @_;	571	my ($ber, $profile, $indent) = @_;
529		572
530	if (my $seq = ber_is_seq $ber) {	573	if (my $seq = ber_is_seq $ber) {
…		…
605	=item C<$Convert::BER::XS::SNMP_PROFILE>	648	=item C<$Convert::BER::XS::SNMP_PROFILE>
606		649
607	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
608	useful when de-/encoding SNMP data.	651	useful when de-/encoding SNMP data.
609		652
		653	The L<Example Profile> section, below, shows how this profile is being
		654	constructed.
		655
610	Example:	656	Example:
611		657
612	$ber = ber_decode $data, $Convert::BER::XS::SNMP_PROFILE;	658	$ber = ber_decode $data, $Convert::BER::XS::SNMP_PROFILE;
613		659
614	=back	660	=back
…		…
684	dot, e.g. C<1.3.6.1.213>.	730	dot, e.g. C<1.3.6.1.213>.
685		731
686	=item C<BER_TYPE_RELOID>	732	=item C<BER_TYPE_RELOID>
687		733
688	Same as C<BER_TYPE_OID> but uses relative object identifier	734	Same as C<BER_TYPE_OID> but uses relative object identifier
689	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
690	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
691	of space in an otherwise wasteful encoding, and relative OIDs are	737	of space in an otherwise wasteful encoding, and relative OIDs are
692	basically OIDs without this hack. The practical difference is that the	738	basically OIDs without this hack. The practical difference is that the
693	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
694	OIDs do not have this restriction.	740	OIDs do not have this restriction.
…		…
737	$SNMP_PROFILE->set (ASN_APPLICATION, SNMP_OPAQUE , BER_TYPE_BYTES);	783	$SNMP_PROFILE->set (ASN_APPLICATION, SNMP_OPAQUE , BER_TYPE_BYTES);
738	$SNMP_PROFILE->set (ASN_APPLICATION, SNMP_COUNTER64 , BER_TYPE_INT);	784	$SNMP_PROFILE->set (ASN_APPLICATION, SNMP_COUNTER64 , BER_TYPE_INT);
739		785
740	=head2 LIMITATIONS/NOTES	786	=head2 LIMITATIONS/NOTES
741		787
742	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
743	only when your perl supports those. So no UUID OIDs for now (unless you	789	integers/tags/lengths, and only when your perl supports those. So no UUID
744	map the C<OBJECT IDENTIFIER> tag to something other than C<BER_TYPE_OID>).	790	OIDs for now (unless you map the C<OBJECT IDENTIFIER> tag to something
		791	other than C<BER_TYPE_OID>).
745		792
746	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
747	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
748	number into an C<SNMP_COUNTER64>.	795	number into an C<SNMP_COUNTER64>.
749		796
750	OBJECT IDENTIFIEERs cannot have unlimited length, although the limit is	797	OBJECT IDENTIFIEERs cannot have unlimited length, although the limit is
751	much larger than e.g. the one imposed by SNMP or other protocols, and is	798	much larger than e.g. the one imposed by SNMP or other protocols, and is
752	about 4kB.	799	about 4kB.
753		800
754	Indefinite length encoding is not supported.
755
756	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
757	join them for convenience.	802	join them for convenience.
758		803
759	REAL values are not supported and will currently croak.	804	REAL values will always be encoded in decimal form and ssometimes is
760		805	forced into a perl "NV" type, potentially losing precision.
761	The encoder and decoder tend to accept more formats than should be
762	strictly supported - security sensitive applications are strongly advised
763	to review the code first.
764
765	This module has undergone little to no testing so far.
766		806
767	=head2 ITHREADS SUPPORT	807	=head2 ITHREADS SUPPORT
768		808
769	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
770	are in use.	810	the (officially discouraged) ithreads are in use.
771		811
772	=head1 AUTHOR	812	=head1 AUTHOR
773		813
774	Marc Lehmann <schmorp@schmorp.de>	814	Marc Lehmann <schmorp@schmorp.de>
775	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.54 by root, Tue Apr 23 21:03:12 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.54 by root, Tue Apr 23 21:03:12 2019 UTC vs.
Revision 1.63 by root, Wed Mar 3 05:30:23 2021 UTC