File Coverage

blib/lib/Mojo/SNMP.pm
Criterion Covered Total %
statement 122 196 62.2
branch 47 94 50.0
condition 17 33 51.5
subroutine 21 34 61.7
pod 9 9 100.0
total 216 366 59.0


line stmt bran cond sub pod time code
1             package Mojo::SNMP;
2 12     12   188001 use Mojo::Base 'Mojo::EventEmitter';
  12         62683  
  12         56  
3 12     12   20226 use Mojo::IOLoop;
  12         904907  
  12         52  
4 12     12   4257 use Mojo::SNMP::Dispatcher;
  12         25  
  12         92  
5 12     12   9396 use Net::SNMP ();
  12         138891  
  12         257  
6 12     12   60 use Scalar::Util ();
  12         13  
  12         282  
7 12 50   12   40 use constant DEBUG => $ENV{MOJO_SNMP_DEBUG} ? 1 : 0;
  12         12  
  12         699  
8 12     12   40 use constant MAXREPETITIONS => 10;
  12         12  
  12         24173  
9              
10             our $VERSION = '0.12';
11              
12             my $DISPATCHER;
13             my @EXCLUDE_METHOD_ARGS = qw( maxrepetitions );
14             my %EXCLUDE = (
15             v1 => [qw( username authkey authpassword authprotocol privkey privpassword privprotocol )],
16             v2c => [qw( username authkey authpassword authprotocol privkey privpassword privprotocol )],
17             v3 => [qw( community )],
18             );
19              
20             my %SNMP_METHOD;
21             __PACKAGE__->add_custom_request_method(bulk_walk => \&_snmp_method_bulk_walk);
22             __PACKAGE__->add_custom_request_method(walk => \&_snmp_method_walk);
23              
24             $Net::SNMP::DISPATCHER = $Net::SNMP::DISPATCHER; # avoid warning
25              
26             has concurrent => 20;
27             has defaults => sub { +{} };
28             has master_timeout => 0;
29             has ioloop => sub { Mojo::IOLoop->singleton };
30              
31             # these attributes are experimental and therefore not exposed. Let me know if
32             # you use them...
33             has _dispatcher => sub { $DISPATCHER ||= Mojo::SNMP::Dispatcher->new(ioloop => shift->ioloop) };
34              
35             sub add_custom_request_method {
36 25     25 1 468 my ($class, $name, $cb) = @_;
37 25         39 $SNMP_METHOD{$name} = $cb;
38 25         33 $class;
39             }
40              
41             sub prepare {
42 18 100   18 1 13431 my $cb = ref $_[-1] eq 'CODE' ? pop : undef; # internal usage. might change
43 18         23 my $self = shift;
44 18 50       48 my $hosts = ref $_[0] eq 'ARRAY' ? shift : [shift];
45 18 100       59 my $args = ref $_[0] eq 'HASH' ? shift : {};
46 18         51 my %args = %$args;
47              
48 18 50 66     110 $hosts = [keys %{$self->{sessions} || {}}] if $hosts->[0] and $hosts->[0] eq '*';
  5 100       23  
49              
50 18   66     20 defined $args{$_} or $args{$_} = $self->defaults->{$_} for keys %{$self->defaults};
  18         43  
51 18   100     288 $args{version} = $self->_normalize_version($args{version} || '');
52 18         18 delete $args{$_} for @{$EXCLUDE{$args{version}}}, @EXCLUDE_METHOD_ARGS;
  18         98  
53 18         21 delete $args{stash};
54              
55             HOST:
56 18         28 for my $key (@$hosts) {
57 25         82 my ($host) = $key =~ /^([^|]+)/;
58 25         37 local $args{hostname} = $host;
59 25 100       60 my $key = $key eq $host ? $self->_calculate_pool_key(\%args) : $key;
60 25 50 66     100 $self->{sessions}{$key} ||= $self->_new_session(\%args) or next HOST;
61              
62 25         50 local @_ = @_;
63 25         51 while (@_) {
64 18         19 my $method = shift;
65 18 100       43 my $oid = ref $_[0] eq 'ARRAY' ? shift : [shift];
66 18         16 push @{$self->{queue}{$key}}, [$key, $method, $oid, $args, $cb];
  18         91  
67             }
68             }
69              
70 18   100     60 $self->{n_requests} ||= 0;
71              
72 18         46 for ($self->{n_requests} .. $self->concurrent - 1) {
73 9 100       38 my $queue = $self->_dequeue or last;
74 7         16 $self->_prepare_request($queue);
75             }
76              
77 18 50 66     157 $self->_setup if !$self->{_setup}++ and $self->ioloop->is_running;
78 18         401 $self;
79             }
80              
81             sub wait {
82 0     0 1 0 my $self = shift;
83 0         0 my $ioloop = $self->ioloop;
84 0         0 my $stop;
85              
86             $stop = sub {
87 0     0   0 $_[0]->unsubscribe(finish => $stop);
88 0         0 $_[0]->unsubscribe(timeout => $stop);
89 0         0 $ioloop->stop;
90 0         0 undef $stop;
91 0         0 };
92              
93 0 0       0 $self->_setup unless $self->{_setup}++;
94 0         0 $self->once(finish => $stop);
95 0         0 $self->once(timeout => $stop);
96 0         0 $ioloop->start;
97 0         0 $self;
98             }
99              
100             for my $method (qw( get get_bulk get_next set walk bulk_walk )) {
101 0 0   0 1 0 eval <<"HERE" or die $@;
  0 50   1 1 0  
  0 0   0 1 0  
  1 50   1 1 1389  
  1 0   0 1 5  
  1 0   0 1 4  
  0         0  
  0         0  
  0         0  
  1         27  
  1         5  
  1         5  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
102             sub $method {
103             my(\$self, \$host) = (shift, shift);
104             my \$args = ref \$_[0] eq 'HASH' ? shift : {};
105             \$self->prepare(\$host, \$args, $method => \@_);
106             }
107             1;
108             HERE
109             }
110              
111             sub _calculate_pool_key {
112 13 100   13   24 join '|', map { defined $_[1]->{$_} ? $_[1]->{$_} : '' } qw( hostname version community username );
  52         117  
113             }
114              
115             sub _dequeue {
116 13     13   16 my $self = shift;
117 13 50       13 my $key = (keys %{$self->{queue} || {}})[0] or return;
  13 100       60  
118 10         30 return delete $self->{queue}{$key};
119             }
120              
121             sub _finish {
122 1     1   1 warn "[Mojo::SNMP] Finish\n" if DEBUG;
123 1         2 $_[0]->emit('finish');
124 1         8 $_[0]->{_setup} = 0;
125             }
126              
127             sub _new_session {
128 10     10   17 my ($self, $args) = @_;
129 10         70 my ($session, $error) = Net::SNMP->new(%$args, nonblocking => 1);
130              
131 10         14808 warn "[Mojo::SNMP] New session $args->{hostname}: ", ($error || 'OK'), "\n" if DEBUG;
132 10 50   0   28 Mojo::IOLoop->next_tick(sub { $self->emit(error => "$args->{hostname}: $error") }) if $error;
  0         0  
133 10         39 $session;
134             }
135              
136             sub _normalize_version {
137 18 100   18   78 $_[1] =~ /1/ ? 'v1' : $_[1] =~ /3/ ? 'v3' : 'v2c';
    100          
138             }
139              
140             sub _prepare_request {
141 12     12   1119 my ($self, $queue) = @_;
142 12         14 my $item = shift @$queue;
143              
144 12 100       28 unless ($item) {
145 4 100       6 $queue = $self->_dequeue or return;
146 3         4 $item = shift @$queue;
147             }
148              
149 11         17 my ($key, $method, $list, $args, $cb) = @$item;
150 11         15 my $session = $self->{sessions}{$key};
151 11         13 my ($error, $success);
152              
153             # dispatch to our mojo based dispatcher
154 11         23 $Net::SNMP::DISPATCHER = $self->_dispatcher;
155              
156 11 100       118 unless ($session->transport) {
157 7         29 warn "[Mojo::SNMP] <<< open connection\n" if DEBUG;
158 7 50       20 unless ($session->open) {
159             Mojo::IOLoop->next_tick(
160             sub {
161 0 0   0   0 return $self->$cb($session->error, undef) if $cb;
162 0         0 return $self->emit(error => $session->error, $session, $args);
163             },
164 0         0 );
165 0   0     0 return $self->{n_requests} || '0e0';
166             }
167             }
168              
169 11         11984 warn "[Mojo::SNMP] <<< $method $key @$list\n" if DEBUG;
170 11         31 Scalar::Util::weaken($self);
171 11   66     41 $method = $SNMP_METHOD{$method} || "$method\_request";
172             $success = $session->$method(
173             $method =~ /bulk/ ? (maxrepetitions => $args->{maxrepetitions} || MAXREPETITIONS) : (),
174             ref $method ? (%$args) : (),
175             varbindlist => $list,
176             callback => sub {
177 2     2   1262 my $session = shift;
178              
179             eval {
180 2         9 local @$args{qw( method request )} = @$item[1, 2];
181 2         4 $self->{n_requests}--;
182 2 50       8 if ($session->var_bind_list) {
183 0         0 warn "[Mojo::SNMP] >>> success: $method $key @$list\n" if DEBUG;
184 0 0       0 return $self->$cb('', $session) if $cb;
185 0         0 return $self->emit(response => $session, $args);
186             }
187             else {
188 2         8 warn "[Mojo::SNMP] >>> error: $method $key @{[$session->error]}\n" if DEBUG;
189 2 50       6 return $self->$cb($session->error, undef) if $cb;
190 2         7 return $self->emit(error => $session->error, $session, $args);
191             }
192 0         0 1;
193 2 50       4 } or do {
194 0         0 $self->emit(error => $@);
195             };
196 2         86 warn "[Mojo::SNMP] n_requests: $self->{n_requests}\n" if DEBUG;
197 2         4 $self->_prepare_request($queue);
198 2         2 warn "[Mojo::SNMP] n_requests: $self->{n_requests}\n" if DEBUG;
199 2 100       8 $self->_finish unless $self->{n_requests};
200             },
201 11 100 50     107 );
    100          
202              
203 11 50       113 return ++$self->{n_requests} if $success;
204 0         0 $self->emit(error => $session->error, $session);
205 0   0     0 return $self->{n_requests} || '0e0';
206             }
207              
208             sub _setup {
209 2     2   982 my $self = shift;
210 2 50       5 my $timeout = $self->master_timeout or return;
211 2         11 my $tid;
212              
213 2         1 warn "[Mojo::SNMP] Timeout: $timeout\n" if DEBUG;
214 2         6 Scalar::Util::weaken($self);
215              
216             $tid = $self->ioloop->timer(
217             $timeout => sub {
218 2     2   2553 warn "[Mojo::SNMP] Timeout\n" if DEBUG;
219 2         13 $self->ioloop->remove($tid);
220 2         60 $self->emit('timeout');
221 2         55 $self->{_setup} = 0;
222             }
223 2         5 );
224             }
225              
226             sub _snmp_method_bulk_walk {
227 2     2   6 my ($session, %args) = @_;
228 2         4 my $base_oid = $args{varbindlist}[0];
229 2         3 my $last = $args{callback};
230 2   100     7 my $maxrepetitions = $args{maxrepetitions} || MAXREPETITIONS;
231 2         3 my ($callback, $end, %tree, %types);
232              
233             $end = sub {
234 0 0   0   0 if (scalar keys %tree) {
235 0         0 $session->pdu->var_bind_list(\%tree, \%types);
236             }
237             else {
238 0         0 $session->pdu->var_bind_list({$base_oid => 'noSuchObject'}, {$base_oid => Net::SNMP::NOSUCHOBJECT});
239             }
240 0         0 $session->$last;
241 0         0 $end = $callback = undef;
242 2         6 };
243              
244             $callback = sub {
245 0     0   0 my ($session) = @_;
246 0 0       0 my $res = $session->var_bind_list or return $end->();
247 0 0       0 my @sortres = $session->var_bind_names() or return $end->();
248 0         0 my $types = $session->var_bind_types;
249 0         0 my $next = $sortres[-1];
250              
251 0         0 for my $oid (@sortres) {
252 0 0 0     0 return $end->() if $types{$oid} or !Net::SNMP::oid_base_match($base_oid, $oid);
253 0         0 $types{$oid} = $types->{$oid};
254 0         0 $tree{$oid} = $res->{$oid};
255             }
256              
257 0 0       0 return $end->() unless $next;
258 0         0 return $session->get_bulk_request(maxrepetitions => $maxrepetitions, varbindlist => [$next], callback => $callback);
259 2         7 };
260              
261 2         6 $session->get_bulk_request(maxrepetitions => $maxrepetitions, varbindlist => [$base_oid], callback => $callback);
262             }
263              
264             sub _snmp_method_walk {
265 0     0     my ($session, %args) = @_;
266 0           my $base_oid = $args{varbindlist}[0];
267 0           my $last = $args{callback};
268 0           my ($callback, $end, %tree, %types);
269              
270             $end = sub {
271 0 0   0     $session->pdu->var_bind_list(\%tree, \%types) if %tree;
272 0           $session->$last;
273 0           $end = $callback = undef;
274 0           };
275              
276             $callback = sub {
277 0     0     my ($session) = @_;
278 0 0         my $res = $session->var_bind_list or return $end->();
279 0           my $types = $session->var_bind_types;
280 0           my @next;
281              
282 0           for my $oid (keys %$res) {
283 0 0 0       if (!$types{$oid} and Net::SNMP::oid_base_match($base_oid, $oid)) {
284 0           $types{$oid} = $types->{$oid};
285 0           $tree{$oid} = $res->{$oid};
286 0           push @next, $oid;
287             }
288             }
289              
290 0 0         return $end->() unless @next;
291 0           return $session->get_next_request(varbindlist => \@next, callback => $callback);
292 0           };
293              
294 0           $session->get_next_request(varbindlist => [$base_oid], callback => $callback);
295             }
296              
297             1;
298              
299             =encoding utf8
300              
301             =head1 NAME
302              
303             Mojo::SNMP - Run SNMP requests with Mojo::IOLoop
304              
305             =head1 VERSION
306              
307             0.12
308              
309             =head1 SYNOPSIS
310              
311             use Mojo::SNMP;
312             my $snmp = Mojo::SNMP->new;
313             my @response;
314              
315             $snmp->on(response => sub {
316             my($snmp, $session, $args) = @_;
317             warn "Got response from $args->{hostname} on $args->{method}(@{$args->{request}})...\n";
318             push @response, $session->var_bind_list;
319             });
320              
321             $snmp->defaults({
322             community => 'public', # v1, v2c
323             username => 'foo', # v3
324             version => 'v2c', # v1, v2c or v3
325             });
326              
327             $snmp->prepare('127.0.0.1', get_next => ['1.3.6.1.2.1.1.3.0']);
328             $snmp->prepare('localhost', { version => 'v3' }, get => ['1.3.6.1.2.1.1.3.0']);
329              
330             # start the IOLoop unless it is already running
331             $snmp->wait unless $snmp->ioloop->is_running;
332              
333             =head1 DESCRIPTION
334              
335             You should use this module if you need to fetch data from many SNMP servers
336             really fast. The module does its best to not get in your way, but rather
337             provide a simple API which allow you to extract information from multiple
338             servers at the same time.
339              
340             This module use L and L to fetch data from hosts
341             asynchronous. It does this by using a custom dispatcher,
342             L, which attach the sockets created by L
343             directly into the ioloop reactor.
344              
345             If you want greater speed, you should check out L and make sure
346             L is able to load.
347              
348             L is supposed to be a replacement for a module I wrote earlier,
349             called L. Reason for the rewrite is that I'm using the
350             framework L which includes an awesome IO loop which allow me to
351             do cool stuff inside my web server.
352              
353             =head1 CUSTOM SNMP REQUEST METHODS
354              
355             L provide methods to retrieve data from the SNMP agent, such as
356             L. It is possible to add custom methods if
357             you find yourself doing the same complicated logic over and over again.
358             Such methods can be added using L.
359              
360             There are two custom methods bundled to this package:
361              
362             =over 4
363              
364             =item * bulk_walk
365              
366             This method will run C until it receives an oid which does
367             not match the base OID. maxrepetitions is set to 10 by default, but could be
368             overrided by maxrepetitions inside C<%args>.
369              
370             Example:
371              
372             $self->prepare('192.168.0.1' => { maxrepetitions => 25 }, bulk_walk => [$oid, ...]);
373              
374             =item * walk
375              
376             This method will run C until the next oid retrieved does
377             not match the base OID or if the tree is exhausted.
378              
379             =back
380              
381             =head1 EVENTS
382              
383             =head2 error
384              
385             $self->on(error => sub {
386             my($self, $str, $session, $args) = @_;
387             });
388              
389             Emitted on errors which may occur. C<$session> is set if the error is a result
390             of a L method, such as L.
391              
392             See L for C<$args> description.
393              
394             =head2 finish
395              
396             $self->on(finish => sub {
397             my $self = shift;
398             });
399              
400             Emitted when all hosts have completed.
401              
402             =head2 response
403              
404             $self->on(response => sub {
405             my($self, $session, $args) = @_;
406             });
407              
408             Called each time a host responds. The C<$session> is the current L
409             object. C<$args> is a hash ref with the arguments given to L, with
410             some additional information:
411              
412             {
413             method => $str, # get, get_next, ...
414             request => [$oid, ...],
415             # ...
416             }
417              
418             =head2 timeout
419              
420             $self->on(timeout => sub {
421             my $self = shift;
422             })
423              
424             Emitted if L has been running for more than L seconds.
425              
426             =head1 ATTRIBUTES
427              
428             =head2 concurrent
429              
430             How many hosts to fetch data from at once. Default is 20. (The default may
431             change in later versions)
432              
433             =head2 defaults
434              
435             This attribute holds a hash ref with default arguments which will be passed
436             on to L. User-submitted C<%args> will be merged with the
437             defaults before being submitted to L. C will filter out
438             and ignore arguments that don't work for the SNMP C.
439              
440             NOTE: SNMP version will default to "v2c".
441              
442             =head2 master_timeout
443              
444             How long to run in total before timeout. Note: This is NOT per host but for
445             the complete run. Default is 0, meaning run for as long as you have to.
446              
447             =head2 ioloop
448              
449             Holds an instance of L.
450              
451             =head1 METHODS
452              
453             =head2 add_custom_request_method
454              
455             $self->add_custom_request_method(name => sub {
456             my($session, %args) = @_;
457             # do custom stuff..
458             });
459              
460             This method can be used to add custom L request methods. See the
461             source code for an example on how to do "walk".
462              
463             NOTE: This method will also replace any method, meaning the code below will
464             call the custom callback instead of L.
465              
466             $self->add_custom_request_method(get_next => $custom_callback);
467              
468             =head2 get
469              
470             $self->get($host, $args, \@oids, sub {
471             my($self, $err, $res) = @_;
472             # ...
473             });
474              
475             Will call the callback when data is retrieved, instead of emitting the
476             L event.
477              
478             =head2 get_bulk
479              
480             $self->get_bulk($host, $args, \@oids, sub {
481             my($self, $err, $res) = @_;
482             # ...
483             });
484              
485             Will call the callback when data is retrieved, instead of emitting the
486             L event. C<$args> is optional.
487              
488             =head2 get_next
489              
490             $self->get_next($host, $args, \@oids, sub {
491             my($self, $err, $res) = @_;
492             # ...
493             });
494              
495             Will call the callback when data is retrieved, instead of emitting the
496             L event. C<$args> is optional.
497              
498             =head2 prepare
499              
500             $self = $self->prepare($host, \%args, ...);
501             $self = $self->prepare(\@hosts, \%args, ...);
502             $self = $self->prepare(\@hosts, ...);
503             $self = $self->prepare('*' => ...);
504              
505             =over 4
506              
507             =item * $host
508              
509             This can either be an array ref or a single host. The "host" can be whatever
510             L can handle; generally a hostname or IP address.
511              
512             =item * \%args
513              
514             A hash ref of options which will be passed directly to L.
515             This argument is optional. See also L.
516              
517             =item * dot-dot-dot
518              
519             A list of key-value pairs of SNMP operations and bindlists which will be given
520             to L. The operations are the same as the method names available in
521             L, but without "_request" at end:
522              
523             get
524             get_next
525             set
526             get_bulk
527             inform
528             walk
529             bulk_walk
530             ...
531              
532             The special hostname "*" will apply the given operation to all previously
533             defined hosts.
534              
535             =back
536              
537             Examples:
538              
539             $self->prepare('192.168.0.1' => { version => 'v2c' }, get_next => [$oid, ...]);
540             $self->prepare('192.168.0.1' => { version => 'v3' }, get => [$oid, ...]);
541             $self->prepare(localhost => set => [ $oid => OCTET_STRING, $value, ... ]);
542             $self->prepare('*' => get => [ $oid ... ]);
543              
544             Note: To get the C constant and friends you need to do:
545              
546             use Net::SNMP ':asn1';
547              
548             =head2 set
549              
550             $self->set($host, $args => [ $oid => OCTET_STRING, $value, ... ], sub {
551             my($self, $err, $res) = @_;
552             # ...
553             });
554              
555             Will call the callback when data is set, instead of emitting the
556             L event. C<$args> is optional.
557              
558             =head2 walk
559              
560             $self->walk($host, $args, \@oids, sub {
561             my($self, $err, $res) = @_;
562             # ...
563             });
564              
565             Will call the callback when data is retrieved, instead of emitting the
566             L event. C<$args> is optional.
567              
568             =head2 bulk_walk
569              
570             $self->bulk_walk($host, $args, \@oids, sub {
571             my($self, $err, $res) = @_;
572             # ...
573             });
574              
575             Will call the callback when data is retrieved, instead of emitting the
576             L event. C<$args> is optional.
577              
578             =head2 wait
579              
580             This is useful if you want to block your code: C starts the ioloop and
581             runs until L or L is reached.
582              
583             my $snmp = Mojo::SNMP->new;
584             $snmp->prepare(...)->wait; # blocks while retrieving data
585             # ... your program continues after the SNMP operations have finished.
586              
587             =head1 AUTHOR
588              
589             Jan Henning Thorsen - C
590              
591             =head1 CONTRIBUTORS
592              
593             Espen Tallaksen - C
594              
595             Joshua Keroes - C
596              
597             Oliver Gorwits - C
598              
599             Per Carlson - C
600              
601             =head1 COPYRIGHT & LICENSE
602              
603             Copyright (C) 2012-2016, L and L.
604              
605             This library is free software. You can redistribute it and/or modify
606             it under the same terms as Perl itself.
607              
608             =cut