1package App::Netdisco::Util::Graph; 2 3use App::Netdisco; 4 5use Dancer qw/:syntax :script/; 6use Dancer::Plugin::DBIC 'schema'; 7 8use App::Netdisco::Util::DNS qw/hostname_from_ip ipv4_from_hostname/; 9use Graph::Undirected (); 10use GraphViz (); 11 12use base 'Exporter'; 13our @EXPORT = ('graph'); 14our @EXPORT_OK = qw/ 15 graph_each 16 graph_addnode 17 make_graph 18/; 19our %EXPORT_TAGS = (all => \@EXPORT_OK); 20 21# nothing to see here, please move along... 22our ($ip, $label, $isdev, $devloc, %GRAPH, %GRAPH_SPEED); 23 24=head1 NAME 25 26App::Netdisco::Util::Graph 27 28=head1 SYNOPSIS 29 30 $ brew install graphviz <-- install graphviz on your system 31 32 $ ~/bin/localenv bash 33 $ cpanm --notest Graph GraphViz 34 $ mkdir ~/graph 35 36 use App::Netdisco::Util::Graph; 37 graph; 38 39=head1 DESCRIPTION 40 41Generate GraphViz output from Netdisco data. Requires that the L<Graph> and 42L<GraphViz> distributions be installed. 43 44Requires the same config as for Netdisco 1, but within a C<graph> key. See 45C<share/config.yml> in the source distribution for an example. 46 47The C<graph> subroutine is exported by default. The C<:all> tag will export 48all subroutines. 49 50=head1 EXPORT 51 52=over 4 53 54=item graph() 55 56Creates netmap of network. 57 58=back 59 60=cut 61 62sub graph { 63 my %CONFIG = %{ setting('graph') }; 64 65 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(); 66 my $month = sprintf("%d%02d",$year+1900,$mon+1); 67 68 info "graph() - Creating Graphs"; 69 my $G = make_graph(); 70 71 unless (defined $G){ 72 print "graph() - make_graph() failed. Try running with debug (-D).\n"; 73 return; 74 } 75 76 my @S = $G->connected_components; 77 78 # Count number of nodes in each subgraph 79 my %S_count; 80 for (my $i=0;$i< scalar @S;$i++){ 81 $S_count{$i} = scalar @{$S[$i]}; 82 } 83 84 foreach my $subgraph (sort { $S_count{$b} <=> $S_count{$a} } keys %S_count){ 85 my $SUBG = $G->copy; 86 print "\$S[$subgraph] has $S_count{$subgraph} nodes.\n"; 87 88 # Remove other subgraphs from this one 89 my %S_notme = %S_count; 90 delete $S_notme{$subgraph}; 91 foreach my $other (keys %S_notme){ 92 print "Removing Non-connected nodes: ",join(',',@{$S[$other]}),"\n"; 93 $SUBG->delete_vertices(@{$S[$other]}) 94 } 95 96 # Create the subgraph 97 my $timeout = defined $CONFIG{graph_timeout} ? $CONFIG{graph_timeout} : 60; 98 99 eval { 100 alarm($timeout*60); 101 graph_each($SUBG,''); 102 alarm(0); 103 }; 104 if ($@) { 105 if ($@ =~ /timeout/){ 106 print "! Creating Graph timed out!\n"; 107 } else { 108 print "\n$@\n"; 109 } 110 } 111 112 # Facility to create subgraph for each non-connected network segment. 113 # Right now, let's just make the biggest one only. 114 last; 115 } 116} 117 118=head1 EXPORT_OK 119 120=over 4 121 122=item graph_each($graph_obj, $name) 123 124Generates subgraph. Does actual GraphViz calls. 125 126=cut 127 128sub graph_each { 129 my ($G, $name) = @_; 130 my %CONFIG = %{ setting('graph') }; 131 info "Creating new Graph"; 132 133 my $graph_defs = { 134 'bgcolor' => $CONFIG{graph_bg} || 'black', 135 'color' => $CONFIG{graph_color} || 'white', 136 'overlap' => $CONFIG{graph_overlap} || 'scale', 137 'fontpath'=> _homepath('graph_fontpath',''), 138 'ranksep' => $CONFIG{graph_ranksep} || 0.3, 139 'nodesep' => $CONFIG{graph_nodesep} || 2, 140 'ratio' => $CONFIG{graph_ratio} || 'compress', 141 'splines' => ($CONFIG{graph_splines} ? 'true' : 'false'), 142 'fontcolor' => $CONFIG{node_fontcolor} || 'white', 143 'fontname' => $CONFIG{node_font} || 'lucon', 144 'fontsize' => $CONFIG{node_fontsize} || 12, 145 }; 146 my $edge_defs = { 147 'color' => $CONFIG{edge_color} || 'wheat', 148 }; 149 my $node_defs = { 150 'shape' => $CONFIG{node_shape} || 'box', 151 'fillcolor' => $CONFIG{node_fillcolor} || 'dimgrey', 152 'fontcolor' => $CONFIG{node_fontcolor} || 'white', 153 'style' => $CONFIG{node_style} || 'filled', 154 'fontname' => $CONFIG{node_font} || 'lucon', 155 'fontsize' => $CONFIG{node_fontsize} || 12, 156 'fixedsize' => ($CONFIG{node_fixedsize} ? 'true' : 'false'), 157 }; 158 $node_defs->{height} = $CONFIG{node_height} if defined $CONFIG{node_height}; 159 $node_defs->{width} = $CONFIG{node_width} if defined $CONFIG{node_width}; 160 161 my $epsilon = undef; 162 if (defined $CONFIG{graph_epsilon}){ 163 $epsilon = "0." . '0' x $CONFIG{graph_epsilon} . '1'; 164 } 165 166 my %gv = ( 167 directed => 0, 168 layout => $CONFIG{graph_layout} || 'twopi', 169 graph => $graph_defs, 170 node => $node_defs, 171 edge => $edge_defs, 172 width => $CONFIG{graph_x} || 30, 173 height => $CONFIG{graph_y} || 30, 174 epsilon => $epsilon, 175 ); 176 177 my $gv = GraphViz->new(%gv); 178 179 my %node_map = (); 180 my @nodes = $G->vertices; 181 182 foreach my $dev (@nodes){ 183 my $node_name = graph_addnode($gv,$dev); 184 $node_map{$dev} = $node_name; 185 } 186 187 my $root_ip = defined $CONFIG{root_device} 188 ? (ipv4_from_hostname($CONFIG{root_device}) || $CONFIG{root_device}) 189 : undef; 190 191 if (defined $root_ip and defined $node_map{$root_ip}){ 192 my $gv_root_name = $gv->_quote_name($root_ip); 193 if (defined $gv_root_name){ 194 $gv->{GRAPH_ATTRS}->{root}=$gv_root_name; 195 } 196 } 197 198 my @edges = $G->edges; 199 200 while (my $e = shift @edges){ 201 my $link = $e->[0]; 202 my $dest = $e->[1]; 203 my $speed = $GRAPH_SPEED{$link}->{$dest}->{speed}; 204 205 if (!defined($speed)) { 206 info " ! No link speed for $link -> $dest"; 207 $speed = 0; 208 } 209 210 my %edge = (); 211 my $val = ''; my $suffix = ''; 212 213 if ($speed =~ /^([\d.]+)\s+([a-z])bps$/i) { 214 $val = $1; $suffix = $2; 215 } 216 217 if ( ($suffix eq 'k') or ($speed =~ m/(t1|ds3)/i) ){ 218 $edge{color} = 'green'; 219 $edge{style} = 'dotted'; 220 } 221 222 if ($suffix eq 'M'){ 223 if ($val < 10.0){ 224 $edge{color} = 'green'; 225 #$edge{style} = 'dotted'; 226 $edge{style} = 'dashed'; 227 } elsif ($val < 100.0){ 228 $edge{color} = '#8b7e66'; 229 #$edge{style} = 'normal'; 230 $edge{style} = 'solid'; 231 } else { 232 $edge{color} = '#ffe7ba'; 233 $edge{style} = 'solid'; 234 } 235 } 236 237 if ($suffix eq 'G'){ 238 #$edge{style} = 'bold'; 239 $edge{color} = 'cyan1'; 240 } 241 242 # Add extra styles to edges (mainly for modifying width) 243 if(defined $CONFIG{edge_style}) { 244 $edge{style} .= "," . $CONFIG{edge_style}; 245 } 246 247 $gv->add_edge($link => $dest, %edge ); 248 } 249 250 info "Ignore all warnings about node size"; 251 252 if (defined $CONFIG{graph_raw} and $CONFIG{graph_raw}){ 253 my $graph_raw = _homepath('graph_raw'); 254 info " Creating raw graph: $graph_raw"; 255 $gv->as_canon($graph_raw); 256 } 257 258 if (defined $CONFIG{graph} and $CONFIG{graph}){ 259 my $graph_gif = _homepath('graph'); 260 info " Creating graph: $graph_gif"; 261 $gv->as_gif($graph_gif); 262 } 263 264 if (defined $CONFIG{graph_png} and $CONFIG{graph_png}){ 265 my $graph_png = _homepath('graph_png'); 266 info " Creating png graph: $graph_png"; 267 $gv->as_png($graph_png); 268 } 269 270 if (defined $CONFIG{graph_map} and $CONFIG{graph_map}){ 271 my $graph_map = _homepath('graph_map'); 272 info " Creating CMAP : $graph_map"; 273 $gv->as_cmap($graph_map); 274 } 275 276 if (defined $CONFIG{graph_svg} and $CONFIG{graph_svg}){ 277 my $graph_svg = _homepath('graph_svg'); 278 info " Creating SVG : $graph_svg"; 279 $gv->as_svg($graph_svg); 280 } 281} 282 283=item graph_addnode($graphviz_obj, $node_ip) 284 285Checks for mapping settings in config file and adds node to the GraphViz 286object. 287 288=cut 289 290sub graph_addnode { 291 my $gv = shift; 292 my %CONFIG = %{ setting('graph') }; 293 my %node = (); 294 295 $ip = shift; 296 $label = $GRAPH{$ip}->{dns}; 297 $isdev = $GRAPH{$ip}->{isdev}; 298 $devloc = $GRAPH{$ip}->{location}; 299 300 $label = "($ip)" unless defined $label; 301 my $domain_suffix = setting('domain_suffix'); 302 $label =~ s/$domain_suffix//; 303 $node{label} = $label; 304 305 # Dereferencing the scalar by name below 306 # requires that the variable be non-lexical (not my) 307 # we'll create some local non-lexical versions 308 # that will expire at the end of this block 309 # Node Mappings 310 foreach my $map (@{ $CONFIG{'node_map'} || [] }){ 311 my ($var, $regex, $attr, $val) = split(':', $map); 312 313 { no strict 'refs'; 314 $var = ${"$var"}; 315 } 316 next unless defined $var; 317 318 if ($var =~ /$regex/) { 319 debug " graph_addnode - Giving node $ip $attr = $val"; 320 $node{$attr} = $val; 321 } 322 } 323 324 # URL for image maps FIXME for non-root hosting 325 if ($isdev) { 326 $node{URL} = "/device?&q=$ip"; 327 } 328 else { 329 $node{URL} = "/search?tab=node&q=$ip"; 330 # Overrides any colors given to nodes above. Bug 1094208 331 $node{fillcolor} = $CONFIG{'node_problem'} || 'red'; 332 } 333 334 if ($CONFIG{'graph_clusters'} && $devloc) { 335 # This odd construct works around a bug in GraphViz.pm's 336 # quoting of cluster names. If it has a name with spaces, 337 # it'll just quote it, resulting in creating a subgraph name 338 # of cluster_"location with spaces". This is an illegal name 339 # according to the dot grammar, so if the name matches the 340 # problematic regexp we make GraphViz.pm generate an internal 341 # name by using a leading space in the name. 342 # 343 # This is bug ID 16912 at rt.cpan.org - 344 # http://rt.cpan.org/NoAuth/Bug.html?id=16912 345 # 346 # Another bug, ID 11514, prevents us from using a combination 347 # of name and label attributes to hide the extra space from 348 # the user. However, since it's just a space, hopefully it 349 # won't be too noticable. 350 my($loc) = $devloc; 351 $loc = " " . $loc if ($loc =~ /^[a-zA-Z](\w| )*$/); 352 $node{cluster} = { name => $loc }; 353 } 354 355 my $rv = $gv->add_node($ip, %node); 356 return $rv; 357} 358 359=item make_graph() 360 361Returns C<Graph::Undirected> object that represents the discovered network. 362 363Graph is made by loading all the C<device_port> entries that have a neighbor, 364using them as edges. Then each device seen in those entries is added as a 365vertex. 366 367Nodes without topology information are not included. 368 369=back 370 371=cut 372 373sub make_graph { 374 my $G = Graph::Undirected->new(); 375 376 my $devices = schema('netdisco')->resultset('Device') 377 ->search({}, { columns => [qw/ip dns location /] }); 378 my $links = schema('netdisco')->resultset('DevicePort') 379 ->search({remote_ip => { -not => undef }}, 380 { columns => [qw/ip remote_ip speed remote_type/]}); 381 my %aliases = map {$_->alias => $_->ip} 382 schema('netdisco')->resultset('DeviceIp') 383 ->search({}, { columns => [qw/ip alias/] })->all; 384 385 my %devs = ( map {($_->ip => $_->dns)} $devices->all ); 386 my %locs = ( map {($_->ip => $_->location)} $devices->all ); 387 388 # Check for no topology info 389 unless ($links->count > 0) { 390 debug "make_graph() - No topology information. skipping."; 391 return undef; 392 } 393 394 my %link_seen = (); 395 my %linkmap = (); 396 397 while (my $link = $links->next) { 398 my $source = $link->ip; 399 my $dest = $link->remote_ip; 400 my $speed = $link->speed; 401 my $type = $link->remote_type; 402 403 # Check for Aliases 404 if (defined $aliases{$dest}) { 405 # Set to root device 406 $dest = $aliases{$dest}; 407 } 408 409 # Remove loopback - After alias check (bbaetz) 410 if ($source eq $dest) { 411 debug " make_graph() - Loopback on $source"; 412 next; 413 } 414 415 # Skip IP Phones 416 if (defined $type and $type =~ /ip.phone/i) { 417 debug " make_graph() - Skipping IP Phone. $source -> $dest ($type)"; 418 next; 419 } 420 next if exists $link_seen{$source}->{$dest}; 421 422 push(@{ $linkmap{$source} }, $dest); 423 424 # take care of reverse too 425 $link_seen{$source}->{$dest}++; 426 $link_seen{$dest}->{$source}++; 427 428 $GRAPH_SPEED{$source}->{$dest}->{speed}=$speed; 429 $GRAPH_SPEED{$dest}->{$source}->{speed}=$speed; 430 } 431 432 foreach my $link (keys %linkmap) { 433 foreach my $dest (@{ $linkmap{$link} }) { 434 435 foreach my $side ($link, $dest) { 436 unless (defined $GRAPH{$side}) { 437 my $is_dev = exists $devs{$side}; 438 my $dns = $is_dev ? 439 $devs{$side} : 440 hostname_from_ip($side); 441 442 # Default to IP if no dns 443 $dns = defined $dns ? $dns : "($side)"; 444 445 $G->add_vertex($side); 446 debug " make_graph() - add_vertex('$side')"; 447 448 $GRAPH{$side}->{dns} = $dns; 449 $GRAPH{$side}->{isdev} = $is_dev; 450 $GRAPH{$side}->{seen}++; 451 $GRAPH{$side}->{location} = $locs{$side}; 452 } 453 } 454 455 $G->add_edge($link,$dest); 456 debug " make_graph - add_edge('$link','$dest')"; 457 } 458 } 459 460 return $G; 461} 462 463sub _homepath { 464 my ($path, $default) = @_; 465 466 my $home = $ENV{NETDISCO_HOME}; 467 my $item = setting('graph')->{$path} || $default; 468 return undef unless defined($item); 469 470 if ($item =~ m,^/,) { 471 return $item; 472 } 473 else { 474 $home =~ s,/*$,,; 475 return $home . "/" . $item; 476 } 477} 478 4791; 480