1package App::Netdisco::Transport::SNMP;
2
3use Dancer qw/:syntax :script/;
4use Dancer::Plugin::DBIC 'schema';
5
6use App::Netdisco::Util::SNMP 'get_communities';
7use App::Netdisco::Util::Device 'get_device';
8use App::Netdisco::Util::Permission ':all';
9
10use SNMP::Info;
11use Try::Tiny;
12use Module::Load ();
13use Path::Class 'dir';
14use NetAddr::IP::Lite ':lower';
15use List::Util qw/pairkeys pairfirst/;
16
17use base 'Dancer::Object::Singleton';
18
19=head1 NAME
20
21App::Netdisco::Transport::SNMP
22
23=head1 DESCRIPTION
24
25Singleton for SNMP connections. Returns cached L<SNMP::Info> instance for a
26given device IP, or else undef. All methods are class methods, for example:
27
28 my $snmp = App::Netdisco::Transport::SNMP->reader_for( ... );
29
30=cut
31
32__PACKAGE__->attributes(qw/ readers writers /);
33
34sub init {
35  my ( $class, $self ) = @_;
36  $self->readers( {} );
37  $self->writers( {} );
38  return $self;
39}
40
41=head1 reader_for( $ip, $useclass? )
42
43Given an IP address, returns an L<SNMP::Info> instance configured for and
44connected to that device. The IP can be any on the device, and the management
45interface will be connected to.
46
47If the device is known to Netdisco and there is a cached SNMP community
48string, that community will be tried first, and then other community strings
49from the application configuration will be tried.
50
51If C<$useclass> is provided, it will be used as the L<SNMP::Info> device
52class instead of the class in the Netdisco database.
53
54Returns C<undef> if the connection fails.
55
56=cut
57
58sub reader_for {
59  my ($class, $ip, $useclass) = @_;
60  my $device = get_device($ip) or return undef;
61  return undef if $device->in_storage and $device->is_pseudo;
62
63  my $readers = $class->instance->readers or return undef;
64  return $readers->{$device->ip} if exists $readers->{$device->ip};
65
66  debug sprintf 'snmp reader cache warm: [%s]', $device->ip;
67  return ($readers->{$device->ip}
68    = _snmp_connect_generic('read', $device, $useclass));
69}
70
71=head1 test_connection( $ip )
72
73Similar to C<reader_for> but will use the literal IP address passed, and does
74not support specifying the device class. The purpose is to test the SNMP
75connectivity to the device before a renumber.
76
77Attempts to have no side effect, however there will be a stored SNMP
78authentication hint (tag) in the database if the connection is successful.
79
80Returns C<undef> if the connection fails.
81
82=cut
83
84sub test_connection {
85  my ($class, $ip) = @_;
86  my $addr = NetAddr::IP::Lite->new($ip) or return undef;
87  # avoid renumbering to localhost loopbacks
88  return undef if $addr->addr eq '0.0.0.0'
89                  or check_acl_no($addr->addr, 'group:__LOCAL_ADDRESSES__');
90  my $device = schema('netdisco')->resultset('Device')
91    ->new_result({ ip => $addr->addr }) or return undef;
92  my $readers = $class->instance->readers or return undef;
93  return $readers->{$device->ip} if exists $readers->{$device->ip};
94  debug sprintf 'snmp reader cache warm: [%s]', $device->ip;
95  return ($readers->{$device->ip} = _snmp_connect_generic('read', $device));
96}
97
98=head1 writer_for( $ip, $useclass? )
99
100Same as C<reader_for> but uses the read-write community strings from the
101application configuration file.
102
103Returns C<undef> if the connection fails.
104
105=cut
106
107sub writer_for {
108  my ($class, $ip, $useclass) = @_;
109  my $device = get_device($ip) or return undef;
110  return undef if $device->in_storage and $device->is_pseudo;
111
112  my $writers = $class->instance->writers or return undef;
113  return $writers->{$device->ip} if exists $writers->{$device->ip};
114
115  debug sprintf 'snmp writer cache warm: [%s]', $device->ip;
116  return ($writers->{$device->ip}
117    = _snmp_connect_generic('write', $device, $useclass));
118}
119
120sub _snmp_connect_generic {
121  my ($mode, $device, $useclass) = @_;
122  $mode ||= 'read';
123
124  my %snmp_args = (
125    AutoSpecify => 0,
126    DestHost => $device->ip,
127    # 0 is falsy. Using || with snmpretries equal to 0 will set retries to 2.
128    # check if the setting is 0. If not, use the default value of 2.
129    Retries => (setting('snmpretries') || setting('snmpretries') == 0 ? 0 : 2),
130    Timeout => (setting('snmptimeout') || 1000000),
131    NonIncreasing => (setting('nonincreasing') || 0),
132    BulkWalk => ((defined setting('bulkwalk_off') && setting('bulkwalk_off'))
133                 ? 0 : 1),
134    BulkRepeaters => (setting('bulkwalk_repeaters') || 20),
135    MibDirs => [ _build_mibdirs() ],
136    IgnoreNetSNMPConf => 1,
137    Debug => ($ENV{INFO_TRACE} || 0),
138    DebugSNMP => ($ENV{SNMP_TRACE} || 0),
139  );
140
141  # an override for RemotePort
142  ($snmp_args{RemotePort}) =
143    (pairkeys pairfirst { check_acl_no($device, $b) }
144      %{setting('snmp_remoteport') || {}}) || 161;
145
146  # an override for bulkwalk
147  $snmp_args{BulkWalk} = 0 if check_acl_no($device, 'bulkwalk_no');
148
149  # further protect against buggy Net-SNMP, and disable bulkwalk
150  if ($snmp_args{BulkWalk}
151      and ($SNMP::VERSION eq '5.0203' || $SNMP::VERSION eq '5.0301')) {
152
153      warning sprintf
154        "[%s] turning off BulkWalk due to buggy Net-SNMP - please upgrade!",
155        $device->ip;
156      $snmp_args{BulkWalk} = 0;
157  }
158
159  # get the community string(s)
160  my @communities = get_communities($device, $mode);
161
162  # which SNMP versions to try and in what order
163  my @versions =
164    ( check_acl_no($device->ip, 'snmpforce_v3') ? (3)
165    : check_acl_no($device->ip, 'snmpforce_v2') ? (2)
166    : check_acl_no($device->ip, 'snmpforce_v1') ? (1)
167    : (reverse (1 .. (setting('snmpver') || 3))) );
168
169  # use existing or new device class
170  my @classes = ($useclass || 'SNMP::Info');
171  if ($device->snmp_class and not $useclass) {
172      unshift @classes, $device->snmp_class;
173  }
174
175  my $info = undef;
176  COMMUNITY: foreach my $comm (@communities) {
177      next unless $comm;
178
179      VERSION: foreach my $ver (@versions) {
180          next unless $ver;
181
182          next if $ver eq 3 and exists $comm->{community};
183          next if $ver ne 3 and !exists $comm->{community};
184
185          CLASS: foreach my $class (@classes) {
186              next unless $class;
187
188              my %local_args = (%snmp_args, Version => $ver);
189              $info = _try_connect($device, $class, $comm, $mode, \%local_args,
190                ($useclass ? 0 : 1) );
191              last COMMUNITY if $info;
192          }
193      }
194  }
195
196  return $info;
197}
198
199sub _try_connect {
200  my ($device, $class, $comm, $mode, $snmp_args, $reclass) = @_;
201  my %comm_args = _mk_info_commargs($comm);
202  my $debug_comm = '<hidden>';
203  if ($ENV{ND2_SHOW_COMMUNITY} || $ENV{SHOW_COMMUNITY}) {
204    $debug_comm = ($comm->{community} ||
205      (sprintf 'v3:%s:%s/%s', ($comm->{user},
206                              ($comm->{auth}->{proto} || 'noAuth'),
207                              ($comm->{priv}->{proto} || 'noPriv'))) );
208  }
209  my $info = undef;
210
211  try {
212      debug
213        sprintf '[%s:%s] try_connect with ver: %s, class: %s, comm: %s',
214          $snmp_args->{DestHost}, $snmp_args->{RemotePort},
215          $snmp_args->{Version}, $class, $debug_comm;
216      Module::Load::load $class;
217
218      $info = $class->new(%$snmp_args, %comm_args) or return;
219      $info = ($mode eq 'read' ? _try_read($info, $device, $comm)
220                               : _try_write($info, $device, $comm));
221
222      # first time a device is discovered, re-instantiate into specific class
223      if ($reclass and $info and $info->device_type ne $class) {
224          $class = $info->device_type;
225          debug
226            sprintf '[%s:%s] try_connect with ver: %s, new class: %s, comm: %s',
227              $snmp_args->{DestHost}, $snmp_args->{RemotePort},
228              $snmp_args->{Version}, $class, $debug_comm;
229
230          Module::Load::load $class;
231          $info = $class->new(%$snmp_args, %comm_args);
232      }
233  }
234  catch {
235      debug $_;
236  };
237
238  return $info;
239}
240
241sub _try_read {
242  my ($info, $device, $comm) = @_;
243
244  return undef unless (
245    (not defined $info->error)
246    and defined $info->uptime
247    and ($info->layers or $info->description)
248    and $info->class
249  );
250
251  $device->in_storage
252    ? $device->update({snmp_ver => $info->snmp_ver})
253    : $device->set_column(snmp_ver => $info->snmp_ver);
254
255  if ($comm->{community}) {
256      $device->in_storage
257        ? $device->update({snmp_comm => $comm->{community}})
258        : $device->set_column(snmp_comm => $comm->{community});
259  }
260
261  # regardless of device in storage, save the hint
262  $device->update_or_create_related('community',
263    {snmp_auth_tag_read => $comm->{tag}}) if $comm->{tag};
264
265  return $info;
266}
267
268sub _try_write {
269  my ($info, $device, $comm) = @_;
270
271  my $loc = $info->load_location;
272  $info->set_location($loc) or return undef;
273  return undef unless ($loc eq $info->load_location);
274
275  $device->in_storage
276    ? $device->update({snmp_ver => $info->snmp_ver})
277    : $device->set_column(snmp_ver => $info->snmp_ver);
278
279  # one of these two cols must be set
280  $device->update_or_create_related('community', {
281    ($comm->{tag} ? (snmp_auth_tag_write => $comm->{tag}) : ()),
282    ($comm->{community} ? (snmp_comm_rw => $comm->{community}) : ()),
283  });
284
285  return $info;
286}
287
288sub _mk_info_commargs {
289  my $comm = shift;
290  return () unless ref {} eq ref $comm and scalar keys %$comm;
291
292  return (Community => $comm->{community})
293    if exists $comm->{community};
294
295  my $seclevel =
296    (exists $comm->{auth} ?
297    (exists $comm->{priv} ? 'authPriv' : 'authNoPriv' )
298                          : 'noAuthNoPriv');
299
300  return (
301    SecName  => $comm->{user},
302    SecLevel => $seclevel,
303    ( exists $comm->{auth} ? (
304      AuthProto => uc ($comm->{auth}->{proto} || 'MD5'),
305      AuthPass  => ($comm->{auth}->{pass} || ''),
306      ( exists $comm->{priv} ? (
307        PrivProto => uc ($comm->{priv}->{proto} || 'DES'),
308        PrivPass  => ($comm->{priv}->{pass} || ''),
309      ) : ()),
310    ) : ()),
311  );
312}
313
314sub _build_mibdirs {
315  my $home = (setting('mibhome') || dir(($ENV{NETDISCO_HOME} || $ENV{HOME}), 'netdisco-mibs'));
316  return map { dir($home, $_)->stringify }
317             @{ setting('mibdirs') || _get_mibdirs_content($home) };
318}
319
320sub _get_mibdirs_content {
321  my $home = shift;
322  my @list = map {s|$home/||; $_} grep {m/[a-z0-9]/} grep {-d} glob("$home/*");
323  return \@list;
324}
325
326true;
327