File Coverage

blib/lib/SNMP/Multi.pm
Criterion Covered Total %
statement 19 21 90.4
branch n/a
condition n/a
subroutine 7 7 100.0
pod n/a
total 26 28 92.8


line stmt bran cond sub pod time code
1             # $Id: Multi.pm,v 1.5 2003/12/18 02:35:29 toni Exp $
2             #
3             # SNMP::Multi -- Perl 5 object-oriented module to simplify SNMP operations
4             # on multiple simultaneous agents.
5             #
6             # Written by Karl "Rat" Schilke for Electric Lightwave, Inc.
7             # Copyright (c) 2000-2002 Electric Lightwave, all rights reserved.
8             #
9             # This software is provided I<``as is''> and without any express or implied
10             # warranties, including, without limitation, the implied warranties of
11             # merchantibility and/or fitness for a particular purpose.
12             #
13             # This program is free software; you may redistribute it and/or modify it
14             # under the same terms as Perl itself.
15              
16             =pod
17              
18             =head1 NAME
19              
20             SNMP::Multi - Perform SNMP operations on multiple hosts simultaneously
21              
22             =head1 SYNOPSIS
23              
24             use SNMP::Multi;
25              
26             my $req = SNMP::Multi::VarReq->new (
27             nonrepeaters => 1,
28             hosts => [ qw/ router1.my.com router2.my.com / ],
29             vars => [ [ 'sysUpTime' ], [ 'ifInOctets' ], [ 'ifOutOctets' ] ],
30             );
31             die "VarReq: $SNMP::Multi::VarReq::error\n" unless $req;
32              
33             my $sm = SNMP::Multi->new (
34             Method => 'bulkwalk',
35             MaxSessions => 32,
36             PduPacking => 16,
37             Community => 'public',
38             Version => '2c',
39             Timeout => 5,
40             Retries => 3,
41             UseNumeric => 1,
42             # Any additional options for SNMP::Session::new() ...
43             )
44             or die "$SNMP::Multi::error\n";
45              
46             $sm->request($req) or die $sm->error;
47             my $resp = $sm->execute() or die "Execute: $SNMP::Multi::error\n";
48              
49             print "Got response for ", (join ' ', $resp->hostnames()), "\n";
50             for my $host ($resp->hosts()) {
51              
52             print "Results for $host: \n";
53             for my $result ($host->results()) {
54             if ($result->error()) {
55             print "Error with $host: ", $result->error(), "\n";
56             next;
57             }
58              
59             print "Values for $host: ", (join ' ', $result->values());
60             for my $varlist ($result->varlists()) {
61             print map { "\t" . $_->fmt() . "\n" } @$varlist;
62             }
63             print "\n";
64             }
65             }
66              
67              
68             =head1 DESCRIPTION
69              
70             The SNMP::Multi package provides a mechanism to perform SNMP operations
71             on several hosts simultaneously. SNMP::Multi builds on G. Marzot's SNMP
72             Perl interface to the UC-Davis SNMP libraries, using asynchronous SNMP
73             operations to send queries/sets to multiple hosts simultaneously.
74              
75             Results from all hosts are compiled into a single object, which offers
76             methods to access the data in aggregate, or broken down by host or the
77             individual request.
78              
79             SNMP::Multi supports SNMP GET, SET, GETNEXT, GETBULK and BULKWALK requests.
80             It also performs PDU packing in order to improve network efficiency, when
81             packing is possible.
82              
83              
84             =head1 OPTIONS
85              
86             The SNMP::Multi constructor takes the following options to control its
87             behavior. Any other options are stored and handed to the SNMP::Session
88             constructor when a new SNMP session is created. As the behavior of
89             SNMP::Multi depends upon certain SNMP::Session parameters (i.e. Timeout),
90             these will be listed below as SNMP::Multi options. These "overlapped"
91             options will be passed un-changed to SNMP::Session's constructor.
92              
93             =item ``Method''
94              
95             =over 4
96              
97             Specify one of B, B, B, B or B. The
98             appropriate SNMP request will be made to each host for each set of variables
99             requested by the user.
100              
101             This parameter is required. There is no default value.
102              
103             =back
104              
105             =item ``Requests''
106              
107             =over 4
108              
109             The SNMP::Multi object may be given a new set of requests via the B
110             method, or by passing a reference to an SNMP::Multi::VarReq object into the
111             constructor. Any VarReq requests given to the SNMP::Multi object through the
112             constructor will be overwritten by subsequent calls to SNMP::Multi::request().
113              
114             This parameter is optional.
115              
116             =back
117              
118             =item ``PduPacking''
119              
120             =over 4
121              
122             The maximum number of variable requests that will be packed into a single SNMP
123             request is controlled by the ``PduPacking'' parameter. PDU packing improves
124             the efficiency and accuracy of SNMP requests by reducing the number of packets
125             exchanged. Setting this variable to '0' will disable PDU packing altogether.
126             PDU packing is not performed for SNMP GETBULK or BULKWALK requests.
127              
128             This optional parameter defaults to the value of $SNMP::Multi::pdupacking.
129              
130             =back
131              
132             =item ``MaxSessions''
133              
134             =over 4
135              
136             This variable controls the maximum number of SNMP sessions that will be kept
137             open simultaneously. Setting ``MaxSessions'' higher increases the number of
138             agents being queried at any time, up to the maximum limit of file descriptors
139             available to the process. SNMP::Multi detects "out of resources" conditions
140             (i.e. EMFILE) and adjusts the number of open connections accordingly.
141              
142             This optional parameter defaults to the value of $SNMP::Multi::maxsessions.
143              
144             =back
145              
146             =item ``Concurrent''
147              
148             =over 4
149              
150             The value of ``Concurrent'' limits the number of requests that may be
151             "in flight" at any time. It defaults to the value of ``MaxSessions''
152             (see above). Setting this value higher may reduce the overall runtime
153             of the SNMP::Multi request, but will also likely increase network
154             traffic and congestion (current maintainer has had SNMP::Multi running
155             smoothly with concurrent set to 512).
156              
157             This optional parameter defaults to the value of $SNMP::Multi::maxsessions
158             or the object's 'MaxSessions' parameter.
159              
160             =back
161              
162             =item ``GetbulkMax''
163              
164             =over 4
165              
166             Sets the default "maxrepetitions" value for SNMP GETBULK and BULKWALK requests.
167             This value may be overridden on a per-request basis (by specifying the
168             'maxrepetitions' parameter in the SNMP::Multi::VarReq constructor).
169              
170             This optional parameter defaults to the value of $SNMP::Multi::getbulkmax.
171              
172             =back
173              
174             =item ``ExternalSelect''
175              
176             =over 4
177              
178             If ``ExternalSelect'' is specified, the SNMP::Multi's B method
179             will return immediately after dispatching the first volley of SNMP requests.
180             The caller can then use B to get a list of the current
181             file descriptors for the SNMP sessions, and select() on them. When one of
182             the fd's becomes readable, it should be handed to SNMP::reply_cb() to handle
183             it.
184              
185             Note that SNMP bulkwalks use the callbacks to dispatch continuing GETBULK
186             requests. This causes the file descriptor to be readable, but SNMP::reply_cb()
187             calls an internal callback in SNMP.xs's bulkwalk implementation, not the
188             SNMP::Multi handler callback. When the walk completes, the SNMP::Multi
189             callback will be called with the specified arguments.
190              
191             =back
192              
193             =item ``Retries'' (shared with SNMP::Session)
194              
195             =over 4
196              
197             The ``Retries'' options specifies the maximum number of retries for each
198             SNMP request. Note that this is the number of retries, not the total number
199             of attempted requests.
200              
201             This optional parameter defaults to the value of $SNMP::Multi::maxretries.
202              
203             =back
204              
205             =item ``Timeout'' (shared with SNMP::Session)
206              
207             =over 4
208              
209             The ``Timeout'' parameter specifies the timeout in seconds between successive
210             retries for SNMP requests. The overall runtime for the complete SNMP::Multi
211             request will be approximately :
212              
213             (retries + 1) * timeout
214              
215             Please note that this is the lower-bound on the time-out. Without sufficient
216             resources (especially file descriptors) to optimize the network communications,
217             completing all requested SNMP operations can take considerably longer.
218              
219             An over-all timeout may be specified as the optional "timeout" parameter to
220             the SNMP::Multi's B method.
221              
222             This optional parameter defaults to the value of $SNMP::Multi::timeout.
223              
224             =back
225              
226             =item ``Community'' (shared with SNMP::Session)
227              
228             =over 4
229              
230             The ``Community'' parameter specifies the SNMP community string to use when
231             making requests from SNMP agents. No mechanism exists at this time to
232             specify a different community for individual agents.
233              
234             This optional parameter defaults to the value of $SNMP::Multi::community.
235              
236             =back
237              
238             =item ``Version'' (shared with SNMP::Session)
239              
240             =over 4
241              
242             The ``Version'' option specifies the SNMP protocol to use with the agents.
243             Due to the poor error reporting in SNMP v1, it is recommended that SNMP v2c
244             or v3 be used to communicate with the agents when possible.
245              
246             This optional parameter defaults to the value of $SNMP::Multi::snmpversion.
247              
248             =back
249              
250             =head1 METHODS
251              
252             The SNMP::Multi object provides several methods for the caller. In most cases,
253             only the B, B, and B methods need to be used. The
254             various methods are documented in approximately the order in which they are
255             normally called.
256              
257             =item SNMP::Multi::new(...)
258              
259             =over 4
260              
261             Create a new instance of an SNMP::Multi object. See above for a description of
262             the available constructor options.
263              
264             =back
265              
266             =item SNMP::Multi::request( )
267              
268             =over 4
269              
270             B arranges for the set of host/variable requests stored in the
271             SNMP::Multi::VarReq object to be transferred to the SNMP::Multi object. This
272             can also be done in the constructor using the ``requests'' option.
273              
274             Note that the B method is not cumulative -- previous requests will
275             be overwritten by subsequent calls to B.
276              
277             =item SNMP::Multi::execute( [timeout] )
278              
279             =over 4
280              
281             The B function performs the actual work in SNMP::Multi, returning
282             when all requests have been answered or timed out. An optional `timeout'
283             argument to B specifies an overall timeout, regardless of the
284             number and timing of retries.
285              
286             B returns a reference to an SNMP::Multi::Response object. This
287             object provides methods to conveniently access the returned data values.
288              
289             =back
290              
291             =item SNMP::Multi::error()
292              
293             =over 4
294              
295             If an error occurs while SNMP::Multi is executing, the caller may retrieve
296             a descriptive string describing the error from the B method.
297              
298             =back
299              
300             =item SNMP::Multi::remaining( $req )
301              
302             =over 4
303              
304             The B method produces an SNMP::Multi::VarReq that is populated
305             with the requests for any un-answered or un-sent request hunks. This VarReq
306             may then be passed to another SNMP::Multi object (or the same one). This
307             allows an application to loop on timeouts like this:
308              
309             my $req = SNMP::Multi::VarReq->new( ... );
310             my $sm = SNMP::Multi->new( ... );
311             while ($req) {
312             $sm->request($req);
313             my $resp = $sm->execute();
314             handle_response($resp);
315              
316             print "Timeout - retrying" if ($req = $sm->remaining());
317             }
318              
319             You can accumulate remaining requests by passing an already existing
320             SNMP::Multi::VarReq object as an argument. Remaining requests will
321             then be added to that object. That allows us to to collect all
322             remaining ones with ease, while looping over huge number of hosts.
323              
324             =back
325              
326             =head1 Building SNMP::Multi::VarReq Requests
327              
328             SNMP variable requests are composed and passed to the SNMP::Multi object
329             through an auxiliary class called an B. This class
330             simply collects SNMP requests for variables and hosts (and optionally
331             validates them).
332              
333             The interface to SNMP::Multi::VarReq is very simple, providing only B
334             and B methods. They take the following arguments:
335              
336             'vars' => [ list of Varbinds to be requested (REQUIRED) ]
337             'hosts' => [ list of hosts for this variable list ]
338             'nonrepeaters' => [ GETBULK/BULKWALK "nonrepeaters" parameter ]
339             'maxrepetitions' => [ GETBULK/BULKWALK "maxrepetitions" parameter ]
340              
341             Every call to new() or add() must contain a list of SNMP variables. If the
342             B parameter is not specified, the variable list will be requested from
343             all hosts currently known by the SNMP::Multi::VarReq object. If a host list
344             is given, the variables will be requested only from the named hosts.
345              
346             Some simple sanity checks can be performed on the VarReq by calling its
347             B method, or by setting $SNMP::Multi::VarReq::autovalidate to 1
348             before calling the B method.
349              
350             An example of building up a complicated request using new() and add():
351              
352             Start with:
353              
354             $r = SNMP::Multi::VarReq->new(
355             hosts => [ qw/ A B C / ],
356             vars => [ qw/ 1 2 3 / ]
357             );
358              
359             to get:
360              
361             A: 1 2 3
362             B: 1 2 3
363             C: 1 2 3
364              
365             Now add a var to each host:
366              
367             $r->add( vars => [ qw/ 4 / ] );
368              
369             to get:
370              
371             A: 1 2 3 4
372             B: 1 2 3 4
373             C: 1 2 3 4
374              
375             Add a var to a specific set of hosts:
376              
377             $r->add( hosts => [ qw/ A C / ],
378             vars => [ qw/ 5 / ] );
379              
380             to get:
381              
382             A: 1 2 3 4 5
383             B: 1 2 3 4
384             C: 1 2 3 4 5
385              
386             Finally, create two new hosts and add a pair of vars to them:
387              
388             $r->add( hosts => [ qw/ D E / ],
389             vars => [ qw/ 6 7 / ] );
390              
391             to get:
392              
393             A: 1 2 3 4 5
394             B: 1 2 3 4
395             C: 1 2 3 4 5
396             D: 6 7
397             E: 6 7
398              
399             The SNMP::Multi::VarReq object also provides a B method which
400             generates a simple dump of the current host/var requests.
401              
402             =head1 SNMP PDU Packing Features
403              
404             SNMP::Multi packs SNMP::Varbind requests into larger request "hunks" to reduce
405             the number of request/response pairs required to complete the SNMP::Multi
406             request. This packing is controlled by the SNMP::Multi 'PduPacking' parameter.
407              
408             For instance, assume your application creates an SNMP::Multi object with a
409             'PduPacking' value of 3. SNMP::Multi will pack 5 single SNMP variable
410             requests into two distinct requests. The first request will contain the first
411             3 variables, the second will get the remaining two variables.
412              
413             PDU packing is not done for SNMP GETBULK and BULKWALK requests. The feature
414             may be disabled by setting the 'PduPacking' parameter to '0'.
415              
416             =head1 Accessing SNMP Data From Agent Responses
417              
418             The SNMP::Multi::execute() method returns the responses from the SNMP agents
419             in an SNMP::Multi::Response object. This object, indexed by hostname, consists
420             of per-host response objects (SNMP::Multi::Response::Host's), each of which
421             contains a list of SNMP::Multi::Result objects. The Result objects connect
422             an SNMP::VarList with the error status (if any) from the SNMP request. An
423             entry is only made in the Response object if the SNMP agent returned some
424             response to SNMP::Multi.
425              
426             This is fairly complicated, but the various objects provide accessor methods
427             to make access to the SNMP responses simple. Assume your application is
428             structured something like this example source code:
429              
430             my $req = SNMP::Multi::VarReq->new( hosts => [...],
431             vars => [...] );
432             my $sm = SNMP::Multi->new( ... requests => $req, ... );
433             my $response = $sm->execute( $overall_timeout );
434             die $sm->error() if $sm->error();
435              
436             Now the data can be accessed through methods on the objects that make up the
437             SNMP::Multi::Response returned by execute(). An SNMP::VarList object is
438             returned for each variable requested. This normalizes the return format
439             across all SNMP operations (including bulkwalks).
440              
441             See the B section above for an example of how to access the SNMP
442             data values after calling the execute() method.
443              
444             =item SNMP::Multi::Response methods
445              
446             =over 4
447              
448             =item hostnames()
449              
450             =over 4
451              
452             Return a list of the hosts that responded to the SNMP queries made by execute().
453              
454             =back
455              
456             =item values()
457              
458             =over 4
459              
460             Return all values returned by the SNMP agents, collated into a single list.
461             This method can be used when the application is not concerned with which value
462             was returned by a specific host (i.e. summing up octet counts on router
463             interfaces).
464              
465             =back
466              
467             =item hosts()
468              
469             =over 4
470              
471             Returns a list of SNMP::Multi::Response::Host objects, one per host queried
472             by the SNMP::Multi::execute() method.
473              
474             =back
475              
476             =back
477              
478             =back
479              
480             =item SNMP::Multi::Response::Host methods
481              
482             =over 4
483              
484             =item hostname()
485              
486             =over 4
487              
488             Return the hostname associated with this set of responses. The reference may
489             also be stringified to get the hostname :
490              
491             print "This is the list of results for $host: \n";
492              
493             =back
494              
495             =item values()
496              
497             =over 4
498              
499             Return all values received in response to requests made to the associated host.
500              
501             =back
502              
503             =item results()
504              
505             =over 4
506              
507             Returns a list of SNMP::Multi::Result objects for this host. There is one
508             Result object for each request sent to the SNMP agent on this host.
509              
510             =back
511              
512             =back
513              
514             =item SNMP::Multi::Result methods
515              
516             The SNMP::Multi::Result object correlates SNMP error information with the
517             response to an SNMP request.
518              
519             =over 4
520              
521             =item error()
522              
523             =over 4
524              
525             Return a printable string describing the error encountered for this variable,
526             or undef if no error occurred.
527              
528             =back
529              
530             =item values()
531              
532             =over 4
533              
534             Return a list of the values received for this request.
535              
536             =back
537              
538             =item varlists()
539              
540             =over 4
541              
542             Return an array of SNMP::VarList objects, one per variable requested in the
543             SNMP packet. This format is consistent for all SNMP operations, and is
544             required to support bulkwalks (in which the number of returned values per
545             variable is not known a priori to the calling application).
546              
547             =back
548              
549             =back
550              
551             =head1 EXAMPLES
552              
553             A complete example is given in the "SYNOPSIS" section above.
554              
555             =head1 CAVEATS
556              
557             The VarList returned for GETBULK requests is "decoded" by SNMP::Multi into an
558             array of single VarLists, one for each requested variable. This behavior
559             differs from the return from the getbulk() method in the SNMP.pm module, but
560             is consistent with the return value of SNMP.pm's bulkwalk() method.
561              
562             Note that the V1 SNMP protocol has very limited error reporting (the agent
563             returns no values, and the 'errind' is set to the index of the offending
564             SNMP variable request). The SNMP::Multi module adjusts the 'errind' index
565             to indicate which of the variables request requested for a host have failed,
566             regardless of the number of actual packets exchanged. This is necessary to
567             support SNMP::Multi's transparent pdu-packing feature.
568              
569             SNMP::Multi relies on features added to the SNMP module by Electric
570             Lightwave, Inc. These features have been incorporated into UCD-SNMP
571             releases 4.2 and later. You must have SNMP 4.2 or later installed
572             to use this package.
573              
574             Using SNMP::Multi with large numbers of hosts or large requests may cause
575             network congestion. All targets may send PDU's to the originating host
576             simultaneously, which could cause heavy traffic and/or dropped packets
577             at the host. Adjusting the I and I variables can
578             mitigate this problem.
579              
580             Network congestion may be a serious problem for bulkwalks, due to multiple
581             packets being exchanged per session. However, network latency and variable
582             target response times cause packets in multiple bulkwalk exchanges to become
583             spread out as the walk progresses. The initial exchange, however, will always
584             cause congestion.
585              
586             =head1 BUGS
587              
588             There is no interface to specify a different SNMP community string for a
589             specific host, although the community is stored on a per-host basis.
590              
591             =head1 SEE ALSO
592              
593             L, the NetSNMP homepage at http://www.net-snmp.org/.
594              
595             =head1 AUTHOR
596              
597             Karl ("Terminator rAT") Schilke
598              
599             =head1 CONTRIBUTORS
600              
601             Joshua Keroes, Todd Caine, Toni Prug
602              
603             =head1 COPYRIGHT
604              
605             Developed by Karl "Terminator rAT" Schilke for Electric Lightwave, Inc.
606             Copyright (c) 2000-2002 Electric Lightwave, Inc. All rights reserved.
607              
608             Co-maintained by Toni Prug.
609              
610             This software is provided I<``as is''> and without any express or implied
611             warranties, including, without limitation, the implied warranties of
612             merchantibility and/or fitness for a particular purpose.
613              
614             This program is free software; you may redistribute it and/or modify it
615             under the same terms as Perl itself.
616              
617             =cut
618              
619             #-----------------------------------------------------------------------------
620             package SNMP::Multi;
621             #-----------------------------------------------------------------------------
622              
623             require 5.005_62;
624 1     1   1127 use strict;
  1         1  
  1         40  
625 1     1   4 use warnings;
  1         2  
  1         36  
626              
627 1     1   5 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
  1         14  
  1         102  
628              
629             require Exporter;
630              
631             @ISA = qw(Exporter);
632             @EXPORT = qw( );
633              
634             $VERSION = "2.1";
635              
636             # Global variables that can be set by the user, used to set defaults for
637             # unspecified values in constructors, etc.
638             #
639 1         224 use vars qw/$DEBUGGING $error $timeout $retries $verbose
640             $pdupacking $maxsessions $community $snmpversion
641 1     1   5 $getbulkmax $fatalwarn $timestamps $usenumeric %_handler/;
  1         1  
642              
643             $DEBUGGING = 0;
644             $error = undef; # SNMP::Multi global error (used by new()).
645             $timeout = 30; # SNMP timeout value.
646             $retries = 5; # Maximum number of retries per request
647             $verbose = 0; # Be verbose if non-zero.
648             $pdupacking = 16; # Max number of vars to pack into one PDU
649             $maxsessions = 16; # Max SNMP sessions to open.
650             $community = 'public'; # Default SNMP community string.
651             $snmpversion = '2c'; # Default SNMP protocol version number.
652             $getbulkmax = 100; # Default maximum repeaters for GETBULK
653             $fatalwarn = 0; # Croak on non-fatal exceptions (if true).
654             $timestamps = 0; # Add timestamps to received vars
655             $usenumeric = 1; # Don't convert iod's to strings, keep numeric
656              
657             # Error message "catalog".
658             my %errors = (
659             TIMED_OUT => "SNMP::Multi timed out",
660             );
661              
662             # Use more user-friendly warning/fatal routines.
663 1     1   5 use Carp;
  1         2  
  1         100  
664              
665             # Get system error numbers for checking $!.
666 1     1   1354 use POSIX qw(:errno_h);
  1         6130  
  1         6  
667              
668             # Use ELI-specific SNMP code. This is necessary for the following features:
669             #
670             # - SNMP::finish() to interrupt SNMP::MainLoop()
671             # - SNMP::bulkwalk() to perform bulkwalks
672             # - Timestamps on returned Varbinds.
673 1     1   2770 use SNMP;
  0            
  0            
674             #$SNMP::dump_packet = 1;
675              
676             # "Private" state variables used by SNMP::Multi.
677             %_handler = (
678             'set' => \&_handle_VarList, # These return a VarList, which must
679             'get' => \&_handle_VarList, # be converted into an array of single-
680             'getnext' => \&_handle_VarList, # Varbind VarLists for storage, unlike
681             'getbulk' => \&_handle_VarList, # the bulkwalk() method.
682             'bulkwalk' => \&_handle_AoVarLists, # Returns array of VarLists already.
683             );
684              
685             # "Nag" -- carp or croak depending on $fatalwarn. The carp() is not reached
686             # if we call croak() first (sort of an implied "else" there... 8^).
687             #
688             sub _nag { croak (@_) if $fatalwarn; carp(@_); }
689              
690             #------------- SNMP::Multi PUBLIC INTERFACE FUNCTIONS -----------------------
691             #
692             # Construct a new SNMP::Multi object and initialize the private metadata for
693             # the object.
694             #
695             sub new {
696             my $self = shift;
697             my $class = ref($self) || $self;
698              
699             my %args = @_;
700              
701             my $obj = { };
702             bless $obj, $class;
703              
704             # Require the object method to be defined and match one of the sending
705             # functions in %_handler ...
706             #
707             unless (defined $args{Method} && exists $_handler{lc $args{Method}}) {
708             _nag "Constructor SNMP 'method' must be one of ",
709             join ', ', (sort keys %_handler);
710             return undef;
711             }
712              
713             # Set up default values if they were not defined by the user.
714             #
715             $obj->{Method} = lc $args{Method};
716             $obj->{Timeout} = $args{Timeout} || $timeout;
717             $obj->{Retries} = $args{Retries} || $retries;
718             $obj->{Verbose} = $args{Verbose} || $verbose;
719             $obj->{MaxSessions} = $args{MaxSessions} || $maxsessions;
720             $obj->{Concurrent} = $args{Concurrent} || $obj->{MaxSessions};
721             $obj->{Community} = $args{Community} || $community;
722             $obj->{Version} = $args{Version} || $snmpversion;
723             $obj->{GetbulkMax} = $args{GetbulkMax} || $getbulkmax;
724             $obj->{TimeStamp} = $args{TimeStamp} || $timestamps;
725             $obj->{UseNumeric} = $args{UseNumeric} || $usenumeric;
726              
727             # Flag case where execute() should return after dispatching the first
728             # volley of SNMP requests. This is useful if you need to do the select
729             # and callbacks externally to SNMP::Multi (i.e. when integrating with
730             # POE or other select-based frameworks).
731             #
732             $obj->{ExternalSelect} = $args{ExternalSelect} || 0;
733              
734             # Need to handle this carefully -- '0' is a good value for pdupacking.
735             $obj->{PduPacking} = $args{PduPacking};
736             $obj->{PduPacking} = $pdupacking unless defined $obj->{PduPacking};
737              
738             $obj->{error} = undef; # Overall error.
739             $obj->{_remain} = 0; # Number of outstanding requests.
740             $obj->{_nsessions} = 0; # Number of current SNMP sessions
741             $obj->{_inflight} = 0; # Number of currently pending requests
742             $obj->{_hosts} = { }; # Per-host context, hashed by name
743             $obj->{_sessions} = { }; # Per-host SNMP session objects.
744              
745             # Fix some minor stuff.
746             $obj->{Version} =~ s/^v//; # Remove 'v' from 'v2c', etc.
747              
748             # Initialize the object's request list, if a VarReq was passed in.
749             # If the method fails, copy the object's error field to the SNMP::Multi
750             # global error variable -- the object is destroyed before the caller
751             # could see the error message otherwise. $obj->request() will create
752             # an empty SNMP::Multi::Response for us.
753             #
754             if (exists $args{Requests}) {
755             unless (defined $obj->request($args{Requests})) {
756             $error = $obj->error();
757             return undef;
758             }
759             delete $args{Requests};
760              
761             } else {
762             # Setup an empty S::M::Response for this object. Presumably the
763             # caller will call $obj->request() to fill it in later.
764             #
765             $obj->{_response} = SNMP::Multi::Response->new();
766             }
767              
768             # Remove any SNMP::Multi-specific options from the caller's arguments,
769             # and store the resulting pairs as an array. This will be handed to the
770             # SNMP::Session constructor. Get rid of some silly things as well.
771             #
772             for my $key (keys %$obj) {
773             next if $key =~ m/^_/;
774             delete $args{$key};
775             }
776              
777             delete $args{SessPtr};
778             delete $args{DestHost};
779             delete $args{DestAddr};
780              
781             $obj->{_SNMPArgs} = [ %args ];
782              
783             return $obj;
784             }
785              
786             # Take an SNMP::Multi::VarReq structure and apply the SNMP::Multi object's
787             # PDU packing parameters to convert the raw request blocks into chunks that
788             # will be scheduled for transmission by the execute() engine.
789             #
790             sub request {
791             my ($multi, $vreq) = @_;
792              
793             my $count = 0;
794              
795             # Take the VarReq a host at a time, and pack the data onto the internal
796             # _host structures. This list may or may not be sorted -- we don't really
797             # care.
798             #
799             my @hosts = $vreq->hosts();
800             for my $host (@hosts) {
801             my $reqs = $vreq->requests($host);
802              
803             croak "VarReq didn't return a request list!" unless defined $reqs;
804              
805             # If it doesn't already exist, initialize this host's metadata.
806             unless (exists $multi->{_hosts}{$host}) {
807             next unless $multi->_init_host($host);
808             }
809              
810             my $reqno = 0;
811             for my $req (@$reqs) {
812             $reqno++;
813              
814             my $did = $multi->_pack_request($host, $req);
815              
816             unless ($did) {
817             $multi->error("Failed packing request $reqno for host $host");
818             return undef;
819             }
820             $count += $did;
821             }
822             }
823              
824             # Clear out any old contents in the Multi's Response field.
825             $multi->{_response} = SNMP::Multi::Response->new();
826              
827             return $count;
828             }
829              
830             # "Execute" the requests queued for each host.
831             # Note: Caller should check $multi->error() to see if an error or timeout
832             # occurred.
833             #
834             sub execute {
835             my $multi = shift;
836             my $timeout = shift;
837              
838             if (!defined $timeout) {
839             if ($multi->{Retries} >= 1) {
840             $timeout = $multi->{Timeout} * ($multi->{Retries} + 1);
841             } else {
842             $timeout = 0;
843             }
844             }
845              
846             # Get the initial order of the requests. Currently only round-robin
847             # is supported (and, in fact, the argument is ignored).
848             #
849             my $rreqlist = $multi->_order_reqs('round-robin');
850             return undef unless defined $rreqlist;
851             $multi->{_reqlist} = $rreqlist;
852              
853             # Initiate the transmission of the requests. This will send to no more
854             # than '$multi->concurrent' hosts at once. Any requests that were not
855             # transmitted by this initial call will be sent during callbacks.
856             #
857             return undef unless $multi->_dispatch();
858              
859             # In order to facilitate using SNMP::Multi with other select loops (i.e.
860             # in a POE-based collector), we offer the option to allow an external
861             # callback loop with SNMP::select_info() and SNMP::reply_cb(). If the
862             # execute() method is called with Multi's "ExternalSelect" option, it
863             # returns immediately after the initial set of requests is dispatched.
864             # The caller is responsible for select()ing on the fd's, and calling
865             # SNMP::reply_cb() on each one. Caller should also check the return
866             # status of SNMP::Multi::complete() to see if the Multi is completed.
867             # After completion, the responses are available to the caller through
868             # the SNMP::Multi::response() method.
869             #
870             # Note that the caller must implement the "overall timeout" if needed.
871             #
872             return 1 if $multi->{'ExternalSelect'};
873              
874             # Now wait for the replies to come back, and possibly transmit any
875             # additional requests.
876             #
877             SNMP::MainLoop($timeout, [ \&_timeout, $multi ]);
878              
879             print "All requests completed or timed out.\n" if $DEBUGGING;
880              
881             # Caller should check $multi->error() to see if an error or timeout
882             # occurred.
883             return $multi->{_response};
884             }
885              
886             # Accessor functions for values in the SNMP::Multi object. If modifying
887             # the value, these return the original value (as before the modify).
888             #
889             sub verbose {
890             my $self = shift;
891             my $old = $self->{Verbose};
892             $self->{Verbose} = shift if @_;
893             return $old;
894             }
895             sub error {
896             my $self = shift;
897             my $old = $self->{error};
898             $self->{error} = shift if @_;
899             return $old;
900             }
901              
902             sub remaining {
903             my $self = shift;
904             my $remain = shift || SNMP::Multi::VarReq->new();
905             my $anyleft = 0;
906              
907             my $resp = $self->{_response};
908             my @hosts = keys %{$self->{_hosts}};
909             for my $host (@hosts) {
910             my $reqs = $self->{_hosts}{$host}{requests};
911             for (my $index = 0; $index < @$reqs; $index ++) {
912             next if $resp->get_result($host, $index);
913              
914             my $r = $reqs->[$index];
915             $remain->add(hosts => [ $host ], vars => $r);
916             $anyleft = 1;
917             }
918             }
919              
920             return $anyleft ? $remain : undef;
921             }
922             sub response {
923             my $multi = shift;
924             return $multi->{_response};
925             }
926              
927             #------------- SNMP::Multi PRIVATE INTERFACE FUNCTIONS ----------------------
928              
929             # Handle timeout from SNMP::MainLoop(). Set the error flag in the Multi
930             # object, and arrange for the MainLoop() to terminate.
931             sub _timeout {
932             my $self = shift;
933              
934             if ($DEBUGGING) {
935             print "Timed out with "
936             . $self->{_inflight} . " requests in flight, "
937             . "on $self->{_nsessions} open sessions:\n";
938             print " ",
939             (join ', ', sort keys %{$self->{_sessions}}),
940             "\n";
941             }
942              
943             $self->{error} = $errors{TIMED_OUT};
944             SNMP::finish();
945             }
946              
947             # Create a new set of metadata for a single host. This metadata will keep
948             # track of things like variable requests, number of remaining requests, SNMP
949             # session data, etc.
950             #
951             sub _init_host {
952             my ($multi, $host) = @_;
953              
954             _nag "_init_host: undefined hostname", return undef unless defined $host;
955              
956             # Create a new hash for the host information and initialize it with the
957             # appropriate variables and objects.
958             #
959             my $hent = { };
960              
961             # These fields are all arrays, with an element for each Request requested
962             # for this host. They are populated as the Requests are added to the host
963             # structure.
964             #
965             $hent->{requests} = []; # SNMP::VarLists of reqs for this host
966             $hent->{sendargs} = []; # Add'tl arguments for send functions
967             $hent->{reqoffs} = []; # Offsets of each set of vars in the requests
968              
969             # These fields contain counters, references to other objects, and other
970             # scalar data.
971             #
972             $hent->{remain} = 0; # Count of requests remaining for host
973              
974             # Default SNMP version and community strings. The user should be able to
975             # specify a per-host version and community, but it's not yet implemented.
976             #
977             $hent->{community} = $multi->{Community};
978             $hent->{snmpversion} = $multi->{Version};
979              
980             # Place the completed metadata into the Multi's %_hosts hash and return
981             # the reference.
982             #
983             $multi->{_hosts}{$host} = $hent;
984              
985             print "New host $host\n" if $DEBUGGING;
986             return $hent;
987             }
988              
989             # Build an SNMP::VarList out of variables. This is directly stolen from the
990             # SNMP perl module, so should have roughly the same look and feel ;^).
991             #
992             sub _build_varlist {
993             my $vars = shift;
994             $vars = shift if (ref($vars) =~ /MultiGet::/); # function or method
995              
996             my $vlref = undef;
997              
998             if (ref($vars) =~ /SNMP::VarList/) { # Already a VarList, so use
999             $vlref = $vars; # it unmodified.
1000              
1001             } elsif (ref($vars) =~ /SNMP::Varbind/) { # A VarList is just an array
1002             $vlref = [$vars]; # of Varbind's, so build it.
1003              
1004             } elsif (ref($vars) =~ /ARRAY/) { # Array of Varbinds.
1005             $vlref = [$vars];
1006             $vlref = $vars if ref($$vars[0]) =~ /ARRAY/; # oops, array of arrays
1007              
1008             } else {
1009             # Parse the string into tag and iid (if declared), and create a VarList
1010             # with one Varbind from the values.
1011             my ($tag, $iid) = ($vars =~ /^((?:\.\d+)+|\w+)\.?(.*)$/);
1012              
1013             $vlref = [[$tag, $iid]];
1014              
1015             }
1016              
1017             bless ($vlref, 'SNMP::VarList');
1018             }
1019              
1020             # Pack the SNMP variables in a Request onto the requests queues for the
1021             # hosts, creating chunks of no more than the $multi->PduPacking variables.
1022             # Note that this is not done for getbulk and bulkwalk requests -- packing
1023             # them would destroy the non-repeater/repeater distinction.
1024             #
1025             sub _pack_request {
1026             my ($multi, $host, $req) = @_;
1027              
1028             my $count = 0; # Count of requests added
1029             my $maxvars = $multi->{PduPacking}; # Max vars per request
1030             my @args = (); # Extra args for this chunk
1031             my $rhost = undef;
1032              
1033             $rhost = $multi->{_hosts}{$host};
1034             unless ($rhost) {
1035             print "Failed to look up $host in hosts\n" if $DEBUGGING;
1036             return undef;
1037             }
1038              
1039             print "Packing request for $host (", scalar @{$req->{vars}}," vars)\n"
1040             if $DEBUGGING;
1041              
1042             # Find index of the last hunk on the reqlist, and get a reference to the
1043             # last VarList (the contents of the last element) if there is one (i.e.
1044             # $last isn't -1).
1045             #
1046             my $last = $#{$rhost->{requests}};
1047             my $target = ($last >= 0) ? $rhost->{requests}->[$last] : undef;
1048             my $offset = ($last >= 0) ? $rhost->{reqoffs}->[$last] : 0;
1049              
1050             my $began = ($last >= 0) ? $last : 0;
1051              
1052             $offset += scalar @$target if defined ($target);
1053              
1054             # Create a new VarList from the request's list of variables if not already
1055             # a VarList.
1056             #
1057             my $vlist = $req->{vars};
1058             $vlist = _build_varlist($vlist) unless (ref($vlist) =~ m/SNMP::VarList/);
1059             _nag "Bad variable list in request", return undef unless defined($vlist);
1060              
1061             # For getbulk and bulkwalk, each varlist gets to be on its own in the
1062             # requests. We need to provide the sendargs for nonrepeaters and max
1063             # repeater counts (or defaults). Adjust the $maxvars count to be
1064             # exactly the size of the variable list. Also undef $target to force
1065             # creation of a new chunk below.
1066             #
1067             if ($multi->{Method} eq 'getbulk' || $multi->{Method} eq 'bulkwalk') {
1068              
1069             # Create 2-element arg list for nonrepeater and maxreps arguments.
1070             @args = ($req->{nonrepeaters} || 0,
1071             $req->{maxrepetitions} || $multi->{GetbulkMax});
1072              
1073             $maxvars = scalar @$vlist; # Enough space, but it doesn't matter,
1074             $target = undef; # since we'll create a new one anyway.
1075             }
1076              
1077             # If pdupacking is turned off, just use this chunk.
1078             #
1079             if ($multi->{PduPacking} == 0) {
1080             $maxvars = scalar @$vlist; # Enough space, but it doesn't matter,
1081             $target = undef; # since we'll create a new one anyway.
1082             }
1083              
1084             # Build a list of the VarBinds in the VarList referenced by the chunks
1085             # on the requests queue.
1086             #
1087             for my $vbref (@$vlist) {
1088             # Need a new chunk or out of room on the existing one? Build a new
1089             # VarList on which to stash the variables.
1090             #
1091             unless ((defined $target) && (scalar @$target < $maxvars)) {
1092             $target = SNMP::VarList->new;
1093             push @{$rhost->{requests}}, $target;
1094             push @{$rhost->{reqoffs}}, $offset;
1095             push @{$rhost->{sendargs}}, [@args]; # Extra send arguments.
1096              
1097             print "Created new request for $host, index ",
1098             scalar @{$rhost->{requests}},
1099             ", now $rhost->{remain}/$multi->{_remain} reqs\n" if $DEBUGGING;
1100             }
1101              
1102             # Copy the VarBind and push it onto the target chunk array.
1103             #
1104             my @vbcopy = @$vbref;
1105             my $rvbcopy = SNMP::Varbind->new(\@vbcopy);
1106             push @$target, $rvbcopy;
1107             $count ++;
1108             $offset ++;
1109             }
1110              
1111             print "Packed $count requests on ", (scalar @{$rhost->{requests}}) - $began,
1112             " request chunks\n" if $DEBUGGING;
1113             return $count;
1114             }
1115              
1116             # Generate an array of host/index tuples which describes the order in which
1117             # the requests should be sent out. This list is stored on the Multi object,
1118             # and traversed as sessions (or inflight requests) become available to send
1119             # more requests. This is currently a round-robin algorithm, to reduce the
1120             # amount of traffic generated to any one router concurrently (hopefully). It
1121             # should be easy to add additional algorithms to it, by selecting one of
1122             # several routines based on $algorithm.
1123             #
1124             # This is just the starting/preferred order. If enough concurrent sessions
1125             # are not allowed, the list will be re-ordered as requests for some hosts
1126             # will be deferred until the requests for other hosts are completed, and
1127             # their sessions can be recycled.
1128             #
1129             sub _order_reqs {
1130             my ($multi, $algorithm) = @_; # $algorithm currently unused
1131              
1132             # Generate a list of the hostnames to which we will be sending the
1133             # requests. This will be used to generate a list of hosts to round-
1134             # robin.
1135             #
1136             my $rhosts = $multi->{_hosts};
1137             my @hosts = keys %$rhosts;
1138              
1139             # Create a new array of host/index pairs from the host list. The index
1140             # is the element index of the first un-sent request for this host, starting
1141             # with element 0. Walk through the hosts, adding a tuple for each host
1142             # that has a request in index $index.
1143             #
1144             my @rr = (); # Round-robin list of host/index tuples.
1145             my $index = 0; # Current index into request lists.
1146             my $host; # Current host being added...
1147             my $done = 0; # Not done yet!
1148              
1149             while (!$done) {
1150             $done = 1; # Assume we'll finish this time.
1151              
1152             foreach $host (@hosts) { # Get requests for each host
1153             my $reqs = $rhosts->{$host}{requests};
1154              
1155             my $nreqs = scalar @$reqs; # How many requests are there?
1156             next unless $index < $nreqs; # Next host if no more reqs.
1157              
1158             push @rr, ($host, $index); # Add the tuple to the RR list.
1159             $done = 0; # Need to go on.
1160              
1161             $multi->{_remain} ++;
1162             $rhosts->{$host}{remain} ++;
1163             }
1164             $index ++;
1165             }
1166              
1167             if ($DEBUGGING) {
1168             print "Order of requests:\n";
1169             for (my $index = 0; $index < scalar @rr; $index += 2) {
1170             my $host = $rr[$index];
1171             my $rind = $rr[$index + 1];
1172             my $reqs = $rhosts->{$host}{requests};
1173             my $vlen = scalar @{$reqs->[$rind]};
1174             print " ", $index / 2, " -> host $host, index $rind ($vlen var",
1175             ($vlen == 1 ? "" : "s"), ")\n";
1176             }
1177             }
1178              
1179             return \@rr;
1180             }
1181              
1182             # Send off some (or all) of the SNMP requests in the Multi's request queue.
1183             # Any requests that cannot be sent will be re-queued at the end of the list.
1184             #
1185             sub _dispatch {
1186             my $multi = shift;
1187             my $count = 0;
1188              
1189             my @retry = (); # Requests to retry on next run.
1190              
1191             # Don't bother doing anything if no more inflight requests are allowed.
1192             #
1193             return 0 if $multi->{_inflight} >= $multi->{Concurrent};
1194              
1195             # How many (if any) SNMP sessions are available to allocate?
1196             #
1197             my $availsess = $multi->{MaxSessions} - $multi->{_nsessions};
1198             my $rsessions = $multi->{_sessions};
1199              
1200             # Any extra arguments for SNMP::Session?
1201             #
1202             my @SNMPargs = @{$multi->{_SNMPArgs}};
1203              
1204             # Iterate through the round-robin list, popping host/index pairs off of
1205             # the front of @rrhosts, and pushing the "next" pair on the end if more
1206             # requests remain.
1207             #
1208             RR: while (@{$multi->{_reqlist}}) {
1209              
1210             # Pull the next host/index pair off of the front of @rrhosts.
1211             #
1212             my $host = shift @{$multi->{_reqlist}};
1213             my $index = shift @{$multi->{_reqlist}};
1214             my $rhost = $multi->{_hosts}{$host};
1215              
1216             # Skip this host/index if a new session to that host is needed,
1217             # but there are no available sessions.
1218             #
1219             my $rsess = $rsessions->{$host};
1220             if (!defined($rsess) && !$availsess) {
1221             print "No SNMP sessions available for $host (all "
1222             . "$multi->{MaxSessions} sessions in use)\n" if $DEBUGGING;
1223              
1224             # Push the request on the tail of the retry request list.
1225             push @retry, ($host, $index);
1226             next RR;
1227             }
1228              
1229             # There is either a current session for this host, or a new one can
1230             # be created. Get handles for the metadata for this host.
1231             #
1232             my $rreqs = $rhost->{requests};
1233             my $nreqs = scalar @$rreqs;
1234              
1235             croak "Request $host:$index outside range [0..$nreqs]"
1236             unless ($index < $nreqs);
1237              
1238             # Get a reference to the request, and its additional arguments.
1239             #
1240             my $request = $rreqs->[$index];
1241             croak "Request is undef!" unless defined $request;
1242              
1243             my $rargs = $rhost->{sendargs}->[$index];
1244              
1245             # Create a new session for this request if one does not already exist.
1246             unless (defined $rsess) {
1247              
1248             $! = 0; # Reset system errno before calling new() (see below)
1249              
1250             $rsess = SNMP::Session->new( @SNMPargs,
1251             DestHost => $host,
1252             Community => $rhost->{community},
1253             Version => $rhost->{snmpversion},
1254             Timeout => $multi->{Timeout} * 1e6,
1255             Retries => $multi->{Retries},
1256             TimeStamp => $multi->{TimeStamp},
1257             #UseNumeric => $multi->{UseNumeric},
1258             # UseNumeric BOMBS PERL CORE !!!
1259             UseNumeric => 0,
1260             );
1261              
1262             # Give up on this particular request for now. At some point in
1263             # the future, we should probably flag the session as failed, and
1264             # provide an option to avoid retrying any further requests on the
1265             # host.
1266             #
1267             # This is a little tricky -- SNMP::Session::new() doesn't set any
1268             # sort of error flag. We can, however, tell if it was a hostname
1269             # lookup failure by examining $! (errno). It will be 0 if the
1270             # problem occurred before the call into the XS code, otherwise
1271             # a system-level error occured which we can trap based on $!.
1272             #
1273             unless (defined $rsess) {
1274             my $err;
1275             unless ($!) {
1276             # Couldn't look up the host, so set the error code
1277             # especially for this.
1278             $err = "Couldn't resolve hostname";
1279              
1280             # We are discarding this request.
1281             #
1282             $rhost->{remain} --;
1283             $multi->{_remain} --;
1284              
1285             } else {
1286             # Some system-level error occurred. Handle a few simple
1287             # resource problems by (hopefully) waiting for things to
1288             # subside, and retry later.
1289             #
1290             # Copy error string, and force numeric errno
1291             $err = "" . $!;
1292             my $errno = $! + 0;
1293             if (($errno == EINTR) || # Interrupted system call
1294             ($errno == EAGAIN) || # Resource temp. unavailable
1295             ($errno == ENOMEM) || # No memory (temporary)
1296             ($errno == ENFILE) || # Out of file descriptors
1297             ($errno == EMFILE)) # Too many open fd's
1298             {
1299             # Push the request onto the retry request list.
1300             push @retry, ($host, $index);
1301              
1302             # Prevent further attempts to get a new session
1303             # until the blockage clears, but only if there's
1304             # a chance a current connection will finish and
1305             # free up resources.
1306             $availsess = 0 if $multi->{_nsessions};
1307              
1308             # Note that we'll retry later.
1309             $err .= " (will retry)";
1310             } else {
1311              
1312             # We are discarding this request.
1313             #
1314             $rhost->{remain} --;
1315             $multi->{_remain} --;
1316             }
1317             }
1318              
1319             _nag "Couldn't create SNMP v$rhost->{snmpversion} session for "
1320             . "$host: $err\n";
1321              
1322             next RR;
1323             }
1324              
1325             # Work around a work-around. When UseNumeric is set, the SNMP
1326             # module forces UseLongNames. This may or may not be what was
1327             # intended by the user. Assume that the user knows what they're
1328             # doing if numeric and no long names... Note that this is digging
1329             # around in the SNMP object -- a no-no, but life's hard.
1330             #
1331             if ($rsess->{UseNumeric} && ! $SNMP::use_long_names) {
1332             print "UseNumeric set with SNMP::use_long_names, resetting...\n"
1333             if $DEBUGGING;
1334             $rsess->{UseLongNames} = 0;
1335             }
1336              
1337             # Store the session for future use, and note the new session in
1338             # the in-use and available counts.
1339             #
1340             $rsessions->{$host} = $rsess;
1341             $multi->{_nsessions} ++;
1342             $availsess --;
1343             print "Created new SNMP session for $host, now $multi->{_nsessions}"
1344             . " of $multi->{MaxSessions} sessions\n" if $DEBUGGING;
1345             }
1346              
1347             # Send the hunk of variable requests. Arrange for the Perl callback
1348             # to get back the host and index number of the request. This allows
1349             # the callback to place the returned values (or error) into the
1350             # correct host slot. Async calls return the request ID for the request,
1351             # or undef on failure.
1352             #
1353             # Call $rsess->'get'() or whatever the method requested was. THe
1354             # name of the method was validated by the 'new()' function.
1355             #
1356             my $method = $multi->{Method};
1357             my $callback = [ $_handler{$method}, $multi, $host, $index ];
1358             my @args = @$rargs;
1359             push @args, $request;
1360             push @args, $callback;
1361              
1362             my $res = $rsess->$method(@args);
1363              
1364             if (defined $res) {
1365             # Note another request successfully sent, and increment the count
1366             # of inflight requests.
1367             #
1368             $count ++;
1369             $multi->{_inflight} ++;
1370              
1371             print "Sent request for $host:$index (", scalar @$request, " var",
1372             (scalar @$request == 1 ? "" : "s"), "), ",
1373             scalar @{$multi->{_reqlist}} / 2, " reqs remain to try, ",
1374             "will retry ", scalar @retry / 2, " reqs\n"
1375             if $DEBUGGING;
1376              
1377             } else {
1378             my $result = SNMP::Multi::Result->new (
1379             varlist => SNMP::VarList->new($request),
1380             errnum => $rsess->{ErrorNum},
1381             errstr => $rsess->{ErrorNum} ? $rsess->{ErrorStr} : "",
1382             reqind => $rsess->{ErrorInd},
1383             errind => $rsess->{ErrorInd} + $rhost->{reqoffs}->[$index]
1384             );
1385             $multi->{_response}->add_result($host, $result, $index);
1386              
1387             _nag "Cannot do $method request #$index on $host (session $rsess)"
1388             . " -- " . $result->error();
1389             }
1390              
1391             # Have we reached the limit of inflight requests?
1392             last RR if $multi->{_inflight} >= $multi->{Concurrent};
1393             }
1394              
1395             # If any requests were attempted but couldn't be sent, push them onto
1396             # the tail of the requests list.
1397             push @{$multi->{_reqlist}}, @retry;
1398              
1399             return $count;
1400             }
1401              
1402              
1403             # Functions to handle variable lists handed back through the async perl
1404             # callback. The "normal" SNMP operations return a VarList (an array of
1405             # Varbinds), while bulkwalk() returns an array of VarLists (one VarList
1406             # for each requested variable). The return values are stored as arrays
1407             # of VarLists, so handle_VarList() converts the VarList to an array of a
1408             # VarList's to match bulkwalk()'s return format. handle_AoVarLists()
1409             # handles the array-of-VarLists return from bulkwalk (basically passes
1410             # it through unmodified).
1411             #
1412             # Note : These are not really methods, although they look like them.
1413             #
1414             sub _handle_VarList {
1415             my ($multi, $host, $index, $rvlist) = @_;
1416             my $raovl = undef;
1417              
1418             croak "No host entry for $host!" unless exists $multi->{_hosts}{$host};
1419              
1420             if (defined $rvlist) {
1421             my @aovl = ();
1422              
1423             # Special case for 'getbulk' method. Create an array of VarLists,
1424             # one per non-repeater, then the list of values for each repeater in
1425             # its own VarList. Returned values for getbulk are non-repeaters,
1426             # followed by the values for each repeater interleaved, one VarBind
1427             # per instance.
1428             #
1429             if ($multi->{Method} ne "getbulk") {
1430             # Not getbulk method, build one VarList per Varbind.
1431             #
1432             for my $vb (@$rvlist) {
1433             # internal work-around: translates text tags back to IOD's,
1434             # needed because of SNMP.pm bug - see below comment next to
1435             # the sub itself
1436             $vb = _translateObj($vb) if $multi->{UseNumeric};
1437             push @aovl, SNMP::VarList->new($vb);
1438             }
1439             } else {
1440             # Getbulk support. Need to "decode" the VarList returned by the
1441             # getbulk method.
1442             #
1443             my $rhost = $multi->{_hosts}{$host};
1444             my $nonreps = $rhost->{sendargs}->[0];
1445             my $reqcount = scalar @{$rhost->{requests}->[$index]};
1446             my $repeats = $reqcount - $nonreps;
1447              
1448             # Build an empty VarList for variable requested.
1449             for (my $i = 0; $i < $reqcount; $i ++) {
1450             push @aovl, SNMP::VarList->new();
1451             }
1452              
1453             # Push each non-repeater Varbind onto the appropriate VarList.
1454             my $nr = 0;
1455             while ($nr < $nonreps) {
1456             push @{$aovl[$nr]}, shift @$rvlist;
1457             $nr ++;
1458             }
1459              
1460             # Now cycle through all the remaining Varbinds, pushing them onto
1461             # the appropriate VarList.
1462             $nr = 0;
1463             while (scalar @$rvlist) {
1464             push @{$aovl[$nr + $nonreps]}, shift @$rvlist;
1465             $nr = ($nr + 1) % $repeats;
1466             }
1467             }
1468              
1469             $raovl = \@aovl; # Take a ref to the resulting array of varlists
1470             }
1471              
1472             # Hand the array reference (or undef for timeout) to _handle_AoVarLists(),
1473             # which will actually place the data in the SNMP::Multi::Response object.
1474             #
1475             _handle_AoVarLists($multi, $host, $index, $raovl);
1476             }
1477              
1478             #====================================================================
1479             # internal work-around function: specific to SNMP::Varbind objects.
1480             # It is needed because of SNMP.pm bug where option UseNumeric makes
1481             # it dump core. So, when UseNumeric is set, we don't pass that
1482             # information to SNMP.pm, instead, to achieve the same effect, but
1483             # without perl core dumps, we let it convert OID's to text tags
1484             # which we then convert back to OID's here. Ironically enough, we do
1485             # that by using a wrapper around SNMP.pm own method.
1486             # -- 16 Dec 2003 toni@irational.org --
1487             #=====================================================================
1488             sub _translateObj {
1489             my ( $varbind ) = @_;
1490              
1491             my $type = "SNMP::Varbind";
1492             if (not ref($varbind) eq $type ) {
1493             printf( "\tERROR in %s: called from the %s (line %s)" .
1494             " with the wrong type of argument. Only %s" .
1495             " object are accepted.\n", (caller(0))[3],
1496             (caller(1))[3], (caller(0))[2], $type);
1497             return;
1498             }
1499              
1500             # accessors for SNMP::Varbind
1501             my @vbaccessors = qw/ tag iid val type /;
1502             my $new_varbind;
1503             foreach my $method ( @vbaccessors ) {
1504             my $value = $varbind->$method;
1505             if ($method eq "tag") {
1506             $value = SNMP::translateObj($value);
1507             $value =~ s/.//;
1508             }
1509             push @$new_varbind, $value;
1510             };
1511             # pack it back in the format we received it in
1512             return bless ($new_varbind, 'SNMP::Varbind');
1513             }
1514              
1515             sub _handle_AoVarLists {
1516             my ($multi, $host, $index, $raovl) = @_;
1517              
1518             croak "No host entry for $host!" unless exists $multi->{_hosts}{$host};
1519              
1520             my $rhost = $multi->{_hosts}{$host};
1521              
1522             if ($DEBUGGING) {
1523             my $vlen = defined $raovl ? scalar @$raovl : 0;
1524             print "Received response for $host:$index ($vlen var",
1525             ($vlen == 1 ? "" : "s"), ").\n";
1526             print "$rhost->{remain} reqs remain to receive from $host\n";
1527             print "$multi->{_remain} reqs remain for Multi($multi->{Method}).\n";
1528             }
1529              
1530             # If undef, we got a timeout. Otherwise copy the error from the SNMP
1531             # session to the Result object.
1532             #
1533             my @errs;
1534             if (defined ($raovl)) {
1535             $errs[0] = $multi->{_sessions}{$host}{ErrorNum};
1536             $errs[1] = $errs[0] ? $multi->{_sessions}{$host}{ErrorStr} : "";
1537             $errs[2] = $multi->{_sessions}{$host}{ErrorInd};
1538             } else {
1539             $errs[0] = -24;
1540             $errs[1] = 'Timeout';
1541             $errs[2] = 0;
1542             }
1543              
1544             my $result = SNMP::Multi::Result->new (
1545             varlist => $raovl,
1546             errnum => $errs[0],
1547             errstr => $errs[1],
1548             reqind => $errs[2],
1549             errind => $errs[0] ? $errs[2] + $rhost->{reqoffs}->[$index] : 0
1550             );
1551             $multi->{_response}->add_result($host, $result, $index);
1552              
1553             # Track the number of in-flight, per-host, and total remaining requests.
1554             $multi->{_inflight} --;
1555             $multi->{_remain} --;
1556             $rhost->{remain} --;
1557              
1558             # If all requests for this host have been completed or timed out, we
1559             # can free the session pointer for someone else to use.
1560             #
1561             unless ($rhost->{remain}) {
1562             delete $multi->{_sessions}{$host};
1563             $multi->{_nsessions} --;
1564             print "All $host requests done, closing SNMP session "
1565             . "($multi->{_nsessions} still in use)\n" if $DEBUGGING;
1566             }
1567              
1568             # If any requests remain at all, attempt to send some more out. Otherwise,
1569             # if no outstanding requests remain, and none are inflight, we're done.
1570             # Interrupt the MainLoop so it can return the results.
1571             if ($multi->{_remain}) {
1572             $multi->_dispatch();
1573             } else {
1574             SNMP::finish() unless $multi->{_inflight};
1575             }
1576             }
1577              
1578             # Return non-zero if the Multi request has been completed (i.e. no requests
1579             # remain to send, and no in-flight requests are outstanding).
1580             #
1581             sub complete {
1582             my $multi = shift;
1583             return ($multi->{_remain} || $multi->{_inflight}) ? 0 : 1;
1584             }
1585              
1586             #-----------------------------------------------------------------------------
1587             package SNMP::Multi::Result;
1588             #-----------------------------------------------------------------------------
1589             use Carp;
1590             use strict;
1591              
1592             #
1593             # The SNMP::Multi::Result class encapsulates the returned data (if any)
1594             # from the SNMP agent, as well as any error information. It supplies a
1595             # few methods to access this data, but is essentially just a container.
1596             #
1597             # The object is simply a hash arranged like this:
1598             #
1599             # +---------------------+----------+
1600             # | SNMP::Multi::Result | varlist -+---> SNMP::VarList
1601             # | | errnum |
1602             # | | errstr |
1603             # | | errind |
1604             # | | reqind |
1605             # +---------------------+----------+
1606             #
1607             # $smr->varlists() returns a reference to the array of SNMP::VarList
1608             # object for this result.
1609             #
1610             # All of these methods return undef if no error occurred:
1611             #
1612             # $smr->errnum() returns numeric number of SNMP error.
1613             # $smr->errstr() returns printable string describing the error.
1614             # $smr->errind() returns the index of the variable causing the error.
1615             # $smr->reqind() returns the index in the request of a bad variable.
1616             # $smr->error() returns "$errstr ($errnum)"
1617             #
1618             # The _set_error() method can be used to change the error information:
1619             #
1620             # $smr->_set_error( , );
1621              
1622             sub new {
1623             my $type = shift;
1624             my $class = ref($type) || $type;
1625              
1626             my %args = @_;
1627              
1628             my $self = {
1629             varlist => $args{'varlist'},
1630             errnum => $args{'errnum'},
1631             errstr => $args{'errstr'},
1632             errind => $args{'errind'},
1633             reqind => $args{'reqind'},
1634             };
1635             bless $self, $class;
1636             return $self;
1637             }
1638              
1639             sub error {
1640             my $self = shift;
1641             return undef unless defined $self->{errnum} && $self->{errnum} != 0;
1642             return $self->{errstr} . " (err " . $self->{errnum}
1643             . " at var $self->{errind})";
1644             }
1645              
1646             sub _set_error {
1647             my ($self, $errnum, $errstr) = @_;
1648             $self->{errnum} = $errnum;
1649             $self->{errstr} = $errstr;
1650             return $self;
1651             }
1652              
1653             # Simple accesssor functions.
1654             #
1655             sub varlists {
1656             my $self = shift;
1657             my $vl = $self->{varlist};
1658              
1659             # Can't use an undefined value as an ARRAY reference [on next line]
1660             if (wantarray) {
1661             return UNIVERSAL::isa($vl, "ARRAY") ? @$vl : ();
1662             } else {
1663             return $vl;
1664             }
1665             }
1666              
1667             sub errnum {
1668             my $self = shift;
1669             return undef unless defined $self->{errnum} && $self->{errnum} != 0;
1670             return $self->{errnum};
1671             }
1672             sub errstr {
1673             my $self = shift;
1674             return undef unless defined $self->{errnum} && $self->{errnum} != 0;
1675             return $self->{errstr};
1676             }
1677             sub errind {
1678             my $self = shift;
1679             return undef unless defined $self->{errnum} && $self->{errnum} != 0;
1680             return $self->{errind};
1681             }
1682             sub reqind {
1683             my $self = shift;
1684             return undef unless defined $self->{errnum} && $self->{errnum} != 0;
1685             return $self->{reqind};
1686             }
1687              
1688             sub values {
1689             my $self = shift;
1690             return if $self->error();
1691              
1692             my @values = ();
1693              
1694             for my $varlist ($self->varlists) {
1695             for my $vb (@$varlist) {
1696             push @values, $vb->val();
1697             }
1698             }
1699              
1700             return wantarray ? @values : \@values;
1701             }
1702              
1703             ###########################################################################
1704             package SNMP::Multi::VarReq;
1705             #
1706             # This object is used to build up a set of host/OID requests that will
1707             # be handed to the SNMP::Multi object to pack and transmit.
1708             #
1709             # Note that we have no a priori knowledge of how the request will be
1710             # packed (or even what sort of SNMP request this will finally be). No
1711             # variable packing is done at this point.
1712             #
1713             # If 'autovalidate' is true, the variables and hostnames being requested
1714             # will be looked up and an error returned. The VarReq can be explicitly
1715             # checked at any time by calling the validate() method.
1716             #
1717             use strict;
1718             use Carp;
1719              
1720             # Declare and initialize global variables/flags.
1721             use vars qw/ $DEBUGGING $error $sorthosts $autovalidate /;
1722             $DEBUGGING = 0;
1723             $error = undef;
1724             $sorthosts = 0;
1725             $autovalidate = 0;
1726              
1727             sub new {
1728             my $type = shift;
1729             my $class = ref($type) || $type;
1730              
1731             $error = '';
1732              
1733             my $req = {
1734             'error' => undef,
1735             'sorthosts' => $sorthosts,
1736             'autovalidate' => $autovalidate,
1737             'requests' => {},
1738             };
1739             bless $req, $class;
1740             print "new() => $req\n" if $DEBUGGING;
1741              
1742             if (@_) {
1743             # add() sets $req's 'error' string, but we won't return the
1744             # request object. Copy error to global $error string.
1745             unless ($req->add(@_)) {
1746             $error = $req->error();
1747             return undef;
1748             }
1749             }
1750             return $req;
1751             };
1752              
1753             sub DESTROY { print "DESTROY: $_[0]\n" if $DEBUGGING };
1754              
1755             ######### Accessor methods:
1756             #
1757             sub error { # read-only
1758             my $self = shift;
1759             return $self->{'error'};
1760             }
1761             sub set_error { # read-write (undef okay)
1762             my ($self, $new) = @_;
1763             my $old = $self->{'error'};
1764             $self->{'error'} = $new;
1765             return $old;
1766             }
1767             sub sorthosts { # read-write
1768             my ($self, $new) = @_;
1769             my $old = $self->{'sorthosts'};
1770             $self->{'sorthosts'} = $new if (defined $new);
1771             return $old;
1772             }
1773             sub autovalidate { # read-write
1774             my ($self, $new) = @_;
1775             my $old = $self->{'autovalidate'};
1776             $self->{'autovalidate'} = $new if (defined $new);
1777             return $old;
1778             }
1779              
1780             # hosts():
1781             #
1782             # Return a list (or array ref) of the hosts mentioned in
1783             # the VarReq object. If 'sorthosts' is true, the list will
1784             # be sorted into a more readable order for the caller.
1785             #
1786             sub hosts { # read-only
1787             my $self = shift;
1788             my @hosts = keys %{$self->{'requests'}};
1789              
1790             @hosts = (sort _by_host @hosts) if ($self->sorthosts() || $sorthosts);
1791              
1792             return wantarray ? @hosts : \@hosts;
1793             }
1794              
1795             # Return a list of the variable request chunks for a host. If no
1796             # host is returned, the requests for all hosts are returned (note
1797             # that no attempt is made to reduce or consolidate the data).
1798             #
1799             sub requests {
1800             my ($self, $host) = @_;
1801              
1802             my @hlist = (defined $host) ? ($host) : $self->hosts();
1803              
1804             my @reqs = ();
1805             for my $h (@hlist) {
1806             push @reqs, @{$self->{'requests'}{$h}};
1807             }
1808             return wantarray ? @reqs : \@reqs;
1809             }
1810              
1811             # Like requests() above, but returns a list of just the 'vars' portion
1812             # of the request lists. See dump() for an example of usage.
1813             #
1814             sub requests_list {
1815             my ($self, $host) = @_;
1816              
1817             my @hlist = (defined $host) ? ($host) : $self->hosts();
1818              
1819             my @reqs = ();
1820             for my $h (@hlist) {
1821             my $varlist = $self->{'requests'}{$h};
1822             for my $hash (@$varlist) {
1823             my $vars = $hash->{'vars'};
1824             push @reqs, @$vars;
1825             }
1826             }
1827             return wantarray ? @reqs : \@reqs;
1828             }
1829              
1830             ######### Action methods:
1831             #
1832             # add():
1833             #
1834             # Add a set of variables to the current request object. The 'vars' argument
1835             # is mandatory, and specifies the variables to request from the agents. An
1836             # optional 'hosts' field specifies a list of hosts for which this variable
1837             # request should be made. If no 'hosts' argument is given, the var request
1838             # will be applied to the currently-existing list of hosts.
1839             #
1840             # For SNMP getbulk and bulkwalk requests, optional arguments 'nonrepeaters'
1841             # and 'maxrepetitions' can be specified. These parameters will be ignored
1842             # by SNMP::Multi for non-bulk requests, and will receive the SNMP::Multi's
1843             # default values unless specified for a request.
1844             #
1845             # Note that no variable packing is done at this time. The SNMP::Multi object
1846             # does packing based on its parameters when the VarReq is handed to it.
1847             #
1848             sub add {
1849             my $self = shift;
1850              
1851             my %arg = @_; # Convert arglist to a hash for key-value access.
1852            
1853             # Each added request block must have at least one element in
1854             # the 'vars' slot. Ensure that we have an array of vars.
1855             #
1856             my $vars = $arg{'vars'} || $arg{'-vars'} || $arg{varlist} || $arg{-varlist};
1857             unless (defined $vars) {
1858             $error = "No 'vars' argument to " . __PACKAGE__ . "::add()";
1859             return undef;
1860             }
1861             $vars = [ $vars ] unless (ref($vars) =~ m/ARRAY/ ||
1862             ref($vars) =~ m/SNMP::VarList/ );
1863              
1864             # Now see if a specific set of hosts was mentioned. If not, we'll
1865             # just use whatever exists. Obviously, the 'hosts' argument is not
1866             # optional if there are no hosts already defined.
1867             #
1868             my $hosts = $arg{'hosts'} || $arg{'-hosts'};
1869              
1870             unless (defined $hosts || $self->hosts()) {
1871             $error = "No 'hosts' for VarReq in " . __PACKAGE__ . "::add()";
1872             return undef;
1873             }
1874              
1875             # If hosts were not specified, apply the var request to all current
1876             # hosts. If a single host was specified, turn it into a 1-element
1877             # array.
1878             #
1879             if (defined $hosts) {
1880             $hosts = [ $hosts ] unless ref($hosts) =~ m/ARRAY/;
1881             } else {
1882             $hosts ||= $self->hosts();
1883             }
1884             print "Adding " . scalar @$vars . " var(s) to $self\n" if $DEBUGGING;
1885              
1886             # We may also have a set of values for this request (if it's an SNMP
1887             # "SET" operation). Store these too, they'll be ignored for anything
1888             # but a SET request.
1889             #
1890             my $values = $arg{'values'} || $arg{'-values'};
1891              
1892             # The SNMP "GETBULK" and "BULKWALK" requests have two additional
1893             # parameters (non-repeaters and max-repetitions). If provided, store
1894             # them, otherwise they'll be given default values by SNMP::Multi.
1895             #
1896             my $nonreps = $arg{'nonrepeaters'} || $arg{'-nonrepeaters'};
1897             my $maxreps = $arg{'maxrepetitions'} || $arg{'-maxrepetitions'};
1898              
1899             # We don't have enough information to do the PDU packing here, so we just
1900             # store up the requests and leave packing up to the SNMP::Multi object.
1901             # If necessary, create a new entry in the VarReq object for this host.
1902             #
1903             my @reqbits = ( 'vars' => $vars );
1904             push @reqbits, ( 'values' => $values ) if defined $values;
1905             push @reqbits, ( 'nonrepeaters' => $nonreps ) if defined $nonreps;
1906             push @reqbits, ( 'maxrepetitions' => $maxreps ) if defined $maxreps;
1907              
1908             my $new_req = { @reqbits };
1909              
1910             for my $h (@$hosts) {
1911             unless (exists $self->{'requests'}{$h}) {
1912             $self->{'requests'}{$h} = [];
1913             print " Created new entry in $self for $h\n" if $DEBUGGING;
1914             }
1915             my $reqlist = $self->{'requests'}{$h};
1916             push @$reqlist, $new_req;
1917             print " Added " . scalar @$vars . " VarReq for $h\n" if $DEBUGGING;
1918             }
1919              
1920             if ($self->autovalidate || $autovalidate) {
1921             print " Validating request -- this may take a bit...\n" if $DEBUGGING;
1922              
1923             return undef unless $self->validate(@$hosts);
1924             }
1925              
1926             return $self;
1927             }
1928              
1929             # validate():
1930             #
1931             # Sanity-check the current contents of the VarReq object. An optional
1932             # host list can be used to reduce the validation scope.
1933             #
1934             # XXX - Not yet fully implemented.
1935             #
1936             sub validate {
1937             my $self = shift;
1938             my @hosts = (scalar @_) ? @_ : $self->hosts;
1939              
1940             # Attempt DNS name lookup on each host. If it fails, try to figure
1941             # out why and return an error in the VarReq's error slot.
1942             #
1943             for my $host (@hosts) {
1944             my $ip = gethostbyname($host); # Could try to canonicalize here.
1945             next unless $?;
1946              
1947             # These error codes are implementation-specific -- check against
1948             # the values #define'd in !
1949             my $err = "$host: ";
1950             $err .= "unknown hostname" if ($? == 1);
1951             $err .= "nameserver failed" if ($? == 2);
1952             $err .= "unrecoverable error" if ($? == 3);
1953             $err .= "no data from nameserver" if ($? == 4);
1954             $err .= "unspecified/unknown error" if ($? >= 5);
1955              
1956             $self->set_error($err);
1957             return undef;
1958             }
1959              
1960             # Now look through the list of variable requests, checking that they
1961             # are reasonable. We should be able to ask the SNMP module if these
1962             # are valid or not. XXX dunno how to do this yet...
1963             #
1964             # my @reqs = $self->requests(@hosts);
1965             # my %seen = ();
1966             #
1967             # for my $req (@reqs) {
1968             # my $vars = $req->{'vars'};
1969             # for my $var (@$vars) {
1970             # # Check if we've already looked this one up, and ignore it if
1971             # # that's the case.
1972             # #
1973             # next if exists $seen{$var};
1974             # $seen{$var} = undef;
1975             #
1976             # # Look for the variable in the MIB if it's not all-numeric.
1977             # #
1978             # next if ($var =~ m/^\.?(\d+\.)*\d+$/);
1979             # next unless SNMP::translateObj($var);
1980             #
1981             # $self->set_error("$var: Unknown var/OID");
1982             # return undef;
1983             # }
1984             # }
1985              
1986             return $self;
1987             }
1988              
1989             # dump():
1990             #
1991             # Returns a printable string outlining the variable and host requests
1992             # contained in the VarReq. Probably should set 'sorthosts' before calling
1993             # this routine.
1994             #
1995             sub dump {
1996             my $self = shift;
1997              
1998             my $out = '';
1999             my $l = 0;
2000              
2001             my @hosts = $self->hosts();
2002             for my $h (@hosts) {
2003             $l = length($h) if length($h) > $l;
2004             }
2005            
2006             for my $h (@hosts) {
2007             my $rl = $self->requests_list($h);
2008             $out .= sprintf "%${l}s: ", $h;
2009             $out .= join ' ',
2010             map { (ref($_) =~ m/ARRAY/) ? (join '.', @$_) : ($_) } @$rl;
2011             $out .= "\n";
2012             }
2013              
2014             return $out;
2015             }
2016              
2017             # _by_host():
2018             #
2019             # Sorting logic to sort hostnames into a "reader friendly" order. This
2020             # algorithm compares hostnames sub-domain by sub-domain, starting with the
2021             # top-level domains, sorting alphabetically at each point.
2022             #
2023             # - eli.net
2024             # - nosferatu.eli.net
2025             # - surly.eli.net
2026             # - www.eli.net
2027             # - er02.plal.eli.net
2028             # - er01.ptld.eli.net
2029             # - gw01.ptld.eli.net
2030             # - gw02.ptld.eli.net
2031             #
2032             # This isn't perfect, but it does help group together related host-names.
2033             # A far better algorithm would be recursive, generating a tree from the
2034             # pieces of the hostname, then doing an in-order traversal of that tree.
2035             # But that would vaguely resemble work. Exercise Left For Reader. 8^)
2036             #
2037             sub _by_host {
2038             my (@a, @b, $A, $B);
2039              
2040             return 0 if (lc $a eq lc $b); # Shortcut if names are identical.
2041              
2042             # Compare each element in the '.'-separated hostnames individually,
2043             # starting with the least significant (i.e. the TLD).
2044             #
2045             @a = split /\./, lc $a;
2046             @b = split /\./, lc $b;
2047              
2048             # Sort hostnames with more pieces (more specific) to the bottom.
2049             return (scalar @a <=> scalar @b) unless (scalar @a == scalar @b);
2050              
2051             while (($A = pop @a) && ($B = pop @b)) {
2052             return ($A cmp $B) if ($A cmp $B); # Different?
2053             }
2054              
2055             # Ran out of pieces in one of the names. If the first was more
2056             # specific, sort it to the bottom. Otherwise, sort to top.
2057             #
2058             return 1 if (defined $A);
2059             return -1;
2060             }
2061              
2062             #-----------------------------------------------------------------------------
2063             package SNMP::Multi::Response;
2064             #-----------------------------------------------------------------------------
2065             #
2066             # This object encapsulates the returned data from the hosts, providing a
2067             # simple interface for accessing the data. It is returned by the Session
2068             # object's execute() method.
2069             #
2070             # The layout is basically a hash of SNMP::Multi::Response::Host objects,
2071             # each of which has a list of SNMP::Multi::Result objects:
2072             #
2073             # my $resp = $sms->execute();
2074             # for my $host ($resp->hosts()) {
2075             # for my $result ($host->results()) {
2076             # if ($result->error()) {
2077             # print $result->error();
2078             # } else {
2079             # print map { " " . $_->fmt() . "\n" } $result->varlist();
2080             # }
2081             # }
2082             # }
2083             #
2084              
2085             use Carp;
2086             use strict;
2087              
2088             sub new {
2089             my $self = shift;
2090             my $class = ref($self) || $self;
2091              
2092             my $resp = {};
2093             bless $resp, $class;
2094              
2095             return $resp;
2096             }
2097              
2098             # Access methods:
2099             #
2100             # add_result($host, $result, $index):
2101             # Add the SNMP::Multi::Result object '$result' to the Response
2102             # object, possibly making a new SNMP::Multi::Response::Host
2103             # object from '$host'. The Result is stored at array position
2104             # $index in the SNMP::Multi::Response::Host 'results' entry.
2105             #
2106             # get_result($host, $index):
2107             # Return the $index'th result for the host $host in the Response
2108             # object. Returns undef if the requested result has not yet been
2109             # returned by the host (or if the host has not yet replied).
2110             #
2111             # hostnames():
2112             # Returns a list [or array ref in scalar context] of the hosts
2113             # for which data was received.
2114             #
2115             # hosts():
2116             # Returns a list [or array ref in scalar context] of the SNMP data
2117             # for each host, contained in SNMP::Multi::Response::Host objects.
2118             #
2119             # values([@hosts]):
2120             # Returns a list [or array ref in scalar context] of the values from
2121             # the SNMP data for the specified hosts (or all hosts). This might
2122             # be useful if, for instance, you wish to simply sum up interface
2123             # octet counts for a set of routers without regard for the mapping
2124             # of hosts to sets of data values.
2125             #
2126             sub add_result {
2127             my ($self, $host, $result, $index) = @_;
2128              
2129             unless (exists $self->{$host}) {
2130             $self->{$host} = SNMP::Multi::Response::Host->new(hostname => $host);
2131             }
2132              
2133             # Add the SNMP::Multi::Results object to the SNMP::Multi::Response::Host
2134             # object at the appropriate slot ($index).
2135             #
2136             $self->{$host}->store_result($result, $index);;
2137             }
2138              
2139             sub get_result {
2140             my ($self, $host, $index) = @_;
2141              
2142             return undef unless (exists $self->{$host});
2143             $self->{$host}->get_result($index);
2144             }
2145              
2146             sub hostnames {
2147             my $self = shift;
2148             my @names = keys %$self;
2149             return wantarray ? @names : \@names;
2150             }
2151             sub hosts {
2152             my $self = shift;
2153             my @hosts = values %$self;
2154             return wantarray ? @hosts : \@hosts;
2155             }
2156             sub values {
2157             my $self = shift;
2158             my @hosts = (scalar @_ ? @_ : $self->hosts);
2159              
2160             my @values = ();
2161              
2162             for my $host (@hosts) {
2163             next unless (exists $self->{$host});
2164              
2165             push @values, $host->values();
2166             }
2167             return wantarray ? @values : \@values;
2168             }
2169              
2170             #-----------------------------------------------------------------------------
2171             package SNMP::Multi::Response::Host;
2172             #-----------------------------------------------------------------------------
2173             #
2174             # This class simply encapsulates the SNMP::Multi::Results for a host. The
2175             # SNMP::Multi::Response object is a hash of these objects.
2176             #
2177             use Carp;
2178             use strict;
2179              
2180             sub new {
2181             my $self = shift;
2182             my $class = ref($self) || $self;
2183              
2184             my $host = {
2185             'hostname' => undef,
2186             'results' => [],
2187             @_
2188             };
2189              
2190             bless $host, $class;
2191             }
2192              
2193             sub store_result {
2194             my ($self, $results, $index) = @_;
2195              
2196             $self->{results}->[$index] = $results;
2197             return $results;
2198             }
2199              
2200             sub get_result {
2201             my ($self, $index) = @_;
2202              
2203             return $self->{results}->[$index];
2204             }
2205              
2206             sub hostname {
2207             my $self = shift;
2208             return $self->{'hostname'};
2209             }
2210              
2211             sub results {
2212             my $self = shift;
2213             my $rlist = $self->{'results'};
2214             return wantarray ? @$rlist : $rlist;
2215             }
2216              
2217             # Return a list or array ref of all values from all results for this host.
2218             #
2219             sub values {
2220             my $self = shift;
2221             my @vals = ();
2222             for my $result ($self->results()) {
2223             next if $result->error();
2224             push @vals, $result->values();
2225             }
2226              
2227             return wantarray ? @vals : \@vals;
2228             }
2229              
2230             use overload '""' => sub { hostname $_[0] };
2231              
2232             1;
2233