File Coverage

blib/lib/SNMP/Persist.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             SNMP::Persist - The SNMP pass_persist threaded backend
4              
5             =head1 VERSION
6              
7             Version 0.05
8              
9             =cut
10              
11             our $VERSION = '0.05';
12              
13             =head1 SYNOPSIS
14              
15             use SNMP::Persist qw(&define_oid &start_persister &define_subtree);
16             use strict;
17             use warnings;
18              
19              
20             #define base oid to host the subtree
21             define_oid(".1.3.6.1.4.1.2021.248");
22              
23             #start the thread serving answers
24             start_persister();
25              
26             #set first application number
27              
28             #loop forever to update the values
29             while(1) {
30              
31             my %subtree;
32             my $gameName;
33             my $index=1; #set first application number
34              
35             foreach $gameName ("game1", "game2") { #for each application
36             $subtree{"1." . $index}=["INTEGER",$index]; #set game index data pair
37             $subtree{"2." . $index}=["STRING",$gameName]; #set game name data pair
38             $subtree{"3." . $index}=["Counter32", 344.2 ]; #set total memory data pair
39             $index++; #next application
40             }
41              
42             #new values have arrived - notify the subtree controller
43             define_subtree(\%subtree);
44              
45             #don't update for next 5 minutes
46             sleep(300);
47             }
48              
49              
50             The script can be used in the following way from snmpd.conf:
51              
52             pass_persist .1.3.6.1.4.1.2021.248
53              
54              
55             =head1 DESCRIPTION
56              
57             The SNMP-Persist module is a backend for pass_persist feature of net-snmp.
58              
59             It simplifies the process of sharing user-specified data via SNMP and
60             development of persistent net-snmp applications controlling a chosen
61             MIB subtree.
62              
63             It is particularly useful if data gathering process takes too long.
64             The responder is a separate thread, which is not influenced by updates
65             of MIB subtree data.
66             The answer to a snmp request is fast and doesn't rely on potentially
67             slow source of data.
68              
69             =cut
70              
71              
72              
73              
74              
75              
76             package SNMP::Persist;
77              
78 1     1   29016 use 5.008;
  1         5  
  1         45  
79 1     1   7 use warnings;
  1         2  
  1         32  
80 1     1   6 use strict;
  1         7  
  1         47  
81 1     1   1029 use threads;
  0            
  0            
82             use threads::shared;
83             use Exporter;
84              
85             our @EXPORT_OK=qw(&define_subtree &start_persister &define_oid);
86             our @ISA=qw(Exporter);
87              
88             my $mib : shared;
89             my $mutex : shared;
90             my $base_oid : shared = ".1.3.6.1.4.1.2021.240";
91             my $conversation_thread;
92              
93             $|=1;
94              
95             sub define_subtree {
96             my $subtree=shift;
97             my $value;
98             my $item;
99              
100             #I expect a hash of two-elements arrays as an argument
101             #will create a copy of it to allow sharing between threads
102             #(sharing an array - empties an array :/ )
103              
104             #lets lock $mutex to hold queries till the update is finished
105             #or wait till the query is finished
106             lock($mutex);
107              
108             $mib=&share({});
109              
110             #the traverse & copy procedure
111             foreach $value (keys %{$subtree}) {
112             $mib->{$value}=&share([]);
113             $mib->{$value}[0]=$subtree->{$value}[0];
114             $mib->{$value}[1]=$subtree->{$value}[1];
115             } #foreach
116              
117             #do the sort here or after each getnext request
118             # #now, lets decide the order
119             # #sorted table of all oids
120             # my @s = sort { _oid_cmp($a, $b) } keys %{ $mib };
121             # #add a next_oid value to table of each oid
122             # for (my $i = 0; $i < @s; $i++) {
123             # $mib->{@s[$i]}[2]=@s[$i+1];
124             # } #for
125             } #define_subtree-end
126              
127              
128              
129             sub define_oid {
130             #set new base_oid
131             $base_oid=shift;
132             } #define_oid-end
133              
134              
135              
136              
137             sub start_persister {
138             if (!$conversation_thread) {
139             $conversation_thread=threads->create("_conversation_update","");
140             } else {
141             warn "Will not start conversation thread more then once.";
142             }
143             } #start-end
144              
145              
146              
147              
148             sub _conversation_update {
149              
150             #lets support PING, getnext and get queries in a loop
151             while(<>) {
152             if ( /PING\n/ ){
153             print "PONG\n";
154             } elsif ( /getnext\n/ ) {
155             lock($mutex);
156             #get next line with full oid
157             my $req_oid=;
158             if (! defined($mib)) {
159             print "NONE\n";
160             next;
161             }
162             my $found=0;
163             my $oid = _get_oid($req_oid);
164             #we don't need the sort really, what a waste it was!
165             #sort all saved oids to a table
166             #my @s = sort { _oid_cmp($a, $b) } keys %{ $mib };
167             my ($oid_higher, $oid_hash);
168             foreach $oid_hash (keys %{ $mib }) {
169             #if higher then the requested one
170             if (_oid_cmp($oid, $oid_hash) == -1 ) {
171             if (defined($oid_higher)) {
172             #if lower the the highest so far
173             if (_oid_cmp($oid_higher,$oid_hash) == 1) {
174             $oid_higher=$oid_hash;
175             }
176             } else {
177             $oid_higher=$oid_hash;
178             }
179             $found=1;
180             }
181             } #for
182             if (!$found) {
183             print "NONE\n";
184             } else {
185             print "$base_oid.".$oid_higher."\n"; #print full oid
186             print $mib->{$oid_higher}[0]."\n"; #print type
187             print $mib->{$oid_higher}[1]."\n"; #print value
188             }
189             } elsif ( /get\n/ ) {
190             lock($mutex);
191             my $req_oid=; #get next line with full oid
192             if (! defined($mib)) {
193             print "NONE\n";
194             next;
195             }
196             my $oid = _get_oid($req_oid);
197             if (defined $oid && defined($mib->{$oid})) {
198             print "$base_oid.$oid\n"; #print full oid
199             print $mib->{$oid}[0]."\n"; #print type
200             print $mib->{$oid}[1]."\n"; #print value
201             } else {
202             print "NONE\n";
203             }
204             } #if
205             } #while
206             #exit if snmpd has stopped
207             exit(0);
208             } #conversation_thread-end
209              
210             sub _oid_cmp {
211             my ($x, $y) = @_;
212             return -1 unless $y;
213             my @a = split /\./, $x;
214             my @b = split /\./, $y;
215              
216             my $i = 0; #oid string index
217            
218             #traverse the oid strings to compare them and return the value (-1,0,1)
219             while (1) {
220             if ($i > $#a) {
221             if ($i > $#b) {
222             return 0;
223             } else {
224             return -1;
225             }
226             } elsif ($i > $#b) {
227             return 1;
228             }
229              
230             if ($a[$i] < $b[$i]) {
231             return -1;
232             } elsif ($a[$i] > $b[$i]) {
233             return 1;
234             }
235             $i++;
236             } #while_end
237             } #oid_cmp-end
238              
239              
240             #remove the base from the OID
241             #and a sort of lousy input validation
242             sub _get_oid {
243             my $oid = shift;
244             chomp $oid;
245              
246             my $base = $base_oid;
247             $base =~ s/\./\\./g;
248              
249             if ($oid !~ /^$base(\.|$)/) {
250             #requested oid doesn't match base oid
251             return 0;
252             }
253              
254             $oid =~ s/^$base\.?//;
255             return $oid;
256             } #get_oid-end
257              
258              
259              
260              
261             1;
262              
263              
264              
265              
266              
267              
268              
269             =head1 FUNCTIONS
270              
271              
272             =head2 B
273              
274             Start the thread responsible for handling snmp requests.
275             The function expects a reference to a predefined hash of arrays.
276             Each array has to be built of two elements:
277              
278             =over 5
279              
280             =item * data type
281              
282             any SMI datatype supported by net-snmp (e.g. "INTEGER", "STRING", "Counter32")
283              
284             =item * value
285              
286             a value set accordingly to the data type
287              
288             =back
289              
290              
291             =head2 B
292              
293             Define the base oid for a mib subtree controlled by a script
294              
295             =head2 B
296              
297             Create or update the subtree data
298              
299              
300              
301             =head1 AUTHOR
302              
303             Anna Wiejak, C<< >>
304              
305              
306              
307             =head1 BUGS
308              
309             Please report any bugs or feature requests to
310             C, or through the web interface at
311             L.
312             I will be notified, and then you'll automatically be notified of progress on
313             your bug as I make changes.
314              
315             =head1 SUPPORT
316              
317             You can find documentation for this module with the perldoc command.
318              
319             perldoc SNMP::Persist
320              
321             You can also look for information at:
322              
323             =over 4
324              
325             =item * AnnoCPAN: Annotated CPAN documentation
326              
327             L
328              
329             =item * CPAN Ratings
330              
331             L
332              
333             =item * RT: CPAN's request tracker
334              
335             L
336              
337             =item * Search CPAN
338              
339             L
340              
341             =back
342              
343             =head1 COPYRIGHT & LICENSE
344              
345             Copyright 2006 Anna Wiejak, all rights reserved.
346              
347             This program is free software; you can redistribute it and/or modify it
348             under the same terms as Perl itself.
349              
350             =cut
351              
352             1; # End of SNMP::Persist