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