1package App::Netdisco::Web::Plugin::Device::Neighbors;
2
3use Dancer ':syntax';
4use Dancer::Plugin::Ajax;
5use Dancer::Plugin::DBIC;
6use Dancer::Plugin::Auth::Extensible;
7
8use List::Util 'first';
9use List::MoreUtils ();
10use App::Netdisco::Util::Permission 'check_acl_only';
11use App::Netdisco::Web::Plugin;
12
13register_device_tab({ tag => 'netmap', label => 'Neighbors' });
14
15ajax '/ajax/content/device/netmap' => require_login sub {
16    content_type('text/html');
17    template 'ajax/device/netmap.tt', {}, { layout => undef };
18};
19
20ajax '/ajax/data/device/netmappositions' => require_login sub {
21    my $q = param('q');
22    my $qdev = schema('netdisco')->resultset('Device')
23      ->search_for_device($q) or send_error('Bad device', 400);
24
25    my $p = param('positions') or send_error('Missing positions', 400);
26    my $positions = from_json($p) or send_error('Bad positions', 400);
27    send_error('Bad positions', 400) unless ref [] eq ref $positions;
28
29    my $vlan = param('vlan');
30    undef $vlan if (defined $vlan and $vlan !~ m/^\d+$/);
31
32    my $mapshow = param('mapshow');
33    return if !defined $mapshow or $mapshow !~ m/^(?:all|neighbors)$/;
34
35    # list of groups selected by user and passed in param
36    my $hgroup = (ref [] eq ref param('hgroup') ? param('hgroup') : [param('hgroup')]);
37    # list of groups validated as real host groups and named host groups
38    my @hgrplist = List::MoreUtils::uniq
39                   grep { exists setting('host_group_displaynames')->{$_} }
40                   grep { exists setting('host_groups')->{$_} }
41                   grep { defined } @{ $hgroup };
42
43    # list of locations selected by user and passed in param
44    my $lgroup = (ref [] eq ref param('lgroup') ? param('lgroup') : [param('lgroup')]);
45    my @lgrplist = List::MoreUtils::uniq grep { defined } @{ $lgroup };
46
47    my %clean = ();
48    POSITION: foreach my $pos (@$positions) {
49      next unless ref {} eq ref $pos;
50      foreach my $k (qw/ID x y/) {
51        next POSITION unless exists $pos->{$k};
52        next POSITION unless $pos->{$k} =~ m/^[[:word:]\.-]+$/;
53      }
54      $clean{$pos->{ID}} = { x => $pos->{x}, y => $pos->{y} };
55    }
56    return unless scalar keys %clean;
57
58    my $posrow = schema('netdisco')->resultset('NetmapPositions')->find({
59      device => (($mapshow eq 'neighbors') ? $qdev->ip : undef),
60      host_groups => \[ '= ?', [host_groups => [sort @hgrplist]] ],
61      locations   => \[ '= ?', [locations   => [sort @lgrplist]] ],
62      vlan => ($vlan || 0),
63    });
64
65    if ($posrow) {
66      $posrow->update({ positions => to_json(\%clean) });
67    }
68    else {
69      schema('netdisco')->resultset('NetmapPositions')->create({
70        device => (($mapshow eq 'neighbors') ? $qdev->ip : undef),
71        host_groups => [sort @hgrplist],
72        locations   => [sort @lgrplist],
73        vlan => ($vlan || 0),
74        positions => to_json(\%clean),
75      });
76    }
77};
78
79# copied from SNMP::Info to avoid introducing dependency to web frontend
80sub munge_highspeed {
81    my $speed = shift;
82    my $fmt   = "%d Mbps";
83
84    if ( $speed > 9999999 ) {
85        $fmt = "%d Tbps";
86        $speed /= 1000000;
87    }
88    elsif ( $speed > 999999 ) {
89        $fmt = "%.1f Tbps";
90        $speed /= 1000000.0;
91    }
92    elsif ( $speed > 9999 ) {
93        $fmt = "%d Gbps";
94        $speed /= 1000;
95    }
96    elsif ( $speed > 999 ) {
97        $fmt = "%.1f Gbps";
98        $speed /= 1000.0;
99    }
100    return sprintf( $fmt, $speed );
101}
102
103sub to_speed {
104  my $speed = shift or return '';
105  ($speed = munge_highspeed($speed / 1_000_000)) =~ s/(?:\.0 |bps$)//g;
106  return $speed;
107}
108
109sub make_node_infostring {
110  my $node = shift or return '';
111  my $fmt = ('<b>%s</b> is %s <b>%s %s</b><br>running <b>%s %s</b><br>Serial: <b>%s</b><br>'
112    .'Uptime: <b>%s</b><br>Location: <b>%s</b><br>Contact: <b>%s</b>');
113  return sprintf $fmt, $node->ip,
114    ((($node->vendor || '') =~ m/^[aeiou]/i) ? 'an' : 'a'),
115    ucfirst($node->vendor || ''),
116    map {defined $_ ? $_ : ''}
117    map {$node->$_}
118        (qw/model os os_ver serial uptime_age location contact/);
119}
120
121sub make_link_infostring {
122  my $link = shift or return '';
123
124  my $domains = setting('domain_suffix');
125  (my $left_name = lc($link->{left_dns} || $link->{left_name} || $link->{left_ip})) =~ s/$domains//;
126  (my $right_name = lc($link->{right_dns} || $link->{right_name} || $link->{right_ip})) =~ s/$domains//;
127
128  my @zipped = List::MoreUtils::zip6
129    @{$link->{left_port}}, @{$link->{left_descr}},
130    @{$link->{right_port}}, @{$link->{right_descr}};
131
132  return join '<br><br>', map { sprintf '<b>%s:%s</b> (%s)<br><b>%s:%s</b> (%s)',
133    $left_name, $_->[0], ($_->[1] || 'no description'),
134    $right_name, $_->[2], ($_->[3] || 'no description') } @zipped;
135}
136
137ajax '/ajax/data/device/netmap' => require_login sub {
138    my $q = param('q');
139    my $qdev = schema('netdisco')->resultset('Device')
140      ->search_for_device($q) or send_error('Bad device', 400);
141
142    my $vlan = param('vlan');
143    undef $vlan if (defined $vlan and $vlan !~ m/^\d+$/);
144
145    my $colorby = (param('colorby') || 'speed');
146    my $mapshow = (param('mapshow') || 'neighbors');
147    $mapshow = 'neighbors' if $mapshow !~ m/^(?:all|neighbors)$/;
148    $mapshow = 'all' unless $qdev->in_storage;
149
150    # list of groups selected by user and passed in param
151    my $hgroup = (ref [] eq ref param('hgroup') ? param('hgroup') : [param('hgroup')]);
152    # list of groups validated as real host groups and named host groups
153    my @hgrplist = List::MoreUtils::uniq
154                   grep { exists setting('host_group_displaynames')->{$_} }
155                   grep { exists setting('host_groups')->{$_} }
156                   grep { defined } @{ $hgroup };
157
158    # list of locations selected by user and passed in param
159    my $lgroup = (ref [] eq ref param('lgroup') ? param('lgroup') : [param('lgroup')]);
160    my @lgrplist = List::MoreUtils::uniq grep { defined } @{ $lgroup };
161
162    my %ok_dev = ();
163    my %logvals = ();
164    my %metadata = ();
165    my %data = ( nodes => [], links => [] );
166    my $domains = setting('domain_suffix');
167
168    # LINKS
169
170    my %seen_link = ();
171    my $links = schema('netdisco')->resultset('Virtual::DeviceLinks')->search({
172      ($mapshow eq 'neighbors' ? ( -or => [
173          { left_ip  => $qdev->ip },
174          { right_ip => $qdev->ip },
175      ]) : ())
176    }, { result_class => 'DBIx::Class::ResultClass::HashRefInflator' });
177
178    while (my $link = $links->next) {
179      # query is ordered by aggregate speed desc so we see highest speed
180      # first, which is hopefully the "best" if links are not symmetric
181      next if exists $seen_link{$link->{left_ip} ."\0". $link->{right_ip}}
182           or exists $seen_link{$link->{right_ip} ."\0". $link->{left_ip}};
183
184      push @{$data{'links'}}, {
185        FROMID => $link->{left_ip},
186        TOID   => $link->{right_ip},
187        INFOSTRING => make_link_infostring($link),
188        SPEED  => to_speed($link->{aggspeed}),
189      };
190
191      ++$ok_dev{$link->{left_ip}};
192      ++$ok_dev{$link->{right_ip}};
193      ++$seen_link{$link->{left_ip} ."\0". $link->{right_ip}};
194    }
195
196    # DEVICES (NODES)
197
198    my $posrow = schema('netdisco')->resultset('NetmapPositions')->find({
199      device => (($mapshow eq 'neighbors') ? $qdev->ip : undef),
200      host_groups => \[ '= ?', [host_groups => [sort @hgrplist]] ],
201      locations   => \[ '= ?', [locations   => [sort @lgrplist]] ],
202      vlan => ($vlan || 0),
203    });
204    my $pos_for = from_json( $posrow ? $posrow->positions : '{}' );
205
206    my $devices = schema('netdisco')->resultset('Device')->search({}, {
207      '+select' => [\'floor(log(throughput.total))'], '+as' => ['log'],
208      join => 'throughput', distinct => 1,
209    })->with_times;
210
211    # filter by vlan for all or neighbors only
212    if ($vlan) {
213      $devices = $devices->search(
214        { 'port_vlans_filter.vlan' => $vlan },
215        { join => 'port_vlans_filter' }
216      );
217    }
218
219    DEVICE: while (my $device = $devices->next) {
220      # if in neighbors mode then use %ok_dev to filter
221      next DEVICE if ($device->ip ne $qdev->ip)
222        and ($mapshow eq 'neighbors')
223        and (not $ok_dev{$device->ip}); # showing only neighbors but no link
224
225      # if location picked then filter
226      next DEVICE if ((scalar @lgrplist) and ((!defined $device->location)
227        or (0 == scalar grep {$_ eq $device->location} @lgrplist)));
228
229      # if host groups picked then use ACLs to filter
230      my $first_hgrp =
231        first { check_acl_only($device, setting('host_groups')->{$_}) } @hgrplist;
232      next DEVICE if ((scalar @hgrplist) and (not $first_hgrp));
233
234      # now reset first_hgroup to be the group matching the device, if any
235      $first_hgrp = first { check_acl_only($device, setting('host_groups')->{$_}) }
236                          keys %{ setting('host_group_displaynames') || {} };
237
238      ++$logvals{ $device->get_column('log') || 1 };
239      (my $name = lc($device->dns || $device->name || $device->ip)) =~ s/$domains//;
240
241      my %color_lkp = (
242        speed => (($device->get_column('log') || 1) * 1000),
243        hgroup => ($first_hgrp ?
244          setting('host_group_displaynames')->{$first_hgrp} : 'Other'),
245        lgroup => ($device->location || 'Other'),
246      );
247
248      my $node = {
249        ID => $device->ip,
250        SIZEVALUE => (param('dynamicsize') ? $color_lkp{speed} : 3000),
251        ((exists $color_lkp{$colorby}) ? (COLORVALUE => $color_lkp{$colorby}) : ()),
252        LABEL => (param('showips') ? ($device->ip .' '. $name) : $name),
253        ORIG_LABEL => $name,
254        INFOSTRING => make_node_infostring($device),
255        LINK => uri_for('/device', {
256          tab => 'netmap',
257          q => $device->ip,
258          firstsearch => 'on',
259        })->path_query,
260      };
261
262      if (exists $pos_for->{$device->ip}) {
263        $node->{'fixed'} = 1;
264        $node->{'x'} = $pos_for->{$device->ip}->{'x'};
265        $node->{'y'} = $pos_for->{$device->ip}->{'y'};
266      }
267      else {
268        ++$metadata{'newnodes'};
269      }
270
271      push @{$data{'nodes'}}, $node;
272      $metadata{'centernode'} = $device->ip
273        if $qdev and $qdev->in_storage and $device->ip eq $qdev->ip;
274    }
275
276    # to help get a sensible range of node sizes
277    $metadata{'numsizes'} = scalar keys %logvals;
278
279    content_type('application/json');
280    to_json({ data => \%data, %metadata });
281};
282
283true;
284