Bug fixes to discovery; add root_ip handling.

Squashed commit of the following:

commit cb6f125c73
Author: Oliver Gorwits <oliver@cpan.org>
Date:   Sat Apr 13 20:26:59 2013 +0100

    discover root_ip properly

commit 8228e73f5b
Author: Oliver Gorwits <oliver@cpan.org>
Date:   Sat Apr 13 19:47:23 2013 +0100

    better name for util package

commit 4546036f4f
Author: Oliver Gorwits <oliver@cpan.org>
Date:   Sat Apr 13 19:23:55 2013 +0100

    bug fixes in getting wireless info

commit 78554e5516
Author: Oliver Gorwits <oliver@cpan.org>
Date:   Sat Apr 13 19:07:44 2013 +0100

    refactor snmp_connect to handle versions and device classes

commit ca9edd114a
Author: Oliver Gorwits <oliver@cpan.org>
Date:   Sat Apr 13 15:23:52 2013 +0100

    rename discoverall to discovernew

commit 1b897e4aee
Author: Oliver Gorwits <oliver@cpan.org>
Date:   Sat Apr 13 14:51:06 2013 +0100

    change debug log tag for store_device

commit 8a5306e056
Author: Oliver Gorwits <oliver@cpan.org>
Date:   Sat Apr 13 14:50:10 2013 +0100

    rename Discover.pm to Device.pm

commit 3197e38819
Author: Oliver Gorwits <oliver@cpan.org>
Date:   Sat Apr 13 14:48:31 2013 +0100

    allow netdisco-do to do all acton

Netdisco/bin/netdisco-do

@@ -30,40 +30,35 @@ my $result = GetOptions(
   'debug|D'    => \$debug,
 ) or exit(1);
 
-# reconfigure logging to use console
 my $CONFIG = config();
 $CONFIG->{logger} = 'console';
 $CONFIG->{log} = ($debug ? 'debug' : 'info');
 
+# reconfigure logging to force console output
 Dancer::Logger->init('console', $CONFIG);
 
-# check requested action
+# get requested action
 my $action = shift @ARGV;
-my $PERMITTED_ACTIONS = qr/(?:discover|discover_neighbors)/;
 
 if (!length $action) {
   error 'error: missing action!';
   exit (1);
 }
 
-if ($action !~ m/^$PERMITTED_ACTIONS$/) {
-  error sprintf 'error: netdisco-do cannot [%s]', $action;
-  exit (1);
-}
-
-if (!length $device) {
-  error 'error: missing device!';
-  exit (1);
-}
-
 # create worker (placeholder object for the role methods)
 {
   package MyWorker;
   use Moo;
-  with 'App::Netdisco::Daemon::Worker::Poller::Discover';
+  with 'App::Netdisco::Daemon::Worker::Poller::Device';
 }
 my $worker = MyWorker->new();
 
+# belt and braces check before we go ahead
+if (not $worker->can( $action )) {
+  error sprintf 'error: %s is not a valid action', $action;
+  exit (1);
+}
+
 # static configuration for the in-memory local job queue
 setting('plugins')->{DBIC}->{daemon} = {
     dsn => 'dbi:SQLite:dbname=:memory:',
@@ -85,12 +80,6 @@ my $job = schema('daemon')->resultset('Admin')->new_result({
   subaction => $extra,
 });
 
-# belt and braces check before we go ahead
-if (not $worker->can( $action )) {
-  error sprintf 'error: %s is not a valid action for netdisco-do', $action;
-  exit (1);
-}
-
 # do job
 my ($status, $log);
 try {

Netdisco/lib/App/Netdisco/Daemon/Queue.pm

@@ -33,7 +33,7 @@ sub capacity_for {
   debug "checking local capacity for action $action";
 
   my $action_map = {
-    Poller => [qw/refresh discover discoverall discover_neighbors/],
+    Poller => [qw/refresh discover discovernew discover_neighbors/],
     Interactive => [qw/location contact portcontrol portname vlan power/],
   };
 

Netdisco/lib/App/Netdisco/Daemon/Util.pm

@@ -1,4 +1,4 @@
-package App::Netdisco::Daemon::Worker::Interactive::Util;
+package App::Netdisco::Daemon::Util;
 
 # support utilities for Daemon Actions
 

Netdisco/lib/App/Netdisco/Daemon/Worker/Interactive/DeviceActions.pm

@@ -1,8 +1,8 @@
 package App::Netdisco::Daemon::Worker::Interactive::DeviceActions;
 
-use App::Netdisco::Util::SNMP ':all';
+use App::Netdisco::Util::SNMP 'snmp_connect_rw';
 use App::Netdisco::Util::Device 'get_device';
-use App::Netdisco::Daemon::Worker::Interactive::Util ':all';
+use App::Netdisco::Daemon::Util ':all';
 
 use Role::Tiny;
 use namespace::clean;

Netdisco/lib/App/Netdisco/Daemon/Worker/Interactive/PortActions.pm

@@ -1,8 +1,8 @@
 package App::Netdisco::Daemon::Worker::Interactive::PortActions;
 
-use App::Netdisco::Util::SNMP ':all';
 use App::Netdisco::Util::Port ':all';
-use App::Netdisco::Daemon::Worker::Interactive::Util ':all';
+use App::Netdisco::Util::SNMP 'snmp_connect_rw';
+use App::Netdisco::Daemon::Util ':all';
 
 use Role::Tiny;
 use namespace::clean;

Netdisco/lib/App/Netdisco/Daemon/Worker/Manager.pm

@@ -14,7 +14,7 @@ my $fqdn = hostfqdn || 'localhost';
 
 my $role_map = {
   (map {$_ => 'Poller'}
-      qw/refresh discover discoverall discover_neighbors/),
+      qw/refresh discover discovernew discover_neighbors/),
   (map {$_ => 'Interactive'}
       qw/location contact portcontrol portname vlan power/)
 };

Netdisco/lib/App/Netdisco/Daemon/Worker/Poller.pm

@@ -9,7 +9,7 @@ use Role::Tiny;
 use namespace::clean;
 
 # add dispatch methods for poller tasks
-with 'App::Netdisco::Daemon::Worker::Poller::Discover';
+with 'App::Netdisco::Daemon::Worker::Poller::Device';
 
 sub worker_body {
   my $self = shift;

Netdisco/lib/App/Netdisco/Daemon/Worker/Poller/Device.pm

@@ -1,4 +1,4 @@
-package App::Netdisco::Daemon::Worker::Poller::Discover;
+package App::Netdisco::Daemon::Worker::Poller::Device;
 
 use Dancer qw/:moose :syntax :script/;
 use Dancer::Plugin::DBIC 'schema';
@@ -6,7 +6,7 @@ use Dancer::Plugin::DBIC 'schema';
 use App::Netdisco::Util::SNMP 'snmp_connect';
 use App::Netdisco::Util::Device 'get_device';
 use App::Netdisco::Util::DiscoverAndStore ':all';
-use App::Netdisco::Daemon::Worker::Interactive::Util ':all';
+use App::Netdisco::Daemon::Util ':all';
 
 use NetAddr::IP::Lite ':lower';
 
@@ -53,7 +53,7 @@ sub discover {
 
 # run find_neighbors on all known devices, and run discover on any
 # newly found devices.
-sub discoverall {
+sub discovernew {
   my ($self, $job) = @_;
 
   my $devices = schema('netdisco')->resultset('Device')->get_column('ip');

Netdisco/lib/App/Netdisco/Daemon/Worker/Scheduler.pm

@@ -11,10 +11,10 @@ use namespace::clean;
 
 my $jobactions = {
   map {$_ => undef} qw/
+      refresh
+      discovernew
   /
 #    saveconfigs
-#    discoverall
-#    refresh
 #    macwalk
 #    arpwalk
 #    nbtwalk

Netdisco/lib/App/Netdisco/Util/DNS.pm

@@ -8,7 +8,7 @@ use Net::DNS;
 use base 'Exporter';
 our @EXPORT = ();
 our @EXPORT_OK = qw/
-  hostname_from_ip
+  hostname_from_ip ipv4_from_hostname
 /;
 our %EXPORT_TAGS = (all => \@EXPORT_OK);
 
@@ -35,6 +35,7 @@ Returns C<undef> if no PTR record exists for the IP.
 
 sub hostname_from_ip {
   my $ip = shift;
+  return unless $ip;
 
   my $res   = Net::DNS::Resolver->new;
   my $query = $res->search($ip);
@@ -49,5 +50,30 @@ sub hostname_from_ip {
   return undef;
 }
 
+=head2 ipv4_from_hostname( $name )
+
+Given a host name will return the first IPv4 address.
+
+Returns C<undef> if no A record exists for the name.
+
+=cut
+
+sub ipv4_from_hostname {
+  my $name = shift;
+  return unless $name;
+
+  my $res   = Net::DNS::Resolver->new;
+  my $query = $res->search($name);
+
+  if ($query) {
+      foreach my $rr ($query->answer) {
+          next unless $rr->type eq "A";
+          return $rr->address;
+      }
+  }
+
+  return undef;
+}
+
 1;
 

Netdisco/lib/App/Netdisco/Util/DiscoverAndStore.pm

@@ -4,7 +4,7 @@ use Dancer qw/:syntax :script/;
 use Dancer::Plugin::DBIC 'schema';
 
 use App::Netdisco::Util::Device 'get_device';
-use App::Netdisco::Util::DNS 'hostname_from_ip';
+use App::Netdisco::Util::DNS ':all';
 use NetAddr::IP::Lite ':lower';
 use Try::Tiny;
 
@@ -47,6 +47,12 @@ sub store_device {
   my $interfaces = $snmp->interfaces;
   my $ip_netmask = $snmp->ip_netmask;
 
+  # find root IP
+  _set_canonical_ip($device, $snmp);
+
+  my $hostname = hostname_from_ip($device->ip);
+  $device->dns($hostname) if length $hostname;
+
   # build device aliases suitable for DBIC
   my @aliases;
   foreach my $entry (keys %$ip_index) {
@@ -63,7 +69,7 @@ sub store_device {
         ? NetAddr::IP::Lite->new($addr, $ip_netmask->{$addr})->network->cidr
         : undef;
 
-      debug sprintf ' [%s] store_device - aliased as %s', $device->ip, $addr;
+      debug sprintf ' [%s] device - aliased as %s', $device->ip, $addr;
       push @aliases, {
           alias => $addr,
           port => $port,
@@ -79,9 +85,6 @@ sub store_device {
       $device->vtp_domain( (values %$vtpdomains)[-1] );
   }
 
-  my $hostname = hostname_from_ip($device->ip);
-  $device->dns($hostname) if length $hostname;
-
   my @properties = qw/
     snmp_ver snmp_comm
     description uptime contact name location
@@ -95,20 +98,55 @@ sub store_device {
       $device->$property( $snmp->$property );
   }
 
-  $device->snmp_class( $snmp->class );
+  $device->snmp_class( $snmp->device_type );
   $device->last_discover(\'now()');
 
   schema('netdisco')->txn_do(sub {
     my $gone = $device->device_ips->delete;
-    debug sprintf ' [%s] store_device - removed %s aliases',
+    debug sprintf ' [%s] device - removed %s aliases',
       $device->ip, $gone;
     $device->update_or_insert;
     $device->device_ips->populate(\@aliases);
-    debug sprintf ' [%s] store_device - added %d new aliases',
+    debug sprintf ' [%s] device - added %d new aliases',
       $device->ip, scalar @aliases;
   });
 }
 
+sub _set_canonical_ip {
+  my ($device, $snmp) = @_;
+
+  my $oldip = $device->ip;
+  my $newip = $snmp->root_ip;
+
+  if (length $newip) {
+      if ($oldip ne $newip) {
+          debug sprintf ' [%s] device - changing root IP to alt IP %s',
+            $oldip, $newip;
+
+          # remove old device and aliases
+          schema('netdisco')->txn_do(sub {
+            my $gone = $device->device_ips->delete;
+            debug sprintf ' [%s] device - removed %s aliases',
+              $oldip, $gone;
+            $device->delete;
+            debug sprintf ' [%s] device - deleted self', $oldip;
+          });
+
+          $device->ip($newip);
+      }
+
+      # either root_ip is changed or unchanged, but it exists
+      return;
+  }
+
+  my $revname = ipv4_from_hostname($snmp->name);
+  if (setting('reverse_sysname') and $revname) {
+      debug sprintf ' [%s] device - changing root IP to revname %s',
+        $oldip, $revname;
+      $device->ip($revname);
+  }
+}
+
 =head2 store_interfaces( $device, $snmp )
 
 Given a Device database object, and a working SNMP connection, discover and
@@ -241,13 +279,13 @@ sub store_wireless {
   my $ssidbcast  = $snmp->i_ssidbcast;
   my $ssidmac    = $snmp->i_ssidmac;
   my $channel    = $snmp->i_80211channel;
-  my $power      = $snmp->i_dot11_cur_tx_pwr_mw;
+  my $power      = $snmp->dot11_cur_tx_pwr_mw;
 
   # build device ssid list suitable for DBIC
   my @ssids;
   foreach my $entry (keys %$ssidlist) {
-      $entry =~ s/\.\d+$//;
+      (my $iid = $entry) =~ s/\.\d+$//;
-      my $port = $interfaces->{$entry};
+      my $port = $interfaces->{$iid};
 
       if (not length $port) {
           debug sprintf ' [%s] wireless - ignoring %s (no port mapping)',
@@ -275,7 +313,6 @@ sub store_wireless {
   # build device channel list suitable for DBIC
   my @channels;
   foreach my $entry (keys %$channel) {
-      $entry =~ s/\.\d+$//;
       my $port = $interfaces->{$entry};
 
       if (not length $port) {

Netdisco/lib/App/Netdisco/Util/SNMP.pm

@@ -60,6 +60,30 @@ sub _snmp_connect_generic {
   # get device details from db
   my $device = get_device($ip);
 
+  # TODO: only supporing v2c at the moment
+  my %snmp_args = (
+    DestHost => $device->ip,
+    Retries => (setting('snmpretries') || 2),
+    Timeout => (setting('snmptimeout') || 1000000),
+    MibDirs => [ _build_mibdirs() ],
+    IgnoreNetSNMPConf => 1,
+    Debug => ($ENV{INFO_TRACE} || 0),
+  );
+
+  # TODO: add version force support
+  # use existing SNMP version or try 2, 1
+  my @versions = (($device->snmp_ver || setting('snmpver') || 2));
+  push @versions, 1;
+
+  # use existing or new device class
+  my @classes = ('SNMP::Info');
+  if ($device->snmp_class) {
+    unshift @classes, $device->snmp_class;
+  }
+  else {
+    $snmp_args{AutoSpecity} = 1;
+  }
+
   # get the community string(s)
   my $comm_type = pop;
   my @communities = @{ setting($comm_type) || []};
@@ -67,36 +91,61 @@ sub _snmp_connect_generic {
     if length $device->snmp_comm
        and length $comm_type and $comm_type eq 'community';
 
-  # TODO: only supporing v2c at the moment
-  my %snmp_args = (
-    DestHost => $device->ip,
-    Version => ($device->snmp_ver || setting('snmpver') || 2),
-    Retries => (setting('snmpretries') || 2),
-    Timeout => (setting('snmptimeout') || 1000000),
-    MibDirs => [ _build_mibdirs() ],
-    AutoSpecify => 1,
-    IgnoreNetSNMPConf => 1,
-    Debug => ($ENV{INFO_TRACE} || 0),
-  );
-
   my $info = undef;
-  my $last_comm = 0;
+  VERSION: foreach my $ver (@versions) {
-  COMMUNITY: foreach my $c (@communities) {
+      next unless length $ver;
-      next unless defined $c and length $c;
+
-      try {
+      CLASS: foreach my $class (@classes) {
-          $info = SNMP::Info->new(%snmp_args, Community => $c);
+          next unless length $class;
-          ++$last_comm if (
+
-            $info
+          COMMUNITY: foreach my $comm (@communities) {
-            and (not defined $info->error)
+              next unless length $comm;
-            and length $info->uptime
+
-          );
+              $info = _try_connect($ver, $class, $comm, \%snmp_args)
-      };
+                and last VERSION;
-      last COMMUNITY if $last_comm;
+          }
+      }
   }
 
   return $info;
 }
 
+sub _try_connect {
+  my ($ver, $class, $comm, $snmp_args) = @_;
+  my $info = undef;
+
+  try {
+      debug
+        sprintf '[%s] try_connect with ver: %s, class: %s, comm: %s',
+        $snmp_args->{DestHost}, $ver, $class, $comm;
+      eval "require $class";
+
+      $info = $class->new(%$snmp_args, Version => $ver, Community => $comm);
+      undef $info unless (
+        (not defined $info->error)
+        and length $info->uptime
+        and ($info->layers or $info->description)
+        and $info->class
+      );
+
+      # first time a device is discovered, re-instantiate into specific class
+      if ($info and $info->device_type ne $class) {
+          $class = $info->device_type;
+          debug
+            sprintf '[%s] try_connect with ver: %s, new class: %s, comm: %s',
+            $snmp_args->{DestHost}, $ver, $class, $comm;
+
+          eval "require $class";
+          $info = $class->new(%$snmp_args, Version => $ver, Community => $comm);
+      }
+  }
+  catch {
+      debug $_;
+  };
+
+  return $info;
+}
+
 sub _build_mibdirs {
   return map { dir(setting('mibhome'), $_) }
              @{ setting('mibdirs') || [] };

Netdisco/share/config.yml

@@ -80,7 +80,7 @@ daemon_pollers: 2
 # what housekeeping tasks should this node *schedule*
 # (it only does them if daemon_pollers is non-zero)
 #housekeeping:
-#  discoverall:
+#  discovernew:
 #    device: '192.0.2.0'
 #    when:
 #      wday: 'wed'