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, 1 month ago) by root
Branch:	MAIN
CVS Tags:	rel-0_11
Changes since 1.1:	+1 -1 lines
Log Message:	0.11
#	User	Rev	Content
1	root	1.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	root	1.2	our $VERSION = '0.11';
67	root	1.1
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