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, there are no public symbols

=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 some 70%.

There are currently the following limitations when using this module:

=over 4

=item leading dots are required for iods

=item error handling is currently broken (but parse errors will be detected)

=item oid components are limited to unsigned 32 bit integers

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

=item a 64 bit perl is required

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

=item only tested with 5.10

=back

=cut

package Net::SNMP::XS;

use strict qw(vars subs);
no warnings;

use Guard;

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

our $VERSION;
our $old_prepare;

BEGIN {
   $VERSION = '0.01';

   $old_prepare = \&Net::SNMP::MessageProcessing::prepare_data_elements;

   # this overrides many methods inside
   require XSLoader;
   XSLoader::load Net::SNMP::XS, $VERSION;
}

sub Net::SNMP::MessageProcessing::prepare_data_elements {
   my ($self, $msg) = @_;

   set_msg $msg, $msg->{_buffer};
   scope_guard \&clr_msg;
   &$old_prepare
}

# almost direct copy from Net::SNMP::Message, as we cannot access $process_methods
{
   package Net::SNMP::Message;

   my @process_methods;

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

   # should be done in XS
   sub process 
   {
#     my ($this, $expected, $found) = @_;

      return $_[0]->_error if defined($_[0]->{_error});
      return $_[0]->_error unless defined(my $type = _buffer_get($_[0], 1));

      $type = unpack 'C', $type;

      if ($process_methods[$type]) {
         if (@_ >= 2 && (defined $_[1]) && $type != $_[1]) {
            return $_[0]->_error(
               'Expected %s, but found %s', asn1_itoa($_[1]), asn1_itoa($type)
            );
         }
         $_[2] = $type if (@_ == 3);
         $process_methods[$type]->($_[0], $type);
      } else {
         $_[0]->_error('Unknown ASN.1 type [0x%02x]', $type);
      }
   }
}

1;

=head1 AUTHOR

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

=cut

Revision:	1.2
Committed:	Wed Apr 8 10:39:32 2009 UTC (15 years, 2 months ago) by root
Branch:	MAIN
Changes since 1.1:	+6 -0 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			# loading it is enough, there are no public symbols
10
11			=head1 DESCRIPTION
12
13			This module tries to speed up Net::SNMP response packet decoding.
14
15			It does this by overriding a few selected internal method by (almost)
16			equivalent XS methods.
17
18			This currently reduces decode time by some 70%.
19
20			There are currently the following limitations when using this module:
21
22			=over 4
23
24			=item leading dots are required for iods
25
26			=item error handling is currently broken (but parse errors will be detected)
27
28			=item oid components are limited to unsigned 32 bit integers
29
30			=item translation will be ignored (all values will be delivered "raw")
31
32	root	1.2	=item a 64 bit perl is required
33
34			=item a moderately modern (>= C99) C compiler is required
35
36			=item only tested with 5.10
37
38	root	1.1	=back
39
40			=cut
41
42			package Net::SNMP::XS;
43
44			use strict qw(vars subs);
45			no warnings;
46
47			use Guard;
48
49			use Net::SNMP::PDU ();
50			use Net::SNMP::Message ();
51			use Net::SNMP::MessageProcessing ();
52
53			our $VERSION;
54			our $old_prepare;
55
56			BEGIN {
57			$VERSION = '0.01';
58
59			$old_prepare = \&Net::SNMP::MessageProcessing::prepare_data_elements;
60
61			# this overrides many methods inside
62			require XSLoader;
63			XSLoader::load Net::SNMP::XS, $VERSION;
64			}
65
66			sub Net::SNMP::MessageProcessing::prepare_data_elements {
67			my ($self, $msg) = @_;
68
69			set_msg $msg, $msg->{_buffer};
70			scope_guard \&clr_msg;
71			&$old_prepare
72			}
73
74			# almost direct copy from Net::SNMP::Message, as we cannot access $process_methods
75			{
76			package Net::SNMP::Message;
77
78			my @process_methods;
79
80			$process_methods [INTEGER ] = \&_process_integer32;
81			$process_methods [OCTET_STRING ] = \&_process_octet_string;
82			$process_methods [NULL ] = \&_process_null;
83			$process_methods [OBJECT_IDENTIFIER] = \&_process_object_identifier;
84			$process_methods [SEQUENCE ] = \&_process_sequence;
85			$process_methods [IPADDRESS ] = \&_process_ipaddress;
86			$process_methods [COUNTER ] = \&_process_counter;
87			$process_methods [GAUGE ] = \&_process_gauge;
88			$process_methods [TIMETICKS ] = \&_process_timeticks;
89			$process_methods [OPAQUE ] = \&_process_opaque;
90			$process_methods [COUNTER64 ] = \&_process_counter64;
91			$process_methods [NOSUCHOBJECT ] = \&_process_nosuchobject;
92			$process_methods [NOSUCHINSTANCE ] = \&_process_nosuchinstance;
93			$process_methods [ENDOFMIBVIEW ] = \&_process_endofmibview;
94			$process_methods [GET_REQUEST ] = \&_process_get_request;
95			$process_methods [GET_NEXT_REQUEST ] = \&_process_get_next_request;
96			$process_methods [GET_RESPONSE ] = \&_process_get_response;
97			$process_methods [SET_REQUEST ] = \&_process_set_request;
98			$process_methods [TRAP ] = \&_process_trap;
99			$process_methods [GET_BULK_REQUEST ] = \&_process_get_bulk_request;
100			$process_methods [INFORM_REQUEST ] = \&_process_inform_request;
101			$process_methods [SNMPV2_TRAP ] = \&_process_v2_trap;
102			$process_methods [REPORT ] = \&_process_report;
103
104			# should be done in XS
105			sub process
106			{
107			# my ($this, $expected, $found) = @_;
108
109			return $_[0]->_error if defined($_[0]->{_error});
110			return $_[0]->_error unless defined(my $type = _buffer_get($_[0], 1));
111
112			$type = unpack 'C', $type;
113
114			if ($process_methods[$type]) {
115			if (@_ >= 2 && (defined $_[1]) && $type != $_[1]) {
116			return $_[0]->_error(
117			'Expected %s, but found %s', asn1_itoa($_[1]), asn1_itoa($type)
118			);
119			}
120			$_[2] = $type if (@_ == 3);
121			$process_methods[$type]->($_[0], $type);
122			} else {
123			$_[0]->_error('Unknown ASN.1 type [0x%02x]', $type);
124			}
125			}
126			}
127
128			1;
129
130			=head1 AUTHOR
131
132			Marc Lehmann <schmorp@schmorp.de>
133			http://home.schmorp.de/
134
135			=cut
136