discover root_ip properly

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) {
@@ -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
@@ -109,6 +112,41 @@ sub store_device {
   });
 }
 
+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