cvsroot/Net-SNMP-XS/XS.pm

=head1 NAME

Net::SNMP::XS - speed up Net::SNMP by decoding in XS, with limitations

=head1 SYNOPSIS

 use Net::SNMP::XS;

 # loading it is enough to speed up Net::SNMP

 # experimental BER decoder
 use Net::SNMP::XS ':ber';

 # TODO

=head1 DESCRIPTION

This module tries to speed up Net::SNMP response packet decoding.

It does this by overriding a few selected internal method by (almost)
equivalent XS methods.

This currently reduces decode time by a factor of ten for typical bulk
responses.

There are currently the following limitations when using this module:

=over 4

=item overriding internal functions might cause the module to
malfunction with future versions of Net::SNMP

=item error messages will be simpler/different

=item translation will be ignored (all values will be delivered "raw")

=item a moderately modern (>= C99) C compiler is required

=item only tested with 5.10, no intentions to port to older perls

=item duplicate OIDs are not supported

=item REPORT PDUs are not supported

=back

Beginning with version 2, this module also contains a generic BER decoder,
with lacking documentation. More to come, but this might eventually move
to it's own module.

=cut

package Net::SNMP::XS;

use common::sense;

use Exporter qw(import);

use Net::SNMP ();
use Net::SNMP::PDU ();
use Net::SNMP::Message ();
use Net::SNMP::MessageProcessing ();

our $VERSION;

BEGIN {
   $VERSION = '2.0';

   # this overrides many methods inside Net::SNMP and it's submodules
   require XSLoader;
   XSLoader::load Net::SNMP::XS, $VERSION;
}

our %EXPORT_TAGS = (
   ber => [qw(
      ber_decode
      ber_eq ber_seq ber_i32 ber_oid
      BER_CLASS BER_TAG BER_CONSTRUCTED BER_DATA
      ASN_BOOLEAN ASN_INTEGER32 ASN_BIT_STRING ASN_OCTET_STRING ASN_NULL ASN_OBJECT_IDENTIFIER ASN_TAG_BER ASN_TAG_MASK
      ASN_CONSTRUCTED ASN_UNIVERSAL ASN_APPLICATION ASN_CONTEXT ASN_PRIVATE ASN_CLASS_MASK ASN_CLASS_SHIFT
      ASN_SEQUENCE ASN_IPADDRESS ASN_COUNTER32 ASN_UNSIGNED32 ASN_TIMETICKS ASN_OPAQUE ASN_COUNTER64
   )],
);

our @EXPORT_OK = @{ $EXPORT_TAGS{ber} };

package Net::SNMP::Message;

Net::SNMP::XS::set_type INTEGER          , \&_process_integer32;
Net::SNMP::XS::set_type OCTET_STRING     , \&_process_octet_string;
Net::SNMP::XS::set_type NULL             , \&_process_null;
Net::SNMP::XS::set_type OBJECT_IDENTIFIER, \&_process_object_identifier;
Net::SNMP::XS::set_type SEQUENCE         , \&_process_sequence;
Net::SNMP::XS::set_type IPADDRESS        , \&_process_ipaddress;
Net::SNMP::XS::set_type COUNTER          , \&_process_counter;
Net::SNMP::XS::set_type GAUGE            , \&_process_gauge;
Net::SNMP::XS::set_type TIMETICKS        , \&_process_timeticks;
Net::SNMP::XS::set_type OPAQUE           , \&_process_opaque;
Net::SNMP::XS::set_type COUNTER64        , \&_process_counter64;
Net::SNMP::XS::set_type NOSUCHOBJECT     , \&_process_nosuchobject;
Net::SNMP::XS::set_type NOSUCHINSTANCE   , \&_process_nosuchinstance;
Net::SNMP::XS::set_type ENDOFMIBVIEW     , \&_process_endofmibview;
Net::SNMP::XS::set_type GET_REQUEST      , \&_process_get_request;
Net::SNMP::XS::set_type GET_NEXT_REQUEST , \&_process_get_next_request;
Net::SNMP::XS::set_type GET_RESPONSE     , \&_process_get_response;
Net::SNMP::XS::set_type SET_REQUEST      , \&_process_set_request;
Net::SNMP::XS::set_type TRAP             , \&_process_trap;
Net::SNMP::XS::set_type GET_BULK_REQUEST , \&_process_get_bulk_request;
Net::SNMP::XS::set_type INFORM_REQUEST   , \&_process_inform_request;
Net::SNMP::XS::set_type SNMPV2_TRAP      , \&_process_v2_trap;
Net::SNMP::XS::set_type REPORT           , \&_process_report;

package Net::SNMP::PDU;

# var_bind_list hardcodes oid_lex_sort. *sigh*
# we copy it 1:1, except for using oid_lex_sort.

sub var_bind_list
{
   my ($this, $vbl, $types) = @_;

   return if defined($this->{_error});

   if (@_ > 1) {
      # The VarBindList HASH is being updated from an external
      # source.  We need to update the VarBind names ARRAY to
      # correspond to the new keys of the HASH.  If the updated
      # information is valid, we will use lexicographical ordering
      # for the ARRAY entries since we do not have a PDU to use
      # to determine the ordering.  The ASN.1 types HASH is also
      # updated here if a cooresponding HASH is passed.  We double
      # check the mapping by populating the hash with the keys of
      # the VarBindList HASH. 

      if (!defined($vbl) || (ref($vbl) ne 'HASH')) {

         $this->{_var_bind_list}  = undef;
         $this->{_var_bind_names} = [];
         $this->{_var_bind_types} = undef; 

      } else {

         $this->{_var_bind_list} = $vbl;

         @{$this->{_var_bind_names}} = Net::SNMP::oid_lex_sort keys %$vbl;

         if (!defined($types) || (ref($types) ne 'HASH')) {
             $types = {};
         }

         map { 
            $this->{_var_bind_types}->{$_} = 
               exists($types->{$_}) ? $types->{$_} : undef; 
         } keys(%{$vbl});

      }

   }

   $this->{_var_bind_list};
}

1;

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/

=cut

Revision:	1.18
Committed:	Fri Apr 19 15:50:48 2019 UTC (7 years, 5 months ago) by root
Branch:	MAIN
Changes since 1.17:	+26 -2 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3			Net::SNMP::XS - speed up Net::SNMP by decoding in XS, with limitations
4
5			=head1 SYNOPSIS
6
7			use Net::SNMP::XS;
8
9	root	1.18	# loading it is enough to speed up Net::SNMP
10
11			# experimental BER decoder
12			use Net::SNMP::XS ':ber';
13
14			# TODO
15	root	1.1
16			=head1 DESCRIPTION
17
18			This module tries to speed up Net::SNMP response packet decoding.
19
20			It does this by overriding a few selected internal method by (almost)
21			equivalent XS methods.
22
23	root	1.5	This currently reduces decode time by a factor of ten for typical bulk
24	root	1.3	responses.
25	root	1.1
26			There are currently the following limitations when using this module:
27
28			=over 4
29
30	root	1.6	=item overriding internal functions might cause the module to
31			malfunction with future versions of Net::SNMP
32
33	root	1.3	=item error messages will be simpler/different
34
35	root	1.1	=item translation will be ignored (all values will be delivered "raw")
36
37	root	1.2	=item a moderately modern (>= C99) C compiler is required
38
39	root	1.7	=item only tested with 5.10, no intentions to port to older perls
40	root	1.2
41	root	1.5	=item duplicate OIDs are not supported
42
43			=item REPORT PDUs are not supported
44
45	root	1.1	=back
46
47	root	1.18	Beginning with version 2, this module also contains a generic BER decoder,
48			with lacking documentation. More to come, but this might eventually move
49			to it's own module.
50
51	root	1.1	=cut
52
53			package Net::SNMP::XS;
54
55	root	1.16	use common::sense;
56	root	1.1
57	root	1.18	use Exporter qw(import);
58
59	root	1.8	use Net::SNMP ();
60	root	1.1	use Net::SNMP::PDU ();
61			use Net::SNMP::Message ();
62			use Net::SNMP::MessageProcessing ();
63
64			our $VERSION;
65
66			BEGIN {
67	root	1.18	$VERSION = '2.0';
68	root	1.1
69	root	1.10	# this overrides many methods inside Net::SNMP and it's submodules
70	root	1.1	require XSLoader;
71			XSLoader::load Net::SNMP::XS, $VERSION;
72			}
73
74	root	1.18	our %EXPORT_TAGS = (
75			ber => [qw(
76			ber_decode
77			ber_eq ber_seq ber_i32 ber_oid
78			BER_CLASS BER_TAG BER_CONSTRUCTED BER_DATA
79			ASN_BOOLEAN ASN_INTEGER32 ASN_BIT_STRING ASN_OCTET_STRING ASN_NULL ASN_OBJECT_IDENTIFIER ASN_TAG_BER ASN_TAG_MASK
80			ASN_CONSTRUCTED ASN_UNIVERSAL ASN_APPLICATION ASN_CONTEXT ASN_PRIVATE ASN_CLASS_MASK ASN_CLASS_SHIFT
81			ASN_SEQUENCE ASN_IPADDRESS ASN_COUNTER32 ASN_UNSIGNED32 ASN_TIMETICKS ASN_OPAQUE ASN_COUNTER64
82			)],
83			);
84
85			our @EXPORT_OK = @{ $EXPORT_TAGS{ber} };
86
87	root	1.8	package Net::SNMP::Message;
88
89			Net::SNMP::XS::set_type INTEGER , \&_process_integer32;
90			Net::SNMP::XS::set_type OCTET_STRING , \&_process_octet_string;
91			Net::SNMP::XS::set_type NULL , \&_process_null;
92			Net::SNMP::XS::set_type OBJECT_IDENTIFIER, \&_process_object_identifier;
93			Net::SNMP::XS::set_type SEQUENCE , \&_process_sequence;
94			Net::SNMP::XS::set_type IPADDRESS , \&_process_ipaddress;
95			Net::SNMP::XS::set_type COUNTER , \&_process_counter;
96			Net::SNMP::XS::set_type GAUGE , \&_process_gauge;
97			Net::SNMP::XS::set_type TIMETICKS , \&_process_timeticks;
98			Net::SNMP::XS::set_type OPAQUE , \&_process_opaque;
99			Net::SNMP::XS::set_type COUNTER64 , \&_process_counter64;
100			Net::SNMP::XS::set_type NOSUCHOBJECT , \&_process_nosuchobject;
101			Net::SNMP::XS::set_type NOSUCHINSTANCE , \&_process_nosuchinstance;
102			Net::SNMP::XS::set_type ENDOFMIBVIEW , \&_process_endofmibview;
103			Net::SNMP::XS::set_type GET_REQUEST , \&_process_get_request;
104			Net::SNMP::XS::set_type GET_NEXT_REQUEST , \&_process_get_next_request;
105			Net::SNMP::XS::set_type GET_RESPONSE , \&_process_get_response;
106			Net::SNMP::XS::set_type SET_REQUEST , \&_process_set_request;
107			Net::SNMP::XS::set_type TRAP , \&_process_trap;
108			Net::SNMP::XS::set_type GET_BULK_REQUEST , \&_process_get_bulk_request;
109			Net::SNMP::XS::set_type INFORM_REQUEST , \&_process_inform_request;
110			Net::SNMP::XS::set_type SNMPV2_TRAP , \&_process_v2_trap;
111			Net::SNMP::XS::set_type REPORT , \&_process_report;
112
113			package Net::SNMP::PDU;
114
115	root	1.10	# var_bind_list hardcodes oid_lex_sort. sigh
116	root	1.8	# we copy it 1:1, except for using oid_lex_sort.
117
118			sub var_bind_list
119	root	1.1	{
120	root	1.8	my ($this, $vbl, $types) = @_;
121
122			return if defined($this->{_error});
123
124			if (@_ > 1) {
125			# The VarBindList HASH is being updated from an external
126			# source. We need to update the VarBind names ARRAY to
127			# correspond to the new keys of the HASH. If the updated
128			# information is valid, we will use lexicographical ordering
129			# for the ARRAY entries since we do not have a PDU to use
130			# to determine the ordering. The ASN.1 types HASH is also
131			# updated here if a cooresponding HASH is passed. We double
132			# check the mapping by populating the hash with the keys of
133			# the VarBindList HASH.
134
135			if (!defined($vbl) \|\| (ref($vbl) ne 'HASH')) {
136
137			$this->{_var_bind_list} = undef;
138			$this->{_var_bind_names} = [];
139			$this->{_var_bind_types} = undef;
140
141			} else {
142
143			$this->{_var_bind_list} = $vbl;
144
145			@{$this->{_var_bind_names}} = Net::SNMP::oid_lex_sort keys %$vbl;
146
147			if (!defined($types) \|\| (ref($types) ne 'HASH')) {
148			$types = {};
149			}
150
151			map {
152			$this->{_var_bind_types}->{$_} =
153			exists($types->{$_}) ? $types->{$_} : undef;
154			} keys(%{$vbl});
155
156			}
157
158			}
159	root	1.1
160	root	1.8	$this->{_var_bind_list};
161	root	1.1	}
162
163			1;
164
165			=head1 AUTHOR
166
167			Marc Lehmann <schmorp@schmorp.de>
168			http://home.schmorp.de/
169
170			=cut
171