File Coverage

blib/lib/FusionInventory/Agent/SNMP/Live.pm
Criterion Covered Total %
statement 37 88 42.0
branch 17 76 22.3
condition n/a
subroutine 7 11 63.6
pod 5 5 100.0
total 66 180 36.6


line stmt bran cond sub pod time code
1             package FusionInventory::Agent::SNMP::Live;
2              
3 2     2   3955523 use strict;
  2         12  
  2         69  
4 2     2   7 use warnings;
  2         3  
  2         82  
5 2     2   10 use base 'FusionInventory::Agent::SNMP';
  2         33  
  2         811  
6              
7 2     2   9 use Encode qw(encode);
  2         2  
  2         81  
8 2     2   9 use English qw(-no_match_vars);
  2         3  
  2         17  
9 2     2   2013 use Net::SNMP;
  2         98055  
  2         1510  
10              
11             sub new {
12 6     6 1 2650 my ($class, %params) = @_;
13              
14 6 100       26 die "no hostname parameters" unless $params{hostname};
15              
16             my $version =
17             ! $params{version} ? 'snmpv1' :
18             $params{version} eq '1' ? 'snmpv1' :
19             $params{version} eq '2c' ? 'snmpv2c' :
20 5 50       25 $params{version} eq '3' ? 'snmpv3' :
    50          
    100          
    50          
21             undef ;
22              
23 5 100       26 die "invalid SNMP version $params{version}" unless $version;
24              
25 3         3 my $self;
26              
27             # shared options
28             my %options = (
29             -retries => 0,
30             -version => $version,
31             -hostname => $params{hostname},
32 3         16 );
33 3 50       10 $options{'-timeout'} = $params{timeout} if $params{timeout};
34              
35             # version-specific options
36 3 50       8 if ($version eq 'snmpv3') {
37             # only username is mandatory
38 0         0 $options{'-username'} = $params{username};
39             $options{'-authprotocol'} = $params{authprotocol}
40 0 0       0 if $params{authprotocol};
41             $options{'-authpassword'} = $params{authpassword}
42 0 0       0 if $params{authpassword};
43             $options{'-privprotocol'} = $params{privprotocol}
44 0 0       0 if $params{privprotocol};
45             $options{'-privpassword'} = $params{privpassword}
46 0 0       0 if $params{privpassword};
47             } else { # snmpv2c && snmpv1 #
48 3         8 $options{'-community'} = $params{community};
49 3         5 $self->{community} = $params{community};
50             }
51              
52 3         20 ($self->{session}, my $error) = Net::SNMP->session(%options);
53 3 100       31022 if (!$self->{session}) {
54 2 50       8 die "no response from host $params{hostname}\n"
55             if $error =~ /^No response from remote host/;
56 2 50       23 die "authentication error on host $params{hostname}\n"
57             if $error =~ /^Received usmStats(WrongDigests|UnknownUserNames)/;
58 2         40 die $error . "\n";
59             }
60              
61 1 50       4 if ($version ne 'snmpv3') {
62 1         2 my $oid = '.1.3.6.1.2.1.1.1.0';
63             my $response = $self->{session}->get_request(
64 1         7 -varbindlist => [$oid]
65             );
66 1 50       5006950 die "no response from host $params{hostname}\n"
67             if !$response;
68             die "no response from host $params{hostname}\n"
69 0 0         if $response->{$oid} =~ /No response from remote host/;
70             }
71              
72 0           bless $self, $class;
73              
74 0           return $self;
75             }
76              
77             sub switch_vlan_context {
78 0     0 1   my ($self, $vlan_id) = @_;
79              
80 0           my $version_id = $self->{session}->version();
81              
82 0 0         my $version =
    0          
    0          
83             $version_id == 0 ? 'snmpv1' :
84             $version_id == 1 ? 'snmpv2c' :
85             $version_id == 3 ? 'snmpv3' :
86             undef ;
87              
88 0           my $error;
89 0 0         if ($version eq 'snmpv3') {
90 0           $self->{context} = 'vlan-' . $vlan_id;
91             } else {
92             # save original session
93 0 0         $self->{oldsession} = $self->{session} unless $self->{oldsession};
94             ($self->{session}, $error) = Net::SNMP->session(
95             -timeout => $self->{session}->timeout(),
96             -retries => 0,
97             -version => $version,
98             -hostname => $self->{session}->hostname(),
99 0           -community => $self->{community} . '@' . $vlan_id
100             );
101             }
102              
103 0 0         die $error unless $self->{session};
104             }
105              
106             sub reset_original_context {
107 0     0 1   my ($self) = @_;
108              
109 0           my $version_id = $self->{session}->version();
110              
111 0 0         my $version =
    0          
    0          
112             $version_id == 0 ? 'snmpv1' :
113             $version_id == 1 ? 'snmpv2c' :
114             $version_id == 3 ? 'snmpv3' :
115             undef ;
116              
117 0 0         if ($version eq 'snmpv3') {
118 0           delete $self->{context};
119             } else {
120 0           $self->{session} = $self->{oldsession};
121 0           delete $self->{oldsession};
122             }
123             }
124              
125             sub get {
126 0     0 1   my ($self, $oid) = @_;
127              
128 0 0         return unless $oid;
129              
130 0           my $session = $self->{session};
131 0           my %options = (-varbindlist => [$oid]);
132 0 0         $options{'-contextname'} = $self->{context} if $self->{context};
133              
134 0           my $response = $session->get_request(%options);
135              
136 0 0         return unless $response;
137              
138 0 0         return if $response->{$oid} =~ /noSuchInstance/;
139 0 0         return if $response->{$oid} =~ /noSuchObject/;
140 0 0         return if $response->{$oid} =~ /No response from remote host/;
141              
142              
143 0           my $value = $response->{$oid};
144              
145 0           return $value;
146             }
147              
148             sub walk {
149 0     0 1   my ($self, $oid) = @_;
150              
151 0 0         return unless $oid;
152              
153 0           my $session = $self->{session};
154 0           my %options = (-baseoid => $oid);
155 0 0         $options{'-contextname'} = $self->{context} if $self->{context};
156 0 0         $options{'-maxrepetitions'} = 1 if $session->version() != 0;
157              
158 0           my $response = $session->get_table(%options);
159              
160 0 0         return unless $response;
161              
162 0           my $values;
163 0           my $offset = length($oid) + 1;
164              
165 0           foreach my $oid (keys %{$response}) {
  0            
166 0           my $value = $response->{$oid};
167 0           $values->{substr($oid, $offset)} = $value;
168             }
169              
170 0           return $values;
171             }
172              
173             1;
174             __END__