AnyEvent-SNMP/SNMP.pm

=head1 NAME

AnyEvent::SNMP - adaptor to integrate Net::SNMP into Anyevent.

=head1 SYNOPSIS

 use AnyEvent::SNMP;
 use Net::SNMP;

 # just use Net::SNMP and AnyEvent as you like:

 # use a condvar to transfer results, this is
 # just an example, you can use a naked callback as well.
 my $cv = AnyEvent->condvar;

 # ... start non-blocking snmp request(s)...
 Net::SNMP->session (-hostname => "127.0.0.1",
                     -community => "public",
                     -nonblocking => 1)
          ->get_request (-callback => sub { $cv->send (@_) });

 # ... do something else until the result is required
 my @result = $cv->wait;

=head1 DESCRIPTION

This module implements an alternative "event dispatcher" for Net::SNMP,
using AnyEvent as a backend.

This integrates Net::SNMP into AnyEvent: You can make non-blocking
Net::SNMP calls and as long as other parts of your program also use
AnyEvent (or some event loop supported by AnyEvent), they will run in
parallel.

Also, the Net::SNMP scheduler is very inefficient with respect to both CPU
and memory usage. Most AnyEvent backends (including the pure-perl backend)
fare much better than the Net::SNMP dispatcher.

A potential disadvantage is that replacing the dispatcher is not at all
a documented thing to do, so future changes in Net::SNP might break this
module (or the many similar ones).

This module does not export anything and does not require you to do
anything special apart from loading it I<before doing any non-blocking
requests with Net::SNMP>. It is recommended but not required to load this
module before C<Net::SNMP>.

=cut

package AnyEvent::SNMP;

no warnings;
use strict qw(subs vars);

# it is possible to do this without loading
# Net::SNMP::Dispatcher, but much more awkward.
use Net::SNMP::Dispatcher;

sub Net::SNMP::Dispatcher::instance {
   AnyEvent::SNMP::
}

use Net::SNMP ();
use AnyEvent ();

our $VERSION = '0.11';

$Net::SNMP::DISPATCHER = instance Net::SNMP::Dispatcher;

our $MESSAGE_PROCESSING = $Net::SNMP::Dispatcher::MESSAGE_PROCESSING;

# avoid the method call
my $timer = sub { shift->timer (@_) };
AnyEvent::post_detect { $timer = AnyEvent->can ("timer") };

our $BUSY;
our %TRANSPORT; # address => [count, watcher]

sub _send_pdu {
   my ($pdu, $retries) = @_;

   # mostly copied from Net::SNMP::Dispatch

   # Pass the PDU to Message Processing so that it can
   # create the new outgoing message.
   my $msg = $MESSAGE_PROCESSING->prepare_outgoing_msg ($pdu);

   if (!defined $msg) {
      --$BUSY;
      # Inform the command generator about the Message Processing error.
      $pdu->status_information ($MESSAGE_PROCESSING->error);
      return; 
   }

   # Actually send the message.
   if (!defined $msg->send) {
      $MESSAGE_PROCESSING->msg_handle_delete ($pdu->msg_id)
         if $pdu->expect_response;

      # A crude attempt to recover from temporary failures.
      if ($retries-- > 0 && ($!{EAGAIN} || $!{EWOULDBLOCK} || $!{ENOSPC})) {
         my $retry_w; $retry_w = AnyEvent->$timer (after => $pdu->timeout, cb => sub {
            undef $retry_w;
            _send_pdu ($pdu, $retries);
         });
      } else {
         --$BUSY;
      }

      # Inform the command generator about the send() error.
      $pdu->status_information ($msg->error);
      return;
   }

   # Schedule the timeout handler if the message expects a response.
   if ($pdu->expect_response) {
      my $transport = $msg->transport;

      # register the transport
      unless ($TRANSPORT{$transport+0}[0]++) {
         $TRANSPORT{$transport+0}[1] = AnyEvent->io (fh => $transport->socket, poll => 'r', cb => sub {
            # Create a new Message object to receive the response
            my ($msg, $error) = Net::SNMP::Message->new (-transport => $transport);

            if (!defined $msg) {
               die sprintf 'Failed to create Message object [%s]', $error;
            }

            # Read the message from the Transport Layer
            if (!defined $msg->recv) {
               # for some reason, connected-oriented transports seem to need this
               unless ($transport->connectionless) {
                  delete $TRANSPORT{$transport+0}
                     unless --$TRANSPORT{$transport+0}[0];
               }

               $msg->error;
               return;
            }

            # For connection-oriented Transport Domains, it is possible to
            # "recv" an empty buffer if reassembly is required.
            if (!$msg->length) {
               return;
            }

            # Hand the message over to Message Processing.
            if (!defined $MESSAGE_PROCESSING->prepare_data_elements ($msg)) {
               $MESSAGE_PROCESSING->error;
               return;
            }

            # Set the error if applicable. 
            $msg->error ($MESSAGE_PROCESSING->error) if $MESSAGE_PROCESSING->error;

            # Cancel the timeout.
            my $rtimeout_w = $msg->timeout_id;
            if ($$rtimeout_w) {
               undef $$rtimeout_w;
               delete $TRANSPORT{$transport+0}
                  unless --$TRANSPORT{$transport+0}[0];

               --$BUSY;
            }

            # Notify the command generator to process the response.
            $msg->process_response_pdu; 
         });
      }

      #####d# timeout_id, wtf?
      $msg->timeout_id (\(my $rtimeout_w =
         AnyEvent->$timer (after => $pdu->timeout, cb => sub {
            my $rtimeout_w = $msg->timeout_id;
            if ($$rtimeout_w) {
               undef $$rtimeout_w;
               delete $TRANSPORT{$transport+0}
                  unless --$TRANSPORT{$transport+0}[0];
            }

            if ($retries--) {
               _send_pdu ($pdu, $retries);
            } else {
               --$BUSY;
               $MESSAGE_PROCESSING->msg_handle_delete ($pdu->msg_id);
               $pdu->status_information ("No response from remote host '%s'", $pdu->hostname);
            }
         })
      )); 
   } else {
     --$BUSY;
   }
}

sub send_pdu($$$) {
   my (undef, $pdu, $delay) = @_;

   ++$BUSY;

   if ($delay > 0) {
      my $delay_w; $delay_w = AnyEvent->$timer (after => $delay, cb => sub {
         undef $delay_w;
         _send_pdu ($pdu, $pdu->retries);
      });
      return 1;
   }

   _send_pdu $pdu, $pdu->retries;
   1
}

sub activate($) {
   AnyEvent->one_event while $BUSY;
}

sub one_event($) {
   die;
}

=head1 SEE ALSO

L<AnyEvent>, L<Net::SNMP>, L<Net::SNMP::EV>.

=head1 AUTHOR

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

=cut

1

Revision:	1.2
Committed:	Fri Apr 10 06:50:16 2009 UTC (15 years, 2 months ago) by root
Branch:	MAIN
CVS Tags:	rel-0_11
Changes since 1.1:	+1 -1 lines
Log Message:	0.11
#	Content
1	=head1 NAME
2
3	AnyEvent::SNMP - adaptor to integrate Net::SNMP into Anyevent.
4
5	=head1 SYNOPSIS
6
7	use AnyEvent::SNMP;
8	use Net::SNMP;
9
10	# just use Net::SNMP and AnyEvent as you like:
11
12	# use a condvar to transfer results, this is
13	# just an example, you can use a naked callback as well.
14	my $cv = AnyEvent->condvar;
15
16	# ... start non-blocking snmp request(s)...
17	Net::SNMP->session (-hostname => "127.0.0.1",
18	-community => "public",
19	-nonblocking => 1)
20	->get_request (-callback => sub { $cv->send (@_) });
21
22	# ... do something else until the result is required
23	my @result = $cv->wait;
24
25	=head1 DESCRIPTION
26
27	This module implements an alternative "event dispatcher" for Net::SNMP,
28	using AnyEvent as a backend.
29
30	This integrates Net::SNMP into AnyEvent: You can make non-blocking
31	Net::SNMP calls and as long as other parts of your program also use
32	AnyEvent (or some event loop supported by AnyEvent), they will run in
33	parallel.
34
35	Also, the Net::SNMP scheduler is very inefficient with respect to both CPU
36	and memory usage. Most AnyEvent backends (including the pure-perl backend)
37	fare much better than the Net::SNMP dispatcher.
38
39	A potential disadvantage is that replacing the dispatcher is not at all
40	a documented thing to do, so future changes in Net::SNP might break this
41	module (or the many similar ones).
42
43	This module does not export anything and does not require you to do
44	anything special apart from loading it I<before doing any non-blocking
45	requests with Net::SNMP>. It is recommended but not required to load this
46	module before C<Net::SNMP>.
47
48	=cut
49
50	package AnyEvent::SNMP;
51
52	no warnings;
53	use strict qw(subs vars);
54
55	# it is possible to do this without loading
56	# Net::SNMP::Dispatcher, but much more awkward.
57	use Net::SNMP::Dispatcher;
58
59	sub Net::SNMP::Dispatcher::instance {
60	AnyEvent::SNMP::
61	}
62
63	use Net::SNMP ();
64	use AnyEvent ();
65
66	our $VERSION = '0.11';
67
68	$Net::SNMP::DISPATCHER = instance Net::SNMP::Dispatcher;
69
70	our $MESSAGE_PROCESSING = $Net::SNMP::Dispatcher::MESSAGE_PROCESSING;
71
72	# avoid the method call
73	my $timer = sub { shift->timer (@_) };
74	AnyEvent::post_detect { $timer = AnyEvent->can ("timer") };
75
76	our $BUSY;
77	our %TRANSPORT; # address => [count, watcher]
78
79	sub _send_pdu {
80	my ($pdu, $retries) = @_;
81
82	# mostly copied from Net::SNMP::Dispatch
83
84	# Pass the PDU to Message Processing so that it can
85	# create the new outgoing message.
86	my $msg = $MESSAGE_PROCESSING->prepare_outgoing_msg ($pdu);
87
88	if (!defined $msg) {
89	--$BUSY;
90	# Inform the command generator about the Message Processing error.
91	$pdu->status_information ($MESSAGE_PROCESSING->error);
92	return;
93	}
94
95	# Actually send the message.
96	if (!defined $msg->send) {
97	$MESSAGE_PROCESSING->msg_handle_delete ($pdu->msg_id)
98	if $pdu->expect_response;
99
100	# A crude attempt to recover from temporary failures.
101	if ($retries-- > 0 && ($!{EAGAIN} \|\| $!{EWOULDBLOCK} \|\| $!{ENOSPC})) {
102	my $retry_w; $retry_w = AnyEvent->$timer (after => $pdu->timeout, cb => sub {
103	undef $retry_w;
104	_send_pdu ($pdu, $retries);
105	});
106	} else {
107	--$BUSY;
108	}
109
110	# Inform the command generator about the send() error.
111	$pdu->status_information ($msg->error);
112	return;
113	}
114
115	# Schedule the timeout handler if the message expects a response.
116	if ($pdu->expect_response) {
117	my $transport = $msg->transport;
118
119	# register the transport
120	unless ($TRANSPORT{$transport+0}[0]++) {
121	$TRANSPORT{$transport+0}[1] = AnyEvent->io (fh => $transport->socket, poll => 'r', cb => sub {
122	# Create a new Message object to receive the response
123	my ($msg, $error) = Net::SNMP::Message->new (-transport => $transport);
124
125	if (!defined $msg) {
126	die sprintf 'Failed to create Message object [%s]', $error;
127	}
128
129	# Read the message from the Transport Layer
130	if (!defined $msg->recv) {
131	# for some reason, connected-oriented transports seem to need this
132	unless ($transport->connectionless) {
133	delete $TRANSPORT{$transport+0}
134	unless --$TRANSPORT{$transport+0}[0];
135	}
136
137	$msg->error;
138	return;
139	}
140
141	# For connection-oriented Transport Domains, it is possible to
142	# "recv" an empty buffer if reassembly is required.
143	if (!$msg->length) {
144	return;
145	}
146
147	# Hand the message over to Message Processing.
148	if (!defined $MESSAGE_PROCESSING->prepare_data_elements ($msg)) {
149	$MESSAGE_PROCESSING->error;
150	return;
151	}
152
153	# Set the error if applicable.
154	$msg->error ($MESSAGE_PROCESSING->error) if $MESSAGE_PROCESSING->error;
155
156	# Cancel the timeout.
157	my $rtimeout_w = $msg->timeout_id;
158	if ($$rtimeout_w) {
159	undef $$rtimeout_w;
160	delete $TRANSPORT{$transport+0}
161	unless --$TRANSPORT{$transport+0}[0];
162
163	--$BUSY;
164	}
165
166	# Notify the command generator to process the response.
167	$msg->process_response_pdu;
168	});
169	}
170
171	#####d# timeout_id, wtf?
172	$msg->timeout_id (\(my $rtimeout_w =
173	AnyEvent->$timer (after => $pdu->timeout, cb => sub {
174	my $rtimeout_w = $msg->timeout_id;
175	if ($$rtimeout_w) {
176	undef $$rtimeout_w;
177	delete $TRANSPORT{$transport+0}
178	unless --$TRANSPORT{$transport+0}[0];
179	}
180
181	if ($retries--) {
182	_send_pdu ($pdu, $retries);
183	} else {
184	--$BUSY;
185	$MESSAGE_PROCESSING->msg_handle_delete ($pdu->msg_id);
186	$pdu->status_information ("No response from remote host '%s'", $pdu->hostname);
187	}
188	})
189	));
190	} else {
191	--$BUSY;
192	}
193	}
194
195	sub send_pdu($$$) {
196	my (undef, $pdu, $delay) = @_;
197
198	++$BUSY;
199
200	if ($delay > 0) {
201	my $delay_w; $delay_w = AnyEvent->$timer (after => $delay, cb => sub {
202	undef $delay_w;
203	_send_pdu ($pdu, $pdu->retries);
204	});
205	return 1;
206	}
207
208	_send_pdu $pdu, $pdu->retries;
209	1
210	}
211
212	sub activate($) {
213	AnyEvent->one_event while $BUSY;
214	}
215
216	sub one_event($) {
217	die;
218	}
219
220	=head1 SEE ALSO
221
222	L<AnyEvent>, L<Net::SNMP>, L<Net::SNMP::EV>.
223
224	=head1 AUTHOR
225
226	Marc Lehmann <schmorp@schmorp.de>
227	http://home.schmorp.de/
228
229	=cut
230
231	1
232