File Coverage

lib/SNMP/Effective.pm
Criterion Covered Total %
statement 10 12 83.3
branch 1 2 50.0
condition n/a
subroutine 4 4 100.0
pod n/a
total 15 18 83.3


line stmt bran cond sub pod time code
1             package SNMP::Effective;
2              
3             =head1 NAME
4              
5             SNMP::Effective - An effective SNMP-information-gathering module
6              
7             =head1 VERSION
8              
9             1.1101
10              
11             =head1 SYNOPSIS
12              
13             use SNMP::Effective;
14              
15             my $snmp = SNMP::Effective->new(
16             max_sessions => $NUM_POLLERS,
17             master_timeout => $TIMEOUT_SECONDS,
18             );
19              
20             $snmp->add(
21             dest_host => $ip,
22             callback => sub { store_data() },
23             get => [ '1.3.6.1.2.1.1.3.0', 'sysDescr' ],
24             );
25              
26             # lather, rinse, repeat
27              
28             # retrieve data from all hosts
29             $snmp->execute;
30              
31             =head1 DESCRIPTION
32              
33             This module collects information, over SNMP, from many hosts and many OIDs,
34             really fast.
35              
36             It is a wrapper around the facilities of C, which is the Perl
37             interface to the C libraries in the C package. Advantages of using
38             this module include:
39              
40             =over 4
41              
42             =item Simple configuration
43              
44             The data structures required by C are complex to set up before
45             polling, and parse for results afterwards. This module provides a simpler
46             interface to that configuration by accepting just a list of SNMP OIDs or leaf
47             names.
48              
49             =item Parallel execution
50              
51             Many users are not aware that C can poll devices asynchronously
52             using a callback system. By specifying your callback routine as in the
53             L section above, many network devices can be polled in parallel,
54             making operations far quicker. Note that this does not use threads.
55              
56             =item It's fast
57              
58             To give one example, C can walk, say, eight indexed OIDs
59             (port status, errors, traffic, etc) for around 300 devices (that's 8500 ports)
60             in under 30 seconds. Storage of that data might take an additional 10 seconds
61             (depending on whether it's to RAM or disk). This makes polling/monitoring your
62             network every five minutes (or less) no problem at all.
63              
64             =back
65              
66             The interface to this module is simple, with few options. The sections below
67             detail everything you need to know.
68              
69             =head1 METHODS ARGUMENTS
70              
71             The method arguments are very flexible. Any of the below acts as the same:
72              
73             $obj->method(MyKey => $value);
74             $obj->method(my_key => $value);
75             $obj->method(My_Key => $value);
76             $obj->method(mYK__EY => $value);
77              
78             =cut
79              
80 4     4   226441 use warnings;
  4         12  
  4         176  
81 4     4   25 use strict;
  4         9  
  4         222  
82 4 50   4   21 use constant DEBUG => $ENV{'SNMP_EFFECTIVE_DEBUG'} ? 1 : 0;
  4         6  
  4         360  
83 4     4   12103 use SNMP;
  0            
  0            
84             use SNMP::Effective::Host;
85             use SNMP::Effective::HostList;
86             use Time::HiRes qw/usleep/;
87             use POSIX qw(:errno_h);
88              
89             use base qw/ SNMP::Effective::Dispatch /;
90              
91             our $VERSION = '1.1101';
92             our %SNMPARG = (
93             Version => '2c',
94             Community => 'public',
95             Timeout => 1e6,
96             Retries => 2
97             );
98              
99             =head1 ATTRIBUTES
100              
101             =head2 master_timeout
102              
103             Get/Set the master timeout
104              
105             =head2 max_sessions
106              
107             Get/Set the number of max session
108              
109             =head2 hostlist
110              
111             Returns a list containing all the hosts.
112              
113             =head2 arg
114              
115             Returns a hash with the default args
116              
117             =head2 callback
118              
119             Returns a ref to the default callback sub-routine.
120              
121             =head2 heap
122              
123             Returns a value for the default heap.
124              
125             =cut
126              
127             BEGIN {
128             no strict 'refs';
129             my %sub2key = qw/
130             max_sessions maxsessions
131             master_timeout mastertimeout
132             _varlist _varlist
133             hostlist _hostlist
134             arg _arg
135             callback _callback
136             heap _heap
137             /;
138              
139             for my $subname (keys %sub2key) {
140             *$subname = sub {
141             my($self, $set) = @_;
142             $self->{ $sub2key{$subname} } = $set if(defined $set);
143             $self->{ $sub2key{$subname} };
144             }
145             }
146             }
147              
148             =head1 METHODS
149              
150             =head2 new
151              
152             This is the object constructor, and returns a L object.
153              
154             =head3 Arguments
155              
156             =over 4
157              
158             =item C
159              
160             Maximum number of simultaneous SNMP sessions.
161              
162             =item C
163              
164             Maximum number of seconds before killing execute.
165              
166             =back
167              
168             All other arguments are passed on to $snmp_effective->add( ... ).
169              
170             =cut
171              
172             sub new {
173             my $class = shift;
174             my %args = _format_arguments(@_);
175             my $self = (ref $class) ? $class : $class->_new_object(%args);
176              
177             $self->add(%args);
178              
179             return $self;
180             }
181              
182             sub _new_object {
183             my $class = shift;
184             my %args = @_;
185              
186             return bless {
187             maxsessions => 1,
188             mastertimeout => undef,
189             _sessions => 0,
190             _hostlist => SNMP::Effective::HostList->new,
191             _varlist => [],
192             _arg => {},
193             _callback => sub {},
194             %args,
195             }, $class;
196             }
197              
198             =head2 C
199              
200             Adding information about what SNMP data to get and where to get it.
201              
202             =head3 Arguments
203              
204             =over 4
205              
206             =item dest_host
207              
208             Either a single host, or an array-ref that holds a list of hosts. The format
209             is whatever L can handle.
210              
211             =item C
212              
213             A hash-ref of options, passed on to SNMP::Session.
214              
215             =item C
216              
217             A reference to a sub which is called after each time a request is finished.
218              
219             =item C
220              
221             This can hold anything you want. By default it's an empty hash-ref.
222              
223             =item C / C / C
224              
225             Either "oid object", "numeric oid", L or an
226             array-ref containing any combination of the above.
227              
228             =item C
229              
230             Either a single L or a L or an array-ref of any of
231             the above.
232              
233             =back
234              
235             This can be called with many different combinations, such as:
236              
237             =over 4
238              
239             =item C / any other argument
240              
241             This will make changes per dest_host specified. You can use this to change arg,
242             callback or add OIDs on a per-host basis.
243              
244             =item C / C / C / C
245              
246             The OID list submitted to L will be added to all dest_host, if no
247             dest_host is specified.
248              
249             =item C / C
250              
251             This can be used to alter all hosts' SNMP arguments or callback method.
252              
253             =back
254              
255             =cut
256              
257             sub add {
258             my $self = shift;
259             my %in = _format_arguments(@_) or return;
260             my $hostlist = $self->hostlist;
261             my $varlist = $self->_varlist;
262             my @new_varlist;
263              
264             # setup desthost input argument
265             if($in{'desthost'} and ref $in{'desthost'} ne 'ARRAY') {
266             $in{'desthost'} = [$in{'desthost'}];
267             warn "Adding host(@{ $in{'desthost'} })" if DEBUG;
268             }
269              
270             # add to varlist
271             for my $key (keys %SNMP::Effective::Dispatch::METHOD) {
272             next unless($in{$key});
273             $in{$key} = [$in{$key}] unless(ref $in{$key});
274              
275             if(@{$in{$key}}) {
276             warn "Adding $key(@{ $in{$key} })" if DEBUG;
277             unshift @{$in{$key}}, $key;
278             push @new_varlist, $in{$key};
279             }
280             }
281              
282             $in{'arg'} ||= delete $in{'args'};
283              
284             if(ref $in{'desthost'} eq 'ARRAY') {
285             for my $addr (@{$in{'desthost'}}) {
286              
287             # add/update hosts
288             my $host = $hostlist->get_host($addr)
289             || $hostlist->add_host(
290             address => $addr,
291             arg => $in{'arg'} || $self->arg,
292             callback => $in{'callback'} || $self->callback,
293             heap => $in{'heap'} || $self->heap,
294             );
295              
296             push @$host, (@$host or @new_varlist) ? @new_varlist : @$varlist;
297             $host->arg($in{'arg'}) if($in{'arg'});
298             $host->callback($in{'callback'}) if($in{'callback'});
299             $host->heap($in{'heap'}) if($in{'heap'});
300             }
301             }
302             else {
303              
304             # update $self with generic args
305             $self->arg($in{'arg'}) if(ref $in{'arg'} eq 'HASH');
306             $self->callback($in{'callback'}) if(ref $in{'callback'});
307             $self->heap($in{'heap'}) if(exists $in{'heap'});
308              
309             # update $self and all hosts with @new_varlist
310             if(@new_varlist) {
311             push @$varlist, @new_varlist;
312             for my $host (values %$hostlist) {
313             push @$host, @new_varlist;
314             }
315             }
316             }
317              
318             return 1;
319             }
320              
321             =head2 execute
322              
323             This method starts setting and/or getting data. It will run as long as
324             necessary, or until L seconds has passed. Every time some
325             data is set and/or retrieved, it will call the callback-method, as defined
326             globally or per host.
327              
328             =cut
329              
330             sub execute {
331             my $self = shift;
332              
333             unless(scalar($self->hostlist)) {
334             return 0;
335             }
336              
337             $self->_init_lock;
338              
339             if(my $timeout = $self->master_timeout) { # dispatch with master timeout
340             my $die_msg = "alarm_clock_timeout";
341              
342             warn "Execute dispatcher with timeout ($timeout)" if DEBUG;
343              
344             eval {
345             local $SIG{'ALRM'} = sub { die $die_msg };
346             alarm $timeout;
347             $self->dispatch and SNMP::MainLoop();
348             alarm 0;
349             };
350              
351             # check for timeout
352             if($@ and $@ =~ /$die_msg/mx) {
353             $self->master_timeout(0);
354             warn "Master timeout!" if DEBUG;
355             SNMP::finish();
356             }
357             elsif($@) {
358             die $@;
359             }
360             }
361             else { # dispatch without master timeout
362             warn "Execute dispatcher without timeout" if DEBUG;
363             $self->dispatch and SNMP::MainLoop();
364             }
365              
366             return 1;
367             }
368              
369             sub _create_session {
370             local $! = 0;
371              
372             my($self, $host) = @_;
373             my $snmp = SNMP::Session->new(%SNMPARG, $host->arg);
374              
375             unless($snmp) {
376             my($retry, $msg) = $self->_check_errno($!);
377             warn "SNMP session failed for host $host: $msg" if DEBUG;
378             return $retry ? '' : undef;
379             }
380              
381             warn "SNMP session created for $host" if DEBUG;
382              
383             return $snmp;
384             }
385              
386             sub _check_errno {
387             my($self, $err) = @_;
388             my $retry = 0;
389             my $errstr = '';
390              
391             if(not $err) {
392             $errstr = "Couldn't resolve hostname";
393             }
394             elsif($errstr = "$err") {
395             if(
396             $err == EINTR || # Interrupted system call
397             $err == EAGAIN || # Resource temp. unavailable
398             $err == ENOMEM || # No memory (temporary)
399             $err == ENFILE || # Out of file descriptors
400             $err == EMFILE # Too many open fd's
401             ) {
402             $errstr .= ' (will retry)';
403             $retry = 1;
404             }
405             }
406              
407             return $retry, $errstr;
408             }
409              
410             =head1 FUNCTIONS
411              
412             =head2 C
413              
414             Takes two arguments: One OID to match against, and the OID to match.
415              
416             match_oid("1.3.6.10", "1.3.6"); # return 10
417             match_oid("1.3.6.10.1", "1.3.6"); # return 10.1
418             match_oid("1.3.6.10", "1.3.6.11"); # return undef
419              
420             =cut
421              
422             sub match_oid {
423             my $p = shift or return;
424             my $c = shift or return;
425             return ($p =~ /^ \.? $c \.? (.*)/mx) ? $1 : undef;
426             }
427              
428             =head2 C
429              
430             Inverse of make_numeric_oid: Takes a list of mib-object strings, and turns
431             them into numeric format.
432              
433             make_numeric_oid("sysDescr"); # return .1.3.6.1.2.1.1.1
434              
435             =cut
436              
437             sub make_numeric_oid {
438             my @input = @_;
439              
440             for my $i (@input) {
441             next if($i =~ /^ [\d\.]+ $/mx);
442             $i = SNMP::translateObj($i);
443             }
444              
445             return wantarray ? @input : $input[0];
446             }
447              
448             =head2 C
449              
450             Takes a list of numeric OIDs and turns them into an mib-object string.
451              
452             make_name_oid("1.3.6.1.2.1.1.1"); # return sysDescr
453              
454             =cut
455              
456             sub make_name_oid {
457             my @input = @_;
458              
459             for my $i (@input) {
460             $i = SNMP::translateObj($i) if($i =~ /^ [\d\.]+ $/mx);
461             }
462              
463             return wantarray ? @input : $input[0];
464              
465             }
466              
467             sub _format_arguments {
468             return if(@_ % 2 == 1);
469              
470             my %args = @_;
471              
472             for my $k (keys %args) {
473             my $v = delete $args{$k};
474             $k = lc $k;
475             $k =~ s/_//gmx;
476             $args{$k} = $v;
477             }
478              
479             return %args;
480             }
481              
482             sub _init_lock {
483             my $self = shift;
484              
485             pipe my $READ, my $WRITE or die "Failed to create pipe: $!";
486             select +( select($READ), $| = 1 )[0];
487             select +( select($WRITE), $| = 1 )[0];
488             print $WRITE "\n";
489              
490             warn "Lock is ready and unlocked" if DEBUG;
491              
492             return $self->{'_lock_fh'} = [ $READ, $WRITE ];
493             }
494              
495             sub _wait_for_lock {
496             my $self = shift;
497             my $LOCK_FH = $self->{'_lock_fh'}->[0];
498              
499             warn "Waiting for lock to unlock..." if DEBUG;
500             defined readline $LOCK_FH or die "Failed to read from LOCK_FH: $!";
501             warn "The lock is now locked again" if DEBUG;
502              
503             return 1;
504             }
505              
506             sub _unlock {
507             my $self = shift;
508             my $LOCK_FH = $self->{'_lock_fh'}->[1];
509              
510             warn "Unlocking lock" if DEBUG;
511             print $LOCK_FH "\n";
512              
513             return 1;
514             }
515              
516             =head1 THE CALLBACK METHOD
517              
518             When C is done collecting data from a host, it calls a callback
519             method, provided by the C<< Callback => sub{} >> argument. Here is an example of a
520             callback method:
521              
522             sub my_callback {
523             my($host, $error) = @_
524              
525             if($error) {
526             warn "$host failed with this error: $error"
527             return;
528             }
529              
530             my $data = $host->data;
531              
532             for my $oid (keys %$data) {
533             print "$host returned oid $oid with this data:\n";
534              
535             print join "\n\t",
536             map { "$_ => $data->{$oid}{$_}" }
537             keys %{ $data->{$oid}{$_} };
538             print "\n";
539             }
540             }
541              
542             =head1 DEBUGGING
543              
544             Debugging is enabled through setting the environment variable
545              
546             SNMP_EFFECTIVE_DEBUG=1 perl myscript.pl
547              
548             It will print the debug information to STDERR.
549              
550             =head1 NOTES
551              
552             =over 4
553              
554             =item C
555              
556             L doesn't really do a SNMP native "walk". It makes a series
557             of "getnext", which is almost the same as SNMP's walk.
558              
559             =item C
560              
561             If you want to use SNMP SET, you have to build your own varbind:
562              
563             $varbind = SNMP::VarBind($oid, $iid, $value, $type);
564             $effective->add( set => $varbind );
565              
566             =back
567              
568             =head1 AUTHOR
569              
570             Jan Henning Thorsen, C<< >>
571              
572             =head1 BUGS
573              
574             Please report any bugs or feature requests to
575             C, or through the web interface at
576             L.
577             I will be notified, and then you'll automatically be notified of progress on
578             your bug as I make changes.
579              
580             =head1 ACKNOWLEDGEMENTS
581              
582             Various contributions by Oliver Gorwits.
583              
584             Sigurd Weisteen Larsen contributed with a better locking mechanism.
585              
586             =head1 COPYRIGHT & LICENSE
587              
588             Copyright 2007 Jan Henning Thorsen, all rights reserved.
589              
590             This program is free software; you can redistribute it and/or modify it
591             under the same terms as Perl itself.
592              
593             =cut
594              
595             1;
596              
597              
598             1;