line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# -*- mode: perl -*-
|
2
|
|
|
|
|
|
|
#
|
3
|
|
|
|
|
|
|
# Copyright (c) 2008 Stephen R. Scaffidi
|
4
|
|
|
|
|
|
|
# All rights reserved.
|
5
|
|
|
|
|
|
|
#
|
6
|
|
|
|
|
|
|
# This program is free software; you may redistribute it and/or modify it
|
7
|
|
|
|
|
|
|
# under the same terms as Perl itself.
|
8
|
|
|
|
|
|
|
#
|
9
|
|
|
|
|
|
|
# Current RCS Info:
|
10
|
|
|
|
|
|
|
#
|
11
|
|
|
|
|
|
|
# $Id: Asynch.pm 38 2008-03-11 16:48:32Z hercynium $
|
12
|
|
|
|
|
|
|
# $HeadURL: https://rtg-utilities.svn.sourceforge.net/svnroot/rtg-utilities/SNMP-Asynch/lib/SNMP/Query/Asynch.pm $
|
13
|
|
|
|
|
|
|
# $Date: 2008-03-11 12:48:32 -0400 (Tue, 11 Mar 2008) $
|
14
|
|
|
|
|
|
|
# $Author: hercynium $
|
15
|
|
|
|
|
|
|
# $Revision: 38 $
|
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
package SNMP::Query::Asynch;
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
# Pragmas
|
20
|
1
|
|
|
1
|
|
19572
|
use strict;
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
30
|
|
21
|
1
|
|
|
1
|
|
4
|
use warnings;
|
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
23
|
|
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
# Standard
|
24
|
1
|
|
|
1
|
|
4
|
use Carp;
|
|
1
|
|
|
|
|
5
|
|
|
1
|
|
|
|
|
85
|
|
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
# Cpan
|
27
|
1
|
|
|
1
|
|
412
|
use SNMP;
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
# See chap 17, pg. 404, PBP (Conway 2005)
|
30
|
|
|
|
|
|
|
# use version; our $VERSION = qv('0.1_32');
|
31
|
|
|
|
|
|
|
use version; our $VERSION = qv(sprintf "0.1_%d", q$Revision: 38 $ =~ /: (\d+)/);
|
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
# This comes in handy so we don't pass bogus
|
35
|
|
|
|
|
|
|
# parameters to SNMP::Session->new()
|
36
|
|
|
|
|
|
|
use vars qw(@valid_sess_params);
|
37
|
|
|
|
|
|
|
@valid_sess_params = qw(
|
38
|
|
|
|
|
|
|
DestHost
|
39
|
|
|
|
|
|
|
Community
|
40
|
|
|
|
|
|
|
Version
|
41
|
|
|
|
|
|
|
RemotePort
|
42
|
|
|
|
|
|
|
Timeout
|
43
|
|
|
|
|
|
|
Retries
|
44
|
|
|
|
|
|
|
RetryNoSuch
|
45
|
|
|
|
|
|
|
SecName
|
46
|
|
|
|
|
|
|
SecLevel
|
47
|
|
|
|
|
|
|
SecEngineId
|
48
|
|
|
|
|
|
|
ContextEngineId
|
49
|
|
|
|
|
|
|
Context
|
50
|
|
|
|
|
|
|
AuthProto
|
51
|
|
|
|
|
|
|
AuthPass
|
52
|
|
|
|
|
|
|
PrivProto
|
53
|
|
|
|
|
|
|
PrivPass
|
54
|
|
|
|
|
|
|
AuthMasterKey
|
55
|
|
|
|
|
|
|
PrivMasterKey
|
56
|
|
|
|
|
|
|
AuthLocalizedKey
|
57
|
|
|
|
|
|
|
PrivLocalizedKey
|
58
|
|
|
|
|
|
|
VarFormats
|
59
|
|
|
|
|
|
|
TypeFormats
|
60
|
|
|
|
|
|
|
UseLongNames
|
61
|
|
|
|
|
|
|
UseSprintValue
|
62
|
|
|
|
|
|
|
UseEnums
|
63
|
|
|
|
|
|
|
UseNumeric
|
64
|
|
|
|
|
|
|
BestGuess
|
65
|
|
|
|
|
|
|
NonIncreasing
|
66
|
|
|
|
|
|
|
);
|
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
#----------------------------------------------------------
|
69
|
|
|
|
|
|
|
# Constructor
|
70
|
|
|
|
|
|
|
sub new {
|
71
|
|
|
|
|
|
|
my $class = shift;
|
72
|
|
|
|
|
|
|
my $self = bless {}, $class;
|
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
$self->{query_stack} = [];
|
75
|
|
|
|
|
|
|
$self->{results} = [];
|
76
|
|
|
|
|
|
|
$self->{max_in_flight} = 10;
|
77
|
|
|
|
|
|
|
$self->{current_in_flight} = 0;
|
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
$self->{this_run_issued} = 0;
|
80
|
|
|
|
|
|
|
$self->{this_run_finished} = 0;
|
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
$self->{grand_total_issued} = 0;
|
83
|
|
|
|
|
|
|
$self->{grand_total_finished} = 0;
|
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
return $self;
|
86
|
|
|
|
|
|
|
}
|
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
#---------------------------------------------------------
|
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
# Verifies that the named parameter is a subref
|
91
|
|
|
|
|
|
|
sub _check_param_callback {
|
92
|
|
|
|
|
|
|
my $self = shift;
|
93
|
|
|
|
|
|
|
my $param_name = shift; # string, hash key
|
94
|
|
|
|
|
|
|
my $params = shift; # hashref
|
95
|
|
|
|
|
|
|
return 1 unless exists $params->{$param_name};
|
96
|
|
|
|
|
|
|
croak "Bad parameter for [$param_name] - not a CODE ref"
|
97
|
|
|
|
|
|
|
if ref $params->{$param_name} ne 'CODE';
|
98
|
|
|
|
|
|
|
return 1;
|
99
|
|
|
|
|
|
|
}
|
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
#---------------------------------------------------------
|
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
# TODO Fill in the code and use in the add_XXX() or _make_XXX_query() methods
|
104
|
|
|
|
|
|
|
# Verifies that the named parameter is something the SNMP
|
105
|
|
|
|
|
|
|
# module can use as a VarBind or VarBindList.
|
106
|
|
|
|
|
|
|
sub _check_param_varbinds {
|
107
|
|
|
|
|
|
|
my $self = shift;
|
108
|
|
|
|
|
|
|
my $param_name = shift; # string, hash key
|
109
|
|
|
|
|
|
|
my $params = shift; # hashref
|
110
|
|
|
|
|
|
|
return;
|
111
|
|
|
|
|
|
|
}
|
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
#---------------------------------------------------------
|
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
sub add_getbulk {
|
116
|
|
|
|
|
|
|
my $self = shift;
|
117
|
|
|
|
|
|
|
my $params = shift;
|
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
my $query_stack = $self->{query_stack};
|
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
# These are required for all query ops so make sure they're present.
|
122
|
|
|
|
|
|
|
my $varbinds = $params->{VarBinds}
|
123
|
|
|
|
|
|
|
|| croak "Bad or missing parameter [VarBinds]";
|
124
|
|
|
|
|
|
|
my $query_type = $params->{QueryType}
|
125
|
|
|
|
|
|
|
|| croak "Bad or missing parameter [QueryType]";
|
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
# Make sure our callback params are valid.
|
128
|
|
|
|
|
|
|
$self->_check_param_callback( 'PreCallback', $params );
|
129
|
|
|
|
|
|
|
$self->_check_param_callback( 'PostCallback', $params );
|
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
if ( $query_type eq 'getbulk' ) {
|
132
|
|
|
|
|
|
|
my $query = $self->_make_getbulk_query($params);
|
133
|
|
|
|
|
|
|
my $query_stack = $self->{query_stack};
|
134
|
|
|
|
|
|
|
push @$query_stack, $query;
|
135
|
|
|
|
|
|
|
}
|
136
|
|
|
|
|
|
|
else {
|
137
|
|
|
|
|
|
|
croak "Attempt to add using unknown query type: $query_type\n";
|
138
|
|
|
|
|
|
|
}
|
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
return;
|
141
|
|
|
|
|
|
|
}
|
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
#---------------------------------------------------------
|
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
# NOTE This method has gotten long and complex.
|
147
|
|
|
|
|
|
|
# TODO Refactor, but think carefully.
|
148
|
|
|
|
|
|
|
#
|
149
|
|
|
|
|
|
|
# I see a couple of places where I can create closure-based memory leaks, and
|
150
|
|
|
|
|
|
|
# knowing myself, I could end up doing it inadvertenly at any time. It's code
|
151
|
|
|
|
|
|
|
# like this where some more experienced hackers could help me *big time*
|
152
|
|
|
|
|
|
|
sub _make_getbulk_query {
|
153
|
|
|
|
|
|
|
my $self = shift;
|
154
|
|
|
|
|
|
|
my $query_info = shift;
|
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
# These params are required for a getbulk query op.
|
157
|
|
|
|
|
|
|
my $non_repeaters =
|
158
|
|
|
|
|
|
|
exists $query_info->{NonRepeaters}
|
159
|
|
|
|
|
|
|
? $query_info->{NonRepeaters}
|
160
|
|
|
|
|
|
|
: croak "Bad or missing parameter [NonRepeaters]";
|
161
|
|
|
|
|
|
|
my $max_repeaters =
|
162
|
|
|
|
|
|
|
exists $query_info->{MaxRepeaters}
|
163
|
|
|
|
|
|
|
? $query_info->{MaxRepeaters}
|
164
|
|
|
|
|
|
|
: croak "Bad or missing parameter [MaxRepeaters]";
|
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
# Currently, these are validated in the add() method, so no need here.
|
167
|
|
|
|
|
|
|
my $preop_callback = $query_info->{PreCallback};
|
168
|
|
|
|
|
|
|
my $postop_callback = $query_info->{PostCallback};
|
169
|
|
|
|
|
|
|
my $batch_callback = $query_info->{BatchCallback};
|
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
# TODO I may want to add a method to validate
|
172
|
|
|
|
|
|
|
# and/or transform the VarBinds parameter
|
173
|
|
|
|
|
|
|
my $varbinds = $query_info->{VarBinds};
|
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
# Parse out the parameters for creating the session.
|
176
|
|
|
|
|
|
|
# I really think I should be validating them better here...
|
177
|
|
|
|
|
|
|
# Maybe I need a separate subroutine...
|
178
|
|
|
|
|
|
|
# TODO write the routine described above.
|
179
|
|
|
|
|
|
|
my %sess_params;
|
180
|
|
|
|
|
|
|
$sess_params{$_} = $query_info->{$_}
|
181
|
|
|
|
|
|
|
for grep { exists $query_info->{$_} } @valid_sess_params;
|
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
my $batch_size = $query_info->{BatchSize};
|
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
return sub {
|
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
# I wonder if this should be before or after the counter increments?
|
188
|
|
|
|
|
|
|
$preop_callback->() if $preop_callback;
|
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
$self->{current_in_flight}++;
|
191
|
|
|
|
|
|
|
$self->{this_run_issued}++;
|
192
|
|
|
|
|
|
|
$self->{grand_total_issued}++;
|
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
my $callback = sub {
|
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
my $bulkwalk_results = shift;
|
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
# Store the results and info about the query for later...
|
199
|
|
|
|
|
|
|
push @{ $self->{results} }, $query_info, $bulkwalk_results;
|
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
# NOTE should I do this callback here, or somewhere else? hmmmmm....
|
202
|
|
|
|
|
|
|
$postop_callback->() if $postop_callback;
|
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
# Am I introducing a bug with the increments
|
205
|
|
|
|
|
|
|
# here and the SNMP::finish() down below?
|
206
|
|
|
|
|
|
|
$self->{current_in_flight}--;
|
207
|
|
|
|
|
|
|
$self->{this_run_finished}++;
|
208
|
|
|
|
|
|
|
$self->{grand_total_finished}++;
|
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
$self->{BatchCallback}()
|
211
|
|
|
|
|
|
|
if $self->{BatchSize}
|
212
|
|
|
|
|
|
|
&& ( $self->{this_run_finished} % $self->{BatchSize} == 0 );
|
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
if ( scalar @{ $self->{query_stack} } ) {
|
215
|
|
|
|
|
|
|
my $next_query = pop @{ $self->{query_stack} };
|
216
|
|
|
|
|
|
|
return $next_query->();
|
217
|
|
|
|
|
|
|
}
|
218
|
|
|
|
|
|
|
$self->{current_in_flight} <= 0 ? return SNMP::finish() : return 1;
|
219
|
|
|
|
|
|
|
};
|
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
my $sess = SNMP::Session->new(%sess_params);
|
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
my $operation_id = $sess->bulkwalk( $non_repeaters, $max_repeaters,
|
224
|
|
|
|
|
|
|
$varbinds, [$callback] );
|
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
# Why, yes. I am being sneaky here. Since $query_info is referenced
|
227
|
|
|
|
|
|
|
# within the $callback closure, any data stored in the hash it points
|
228
|
|
|
|
|
|
|
# to should be available, regardless of whether is was stored before
|
229
|
|
|
|
|
|
|
# or after the closure definition.
|
230
|
|
|
|
|
|
|
$query_info->{OperationId} = $operation_id;
|
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
return; # No need to return anything, AFAICT.
|
233
|
|
|
|
|
|
|
};
|
234
|
|
|
|
|
|
|
}
|
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
#---------------------------------------------------------
|
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
sub current_in_flight { return shift->{current_in_flight} }
|
241
|
|
|
|
|
|
|
sub this_run_issued { return shift->{this_run_issued} }
|
242
|
|
|
|
|
|
|
sub this_run_finished { return shift->{this_run_finished} }
|
243
|
|
|
|
|
|
|
sub grand_total_issued { return shift->{grand_total_issued} }
|
244
|
|
|
|
|
|
|
sub grand_total_finished { return shift->{grand_total_finished} }
|
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
sub shuffle { } # TODO Implement with List::Util::shuffle
|
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
#---------------------------------------------------------
|
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
sub execute {
|
251
|
|
|
|
|
|
|
my $self = shift;
|
252
|
|
|
|
|
|
|
my $params = shift;
|
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
# The KeepLast option can come in handy if, for example, another
|
255
|
|
|
|
|
|
|
# thread or process is working on the contents of the results
|
256
|
|
|
|
|
|
|
# array from a previous execution and may not finish before the
|
257
|
|
|
|
|
|
|
# next execution.
|
258
|
|
|
|
|
|
|
@{ $self->{results} } = ()
|
259
|
|
|
|
|
|
|
unless (
|
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
# I'll make my OWN idioms from now on, HAHA! (You can explicitly
|
262
|
|
|
|
|
|
|
# set keeplast or it will use the object's default)
|
263
|
|
|
|
|
|
|
defined $params->{KeepLast} ? $params->{KeepLast} : $self->{KeepLast}
|
264
|
|
|
|
|
|
|
);
|
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
# Install 'batch' callback if applicable...
|
267
|
|
|
|
|
|
|
$self->{BatchCallback} = $params->{BatchCallback}
|
268
|
|
|
|
|
|
|
if $self->_check_param_callback( 'BatchCallback', $params );
|
269
|
|
|
|
|
|
|
$self->{BatchSize} = $params->{BatchSize};
|
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
# Determine our maximum concurrency level for this run
|
273
|
|
|
|
|
|
|
my $max_in_flight = $params->{InFlight} || $self->{max_in_flight};
|
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
# Make a copy of the stack in case we want to run the same query
|
276
|
|
|
|
|
|
|
my $query_stack_ref = $self->{query_stack};
|
277
|
|
|
|
|
|
|
my @query_stack_copy = @{ $self->{query_stack} };
|
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
# Set some counters
|
280
|
|
|
|
|
|
|
$self->{current_in_flight} = 0;
|
281
|
|
|
|
|
|
|
$self->{this_run_issued} = 0;
|
282
|
|
|
|
|
|
|
$self->{this_run_finished} = 0;
|
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
# Begin issuing operations
|
285
|
|
|
|
|
|
|
while ( scalar @$query_stack_ref ) {
|
286
|
|
|
|
|
|
|
my $query = pop @$query_stack_ref;
|
287
|
|
|
|
|
|
|
$query->();
|
288
|
|
|
|
|
|
|
last if $self->{current_in_flight} >= $max_in_flight;
|
289
|
|
|
|
|
|
|
}
|
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
# Wait for the ops to complete, or time-out (if specified)
|
292
|
|
|
|
|
|
|
$params->{MasterTimeout}
|
293
|
|
|
|
|
|
|
? SNMP::MainLoop( $params->{MasterTimeout}, &SNMP::finish() )
|
294
|
|
|
|
|
|
|
: SNMP::MainLoop();
|
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
# Reset the stack for the next run.
|
297
|
|
|
|
|
|
|
$self->{query_stack} = \@query_stack_copy;
|
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
return $self->get_results_ref();
|
300
|
|
|
|
|
|
|
}
|
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
#---------------------------------------------------------
|
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
# Returns a reference to the results array from executing the query.
|
305
|
|
|
|
|
|
|
sub get_results_ref {
|
306
|
|
|
|
|
|
|
return shift->{results};
|
307
|
|
|
|
|
|
|
}
|
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
1;
|
310
|
|
|
|
|
|
|
__END__
|