File Coverage

blib/lib/SNMP/NPAdmin/Neon.pm
Criterion Covered Total %
statement 7 9 77.7
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 10 12 83.3


line stmt bran cond sub pod time code
1             package SNMP::NPAdmin::Neon;
2              
3             #
4             # assumptions
5             # 1. only SNMPv1 will be supported initially
6             # 2. only mib-2 and printmib will be supported initially
7             # 3. SNMPv2 support will be added later
8             # 4. private mib support will be added after printmib support is complete
9             #
10             # a. found an HP JETDIRECT MIB; will incorporate that later.
11             #
12              
13 1     1   11 use strict;
  1         1  
  1         36  
14 1     1   4 use vars qw/ $VERSION $CVSver $VERBOSE $DEBUG /;
  1         1  
  1         69  
15              
16             $VERSION = '1.0';
17             $CVSver= '$Id: Neon.pm,v 1.6 2002/11/15 04:06:08 bozzio Exp $';
18              
19 1     1   6349 use SNMP;
  0            
  0            
20             $ENV{MIBS}='+Printer-MIB:JETDIRECT3-MIB';
21             $ENV{MIBDIRS}= sprintf '+%s/MIBs', ( $INC{'SNMP/NPAdmin/Neon.pm'} =~ m:(.+)/Neon.pm$: )[0];
22              
23             use vars qw/
24             %defaults
25             $list_code
26             %list_map
27             $table_code
28             %table_map
29             $mib2_str
30             $hostmib_template
31             $printmib_template
32             /;
33              
34             ##################################### defaults
35              
36             %defaults= (
37             timeout => 1000000,
38             port => 161,
39             retries => 5,
40             community => 'public'
41             );
42              
43             ##################################### MIB OID strings
44              
45             use constant MIB_2 => 0x1;
46             use constant HOST_MIB => 0x2;
47             use constant PRINTER_MIB => 0x4;
48              
49             $mib2_str= '.iso.org.dod.internet.mgmt.mib-2';
50             $hostmib_template= "$mib2_str.host.%s.%sTable";
51             $printmib_template= "$mib2_str.printmib.%s.%sTable";
52              
53             ##################################### table_code
54              
55             %table_map= (
56             # sub name MIBs template resource table
57             # -------- -------- -------- -------- -----
58             hrStorage => [ HOST_MIB, \$hostmib_template, 'hrStorage', ],
59             hrDevice => [ HOST_MIB, \$hostmib_template, 'hrStorage', ],
60             hrPrinter => [ HOST_MIB, \$hostmib_template, 'hrDevice', 'hrPrinter' ],
61             prtConsoleDisplayBuffer => [ PRINTER_MIB, \$printmib_template, 'prtConsoleDisplayBuffer', ],
62             prtInterpreter => [ PRINTER_MIB, \$printmib_template, 'prtInterpreter', ],
63             prtCover => [ PRINTER_MIB, \$printmib_template, 'prtCover', ],
64             prtMediaPath => [ PRINTER_MIB, \$printmib_template, 'prtMediaPath', ],
65             prtInput => [ PRINTER_MIB, \$printmib_template, 'prtInput', ],
66             prtMarker => [ PRINTER_MIB, \$printmib_template, 'prtMarker', ],
67             prtChannel => [ PRINTER_MIB, \$printmib_template, 'prtChannel', ],
68             prtMarkerSupplies => [ PRINTER_MIB, \$printmib_template, 'prtMarkerSupplies', ],
69             prtAlert => [ PRINTER_MIB, \$printmib_template, 'prtAlert', ],
70             );
71              
72             $table_code= q[
73             sub ##SUBNAME##
74             {
75             #warn "##SUBNAME##";
76             my $self= shift;
77             my $name= '##RESOURCE##';
78             my $name2= '##TABLE##';
79             my $table= sprintf( "##TEMPLATE##", $name, $name2);
80              
81             if ( ! $self->{$name} )
82             {
83             my $val= $self->_readTable( $table) if ! $self->{$name};
84             return undef if ! $val;
85              
86             $self->{$name}= $self->_convertTable( $val);
87             }
88              
89             $self->{MIBs} |= ##MIBS##;
90              
91             return $self->{$name};
92             }
93             ];
94              
95             ##################################### list_code
96              
97             %list_map= (
98             # sub name oid list
99             # -------- --------------------------------------------------------------------------------------------------------
100             mib2_system => [ 0x0,
101             [ q{
102             [ '.iso.org.dod.internet.mgmt.mib-2.system.sysDescr', 0],
103             [ '.iso.org.dod.internet.mgmt.mib-2.system.sysUpTime', 0],
104             [ '.iso.org.dod.internet.mgmt.mib-2.system.sysContact', 0],
105             [ '.iso.org.dod.internet.mgmt.mib-2.system.sysLocation', 0]
106             } ],
107             ],
108             hrMemorySize => [ HOST_MIB,
109             [ q{
110             [ '.iso.org.dod.internet.mgmt.mib-2.host.hrStorage.hrMemorySize', 0]
111             } ],
112             ],
113             hrPrinterStatus => [ HOST_MIB,
114             [ q{
115             [ '.iso.org.dod.internet.mgmt.mib-2.host.hrDevice.hrPrinterTable.hrPrinterEntry.hrPrinterStatus', 1]
116             } ],
117             ],
118             hp_npCfgSource => [ 0x0,
119             [ q{
120             [ '.iso.org.dod.internet.private.enterprises.hp.nm.interface.npCard.npCfg.npCfgSource', 0],
121             } ],
122             ],
123             hp_gdStatusId => [ 0x0,
124             [ q{
125             [ '.iso.org.dod.internet.private.enterprises.hp.nm.system.net-peripheral.net-printer.generalDeviceStatus.gdStatusId', 0]
126             } ],
127             ],
128             );
129              
130             $list_code= q{
131             sub ##SUBNAME##
132             {
133             #warn "##SUBNAME##";
134             my $self= shift;
135             my( $S, $vars);
136              
137             $S= $self->{snmp};
138              
139             $vars= SNMP::VarList->new( ##OIDLIST##);
140              
141             if ( ! $self->{##SUBNAME##} )
142             {
143             my @vals= $S->get( $vars) if ! $self->{##SUBNAME##};
144             return undef if $S->{ErrorNum};
145              
146             $self->{##SUBNAME##}= $self->_convertTable( $vars);
147             }
148              
149             $self->{MIBs} |= ##MIBS##;
150              
151             return $self->{##SUBNAME##};
152             }
153             };
154              
155             ##################################### AUTOLOAD
156              
157             use vars '$AUTOLOAD';
158             sub AUTOLOAD
159             {
160             #warn "AUTOLOAD";
161             my $autoload= ( $AUTOLOAD =~ /.*::(\w+)/ )[0];
162              
163             my( $sub, %tags);
164             if ( defined $table_map{$autoload} )
165             {
166             my @map= @{$table_map{$autoload}};
167             $sub= $table_code;
168             %tags= (
169             '##SUBNAME##' => $autoload,
170             '##MIBS##' => $map[0],
171             '##TEMPLATE##' => ${$map[1]},
172             '##RESOURCE##' => $map[2],
173             '##TABLE##' => $map[3] || $map[2],
174             );
175             }
176             elsif ( defined $list_map{$autoload} )
177             {
178             my @map= @{$list_map{$autoload}};
179             $sub= $list_code;
180             %tags= (
181             '##SUBNAME##' => $autoload,
182             '##MIBS##' => $map[0],
183             '##OIDLIST##' => @{$map[1]},
184             );
185             }
186              
187             if ( $sub )
188             {
189             map { $sub=~ s/\Q$_/$tags{$_}/g } keys %tags;
190             eval $sub;
191             die $@ if $@;
192             goto &$autoload;
193             }
194              
195             printf STDERR "Unimplemented method:\t'%s'\n", $AUTOLOAD;
196             return undef;
197             }
198              
199             ##################################### _readTable
200              
201             sub _readTable
202             {
203             #warn "_readTable";
204             my( $self, $table)= @_;
205             ( my $name = $table ) =~ s/^.*\.(\w+?)Table\..*$/$1/;
206             my $vb= SNMP::Varbind->new( [ $table, 0 ] );
207             my( $S, $vals);
208              
209             $S= $self->{snmp};
210              
211             for ( my $val= $S->getnext( $vb);
212             ( $vb->[0] =~ /^${table}/ );
213             # removed regex 'o' option; want optimization but need to handle different tables
214             $val= $S->getnext( $vb)
215             )
216             {
217             return undef
218             if $S->{ErrorNum};
219              
220             my( $oid, $iid)= (@$vb)[0,1];
221             next if ! $iid;
222             $oid =~ s/^${table}\.${name}Entry\.${name}(\w+)$/$1/o;
223             push @{$vals->{$iid}}, SNMP::Varbind->new( [ @$vb ]);
224             }
225              
226             return $vals;
227             }
228              
229             ##################################### _printTable
230              
231             sub _printTable
232             {
233             #warn "_printTable";
234             my( $self, $name, $vals)= @_;
235             $vals= $self->{$name};
236              
237             foreach my $instance ( values %$vals )
238             {
239             my @x;
240             foreach my $k ( keys %$instance )
241             {
242             my $n;
243             ( $n= $k ) =~ s/^.*\.${name}(\w+)$/$1/;
244             push @x, sprintf( "%s=\"%s\"", $n, $instance->{$k}->[2])
245             };
246             printf( "%s\n", join( ';', @x));
247             }
248             }
249              
250             ##################################### DESTROY
251              
252             sub DESTROY {};
253              
254             ##################################### version
255              
256             sub version
257             {
258             #warn "version";
259             return $VERSION;
260             }
261              
262             ##################################### verbose
263              
264             sub verbose
265             {
266             #warn "verbose";
267             $SNMP::debugging= 1;
268             }
269              
270             ##################################### debugsnmp
271              
272             sub debugsnmp
273             {
274             #warn "debugsnmp";
275             $SNMP::debugging= 2;
276             }
277              
278             ##################################### debug
279              
280             sub debug
281             {
282             #warn "debug";
283             my $class= shift;
284             my $value= shift;
285              
286             if ( defined $value )
287             {
288             $DEBUG= $value;
289             }
290             else
291             {
292             $DEBUG |= 1;
293             }
294             }
295              
296             ##################################### new
297              
298             sub new
299             {
300             #warn "new";
301             my $class= shift;
302             my %options= @_;
303             my $self;
304              
305             map { print "debug:\t$_ = $options{$_}\n" } keys %options if $DEBUG;
306              
307             $self->{snmp}= SNMP::Session->new(
308             DestHost => $options{printer},
309             RemotePort => $options{port} || $defaults{port},
310             Community => $options{community} || $defaults{community},
311             Timeout => $options{timeout} || $defaults{timeout},
312             Retries => $options{retries} || $defaults{retries},
313             UseLongNames => 1,
314             UseEnums => 1,
315             # UseNumeric => 1,
316             );
317              
318             return undef if ! $self->{snmp};
319              
320             bless $self, $class;
321             return $self;
322             }
323              
324             ##################################### reboot
325             #
326             # .iso.org.dod.internet.private.enterprises.hp.nm.interface.npCard.npCtl.npCtlReconfig
327             # .1.3.6.1.4.1.11.2.4.3.7.8
328             #
329              
330             ##################################### printmib
331              
332             sub printmib
333             {
334             #warn "printmib";
335             my $self= shift;
336             my( $S, $vars);
337              
338             $S= $self->{snmp};
339              
340             do {
341             my $vb= [ '.iso.org.dod.internet.mgmt.mib-2.printmib.prtMIBConformance', 0];
342             $S->getnext( $vb);
343             return undef if $S->{ErrorNum};
344             $self->{MIBs} |= PRINTER_MIB if $vb->[0] =~ /^\.iso\.org\.dod\.internet\.mgmt\.mib-2\.printmib\..*$/;
345             };
346              
347             return { printmib => ( $self->{MIBs} & PRINTER_MIB ) };
348             }
349              
350             ##################################### hostmib
351              
352             sub hostmib
353             {
354             #warn "hostmib";
355             my $self= shift;
356             my( $S, $vars);
357              
358             $S= $self->{snmp};
359              
360             do {
361             my $vb= [ '.iso.org.dod.internet.mgmt.mib-2.host.hrSystem.hrSystemUptime', 0];
362             $S->getnext( $vb);
363             return undef if $S->{ErrorNum};
364             $self->{MIBs} |= HOST_MIB if $vb->[0] =~ /^\.iso\.org\.dod\.internet\.mgmt\.mib-2\.host\..*$/;
365             };
366              
367             return { hostmib => ( $self->{MIBs} & HOST_MIB ) };
368             }
369              
370             ##################################### netconfig (all mib-2)
371             #
372             # .iso.org.dod.internet.mgmt.mib-2.interfaces.ifTable.ifEntry.ifType
373             # .iso.org.dod.internet.mgmt.mib-2.interfaces.ifTable.ifEntry.ifPhysAddress
374             # .iso.org.dod.internet.mgmt.mib-2.ip.ipAddrTable.ipAddrEntry.ipAdEntAddr
375             # .iso.org.dod.internet.mgmt.mib-2.ip.ipAddrTable.ipAddrEntry.ipAdEntNetMask
376             # .iso.org.dod.internet.mgmt.mib-2.ip.ipRouteTable.ipRouteEntry.ipRouteNextHop
377             #
378              
379             sub netconfig
380             {
381             #warn "netconfig";
382             my $self= shift;
383             my( $S, $vars);
384              
385             $S= $self->{snmp};
386             $vars= SNMP::VarList->new(
387             [ '.iso.org.dod.internet.mgmt.mib-2.interfaces.ifTable.ifEntry.ifType', 1],
388             [ '.iso.org.dod.internet.mgmt.mib-2.interfaces.ifTable.ifEntry.ifPhysAddress', 1],
389             );
390              
391             $S->get( $vars) || return undef;
392              
393             my $hex= '[0-9A-Ha-h]';
394             $vars->[1]->[2]= unpack( "H12", $vars->[1]->[2]);
395             $vars->[1]->[2] =~
396             s/^(${hex}{2})(${hex}{2})(${hex}{2})(${hex}{2})(${hex}{2})(${hex}{2})$/$1:$2:$3:$4:$5:$6/o;
397              
398             do {
399             my $vb= [ '.iso.org.dod.internet.mgmt.mib-2.ip.ipAddrTable.ipAddrEntry.ipAdEntAddr', 0];
400             $S->getnext( $vb);
401             return undef if $S->{ErrorNum};
402             push @$vars, $vb;
403             };
404              
405             do {
406             my $vb= [ '.iso.org.dod.internet.mgmt.mib-2.ip.ipAddrTable.ipAddrEntry.ipAdEntNetMask', $vars->[$#$vars]->[2]];
407             $S->get( $vb);
408             return undef if $S->{ErrorNum};
409             push @$vars, $vb;
410             };
411              
412             do {
413             my $vb= [ '.iso.org.dod.internet.mgmt.mib-2.ip.ipRouteTable.ipRouteEntry.ipRouteNextHop', '0.0.0.0'];
414             $S->get( $vb);
415             return undef if $S->{ErrorNum};
416             push @$vars, $vb;
417             };
418              
419             return $self->_convertTable( $vars);
420             }
421              
422             ##################################### _convertTable
423              
424             sub _convertTable
425             {
426             #warn "_convertTable";
427             my( $self, $data)= @_;
428             my @xdata;
429              
430             my $x;
431             if ( ref $data eq 'SNMP::VarList' )
432             {
433             my %x;
434             foreach my $var ( @$data )
435             {
436             my $name;
437             $name= ( $var->[0] =~ m/\.(\w+?)$/ )[0];
438             $x{$name}= $var->[2];
439             }
440             $x= \%x;
441             }
442             else
443             {
444             foreach my $k ( sort keys %$data )
445             {
446             my %x;
447             my $v= $data->{$k};
448              
449             foreach my $var ( @$v )
450             {
451             my $name;
452             $name= ( $var->[0] =~ m/\.(\w+?)$/ )[0];
453             $x{$name}= $var->[2];
454             }
455              
456             push @$x, \%x;
457             }
458             }
459             ## else
460             ## {
461             ## die "uh, oh! something went wrong: unexpected data format!";
462             ## }
463              
464             return $x;
465             }
466              
467             ##################################### the end
468             #
469             # $Id: Neon.pm,v 1.6 2002/11/15 04:06:08 bozzio Exp $
470             #
471              
472             1;