<%args>
$from => undef
$to => undef
%args>
<%method title>
- Trace Route (L2)\
%method>
<%shared>
my ($sentto,$sentfrom,$G,$H,$err);
my $path = [];
my (%from,%to);
my $have_path=0;
my $domain = $netdisco::CONFIG{domain};
my $timeout = $netdisco::CONFIG{graph_timeout} || 60;
%shared>
<%init>
$sentto = $to;
$sentfrom = $from;
# Check FROM for node-mac,device,node-host
if ($from and &is_mac($from)){
my $dev = sql_hash('node',['mac','switch','port'],{'mac'=>$from,'active'=>1});
if (defined $dev){
$from{mac} = $from;
$from{ip} = sql_scalar('node_ip',['ip'],{'mac'=>$from,'active'=>1});
$from{type} = 'node';
$from{next} = $dev->{switch};
$from{to_port} = $dev->{port};
}
} elsif ($from) {
$from{ip} = getip($from);
# Check if device
if (my $devip = &root_device($from{ip})){
$from{ip}=$devip;
$from{type} = 'device';
} else {
# Check if node
my $devmac = sql_scalar('node_ip',['mac'],{'ip'=>$from{ip}, 'active' => 1});
my $dev = sql_hash('node',['mac','switch','port'],{'mac'=>$devmac,'active'=>1});
if (defined $dev){
$from{mac} = $devmac;
$from{type} = 'node';
$from{next} = $dev->{switch};
$from{to_port} = $dev->{port};
}
}
}
# Check TO for node-mac,device,node-host
if ($to and &is_mac($to)){
my $dev = sql_hash('node',['mac','switch','port'],{'mac'=>$to,'active'=>1});
if (defined $dev){
$to{mac} = $to;
$to{ip} = sql_scalar('node_ip',['ip'],{'mac'=>$from,'active'=>1});
$to{type} = 'node';
$to{next} = $dev->{switch};
$to{from_port} = $dev->{port};
}
} elsif ($to) {
$to{ip} = getip($to);
# Check if device
if (my $devip = &root_device($to{ip})){
$to{ip}=$devip;
$to{type} = 'device';
} else {
# Check if node
my $devmac = sql_scalar('node_ip',['mac'],{ 'ip'=>$to{ip},'active'=>1 } );
my $dev = sql_hash('node',['mac','switch','port'],{'mac'=>$devmac,'active'=>1});
if (defined $dev){
$to{mac} = $devmac;
$to{type} = 'node';
$to{next} = $dev->{switch};
$to{from_port} = $dev->{port};
}
}
}
if (defined $from{type} and defined $to{type}) {
# this could take a while
$m->flush_buffer;
$G = make_graph();
my $fromip = $from{type} eq 'node' ? $from{next} : $from{ip};
my $toip = $to{type} eq 'node' ? $to{next} : $to{ip};
# Check to see if we have a path
my @S = $G->connected_components;
for (my $i; $i < @S; $i++){
next unless grep(/^\Q$fromip\E$/,@{$S[$i]});
next unless grep(/^\Q$toip\E$/,@{$S[$i]});
$have_path++;
# Found path, delete all the other subgraphs to speed up the search
for (my $j; $j < @S; $j++){
next if $i == $j;
$G->delete_vertices(@{$S[$j]})
}
# We should only be in one connected graph, so first found is the only
# sub graph. multiple paths in that one subgraph will exist.
last;
}
if ($have_path){
local $SIG{ALRM} = sub { die "timeout"; };
eval {
alarm($timeout);
$H = $G->SSSP_Dijkstra($fromip);
$path = [ $H->path_vertices($fromip,$toip) ];
alarm(0);
};
if ($@ =~ /timeout/) {
$err = "Shortest Path Algorithm timed out in $timeout sec.
";
$have_path=0;
} elsif ($@) {
$err = "Error w/ SSSP. $@";
$have_path=0;
}
}
}
%init>
<%method results>
%return unless (length($sentfrom) and length($sentto));
<%perl>
unless (defined $from{type}){
$m->out("No matching device or node found for $sentfrom.
\n");
}
unless (defined $to{type}){
$m->out("No matching device or node found for $sentto.
\n");
}
return unless (defined $from{type} and defined $to{type});
unless ($have_path){
$m->out("No Path found between $sentfrom and $sentto.
\n");
return;
}
my %path_info;
for (my $i=0; $i < @$path; $i++){
my $this = $path->[$i];
my $dns = sql_scalar('device',['dns'],{'ip'=>$this});
$dns = defined $dns ? $dns : $this;
$dns =~ s/\Q$domain\E//;
$path_info{$this}->{dns} = $dns;
last if ($i == scalar(@$path)-1);
my $that = $path->[$i+1];
# remote_ip of port may be set to an alias, so we check for connections to alias ips.
my $aliases = sql_rows('device_ip',['alias'],{'ip'=>$that});
# Add our root device to the list of ips to check first
unshift (@$aliases, {'alias'=>$that});
my $port;
foreach my $alias (@$aliases){
my $alias_ip = $alias->{alias};
$port = sql_hash('device_port',['port','remote_port'],{'ip'=>$this,'remote_ip'=>$alias_ip});
# take the first one we find.
last if defined $port;
}
$path_info{$this}->{type}='device';
$path_info{$this}->{next}=$that;
$path_info{$this}->{to_port} = $port->{port};
$path_info{$that}->{from_port} = $port->{remote_port};
}
# Add node to beg
if ($from{type} eq 'node'){
my $this = defined $from{ip} ? $from{ip} : $from{mac};
my $dns = defined $from{ip} ? &hostname($from{ip}) : $this;
$dns = defined $dns ? $dns : $this;
$dns =~ s/\Q$domain\E//;
my $that = $from{next};
$path_info{$this}->{next} = $that;
$path_info{$this}->{dns} = $dns ;
$path_info{$that}->{from_port} = $from{to_port};
$path_info{$this}->{type} = 'node';
unshift(@$path,$this);
}
# Add node to end
if ($to{type} eq 'node'){
my $this = defined $to{ip} ? $to{ip} : $to{mac};
my $dns = defined $to{ip} ? &hostname($to{ip}) : $this;
$dns = $dns ? $dns : $this;
$dns =~ s/\Q$domain\E//;
$path_info{$this}->{type} = 'node';
$path_info{$this}->{dns} = $dns ;
my $that = $to{next};
$path_info{$that}->{next} = $this;
$path_info{$that}->{to_port} = $to{from_port};
push(@$path,$this);
}
my $odd = 0;
%perl>
<%$sentfrom%> --> <%$sentto%>
|
Port In |
Device |
Port Out |
|
<%perl>
while (my $this = shift(@$path)){
my $that = $path_info{$this}->{next};
my $from_port = $path_info{$this}->{from_port};
my $to_port = $path_info{$this}->{to_port};
my $link = $path_info{$this}->{type} eq 'node' ?
"node.html?node=$this" :
"device.html?ip=$this";
$link .= "\&port=$from_port" if defined $from_port;
$link .= "\&port=$to_port" if defined $to_port;
$odd++;
%perl>
<%$odd%>. |
<% defined $from_port ? "[$from_port]" : ' ' %> |
<%$path_info{$this}->{dns}%> |
<% defined $to_port ? "[$to_port]" : ' ' %> |
%}
%method>
%# $Id: traceroute.html,v 1.9 2009/03/25 22:25:19 fenner Exp $
%# vim:syntax=mason