1package App::Netdisco::Util::SNMP;
2
3use Dancer qw/:syntax :script/;
4use App::Netdisco::Util::DeviceAuth 'get_external_credentials';
5
6use base 'Exporter';
7our @EXPORT = ();
8our @EXPORT_OK = qw/ get_communities snmp_comm_reindex /;
9our %EXPORT_TAGS = (all => \@EXPORT_OK);
10
11=head1 NAME
12
13App::Netdisco::Util::SNMP
14
15=head1 DESCRIPTION
16
17Helper functions for L<SNMP::Info> instances.
18
19There are no default exports, however the C<:all> tag will export all
20subroutines.
21
22=head1 EXPORT_OK
23
24=head2 get_communities( $device, $mode )
25
26Takes the current C<device_auth> setting and pushes onto the front of the list
27the last known good SNMP settings used for this mode (C<read> or C<write>).
28
29=cut
30
31sub get_communities {
32  my ($device, $mode) = @_;
33  $mode ||= 'read';
34
35  my $seen_tags = {}; # for cleaning community table
36  my $config = (setting('device_auth') || []);
37  my @communities = ();
38
39  # first of all, use external command if configured
40  push @communities, get_external_credentials($device, $mode);
41
42  # last known-good by tag
43  my $tag_name = 'snmp_auth_tag_'. $mode;
44  my $stored_tag = eval { $device->community->$tag_name };
45
46  if ($device->in_storage and $stored_tag) {
47    foreach my $stanza (@$config) {
48      if ($stanza->{tag} and $stored_tag eq $stanza->{tag}) {
49        push @communities, {%$stanza, only => [$device->ip]};
50        last;
51      }
52    }
53  }
54
55  # try last-known-good v2 read
56  push @communities, {
57    read => 1, write => 0, driver => 'snmp',
58    only => [$device->ip],
59    community => $device->snmp_comm,
60  } if defined $device->snmp_comm and $mode eq 'read';
61
62  # try last-known-good v2 write
63  my $snmp_comm_rw = eval { $device->community->snmp_comm_rw };
64  push @communities, {
65    write => 1, read => 0, driver => 'snmp',
66    only => [$device->ip],
67    community => $snmp_comm_rw,
68  } if $snmp_comm_rw and $mode eq 'write';
69
70  # clean the community table of obsolete tags
71  eval { $device->community->update({$tag_name => undef}) }
72    if $device->in_storage
73       and (not $stored_tag or !exists $seen_tags->{ $stored_tag });
74
75  return ( @communities, @$config );
76}
77
78=head2 snmp_comm_reindex( $snmp, $device, $vlan )
79
80Takes an established L<SNMP::Info> instance and makes a fresh connection using
81community indexing, with the given C<$vlan> ID. Works for all SNMP versions.
82
83Inherits the C<vtp_version> from the previous L<SNMP::Info> instance.
84
85Passing VLAN "C<0>" (zero) will reset the indexing to the basic v2 community
86or v3 empty context.
87
88=cut
89
90sub snmp_comm_reindex {
91  my ($snmp, $device, $vlan) = @_;
92  my $ver = $snmp->snmp_ver;
93  my $vtp = $snmp->vtp_version;
94
95  if ($ver == 3) {
96      my $prefix = '';
97      my @comms = get_communities($device, 'read');
98      # find a context prefix configured by the user
99      foreach my $c (@comms) {
100          next unless $c->{tag}
101            and $c->{tag} eq (eval { $device->community->snmp_auth_tag_read } || '');
102          $prefix = $c->{context_prefix} and last;
103      }
104      $prefix ||= 'vlan-';
105
106      if ($vlan =~ /^[0-9]+$/i && $vlan) {
107        debug sprintf '[%s] reindexing to "%s%s" (ver: %s, class: %s)',
108        $device->ip, $prefix, $vlan, $ver, $snmp->class;
109        $snmp->update(Context => ($prefix . $vlan));
110      } elsif ($vlan =~ /^[a-z0-9]+$/i && $vlan) {
111        debug sprintf '[%s] reindexing to "%s" (ver: %s, class: %s)',
112          $device->ip, $vlan, $ver, $snmp->class;
113        $snmp->update(Context => ($vlan));
114      } else {
115        debug sprintf '[%s] reindexing without context (ver: %s, class: %s)',
116          $device->ip, $ver, $snmp->class;
117        $snmp->update(Context => '');
118      }
119  }
120  else {
121      my $comm = $snmp->snmp_comm;
122
123      debug sprintf '[%s] reindexing to vlan %s (ver: %s, class: %s)',
124        $device->ip, $vlan, $ver, $snmp->class;
125      $vlan ? $snmp->update(Community => $comm . '@' . $vlan)
126            : $snmp->update(Community => $comm);
127  }
128
129  $snmp->cache({ _vtp_version => $vtp });
130  return $snmp;
131}
132
133true;
134