igor@0: #!/usr/bin/perl -w
igor@0: #
igor@0: use Net::IP qw(:PROC);
igor@0: 
igor@0: our $traceroute_options="-q1 -n -I";
igor@0: our $hops_to_highlight=4;
igor@0: our $verbose =1;
igor@0: our $prefixes="prefixes.txt";
igor@0: our $scale=1;
igor@0: 
igor@0: our $dot_file="tracemap.dot";
igor@0: our $svg_file="tracemap.svg";
igor@0: our $png_file="tracemap.png";
igor@0: 
igor@0: #our @printed_hops;
igor@0: our $graph="";
igor@0: our $hop_id = 0;
igor@0: our %hop_id;
igor@0: 
igor@0: our $previous_hop;
igor@0: our $previous_time;
igor@0: our $hop;
igor@0: our $time;
igor@0: our $ttl;
igor@0: 
igor@0: our %color_table=qw(
igor@0: 194.150.0.0/16 red
igor@0: 10.0.0.0/16 seagreen2
igor@0: 10.1.0.0/16 seashell2
igor@0: 10.2.0.0/16 sienna2
igor@0: 10.3.0.0/16 skyblue2
igor@0: 10.4.0.0/16 slateblue2
igor@0: 10.5.0.0/16 slategray2
igor@0: 10.6.0.0/16 snow1
igor@0: 10.7.0.0/16 springgreen1
igor@0: 10.8.0.0/16 steelblue1
igor@0: );
igor@0: 
igor@0: our @prefixes;
igor@0: 
igor@0: sub load_prefixes
igor@0: {
igor@0:     my @prefixes=();
igor@0:     open(PREFIXES, $prefixes);
igor@0:     while (<PREFIXES>) { chomp; push @prefixes, $_;};
igor@0:     close(PREFIXES);
igor@0:     return @prefixes;
igor@0: }
igor@0: 
igor@0: sub ip_in_range
igor@0: {
igor@0:     my $ip=shift;
igor@0:     my $range_found=0;
igor@0:     for my $range (@_) {
igor@0:         my ($range_ip, $range_prefix) = split m@/@, $range;
igor@0:         my ($ip1, $ip2) = ip_prefix_to_range($range_ip, $range_prefix,4);
igor@0: #        print "$range\n";
igor@0:         $range_found=ip_bincomp(ip_iptobin($ip1,4),'lt',ip_iptobin($ip,4))
igor@0:             && ip_bincomp(ip_iptobin($ip,4),'lt',ip_iptobin($ip2,4));
igor@0:         if ($range_found) {
igor@0:             return $range;
igor@0:         }
igor@0:     }
igor@0:     return 0;
igor@0: }
igor@0: 
igor@0: sub color_of_ip($)
igor@0: {
igor@0:     my $ip = shift;
igor@0:     for $range (keys %color_table) {
igor@0:        if (ip_in_range($ip,$range)) {
igor@0:             return $color_table{"$range"};
igor@0:         }
igor@0:     }
igor@0:     return "indigo";
igor@0: }
igor@0: 
igor@0: sub print_hop($)
igor@0: {
igor@0:     $hop = shift;
igor@0:     unless (defined($hop_id{$hop})) {
igor@0:         $hop_id++;
igor@0:         $color="";
igor@0:         $shape="";
igor@0:         if (ip_in_range($hop, @prefixes)) {
igor@0:             $color=",color=green"
igor@0:         }
igor@0:         $color=",color=".color_of_ip($hop);
igor@0:         if ($ttl == $hops_to_highlight+1) {
igor@0:             $shape=",shaper=rectangle"
igor@0:         }
igor@0:         $graph .= "hop$hop_id [ label=\"$hop\"$color$shape];";
igor@0:         $hop_id{$hop} = $hop_id;
igor@0:     }
igor@0: }
igor@0: 
igor@0: sub time_to_len($$)
igor@0: {
igor@0:     $a=shift;
igor@0:     $b=shift;
igor@0:     $l=$a-$b;
igor@0:     $l = 0.25 if $l<0.25;
igor@0:     return (3+1.2*log($l))*0.3285*$scale;
igor@0: }
igor@0: sub say
igor@0: {
igor@0:     print @_ if $verbose;
igor@0: }
igor@0: 
igor@0: sub ping_sweep($)
igor@0: {
igor@0:     my $net = shift;
igor@0:     my @res;
igor@0:     say("Doing ping sweep of the $net IP-addresses block");
igor@0:     open(NMAP, "nmap -sP $net|grep 'appears to be up' | awk '{print \$2}'|")
igor@0:         or die "can't make ping sweep of $net. Have you nmap installed?\n$!";
igor@0:     while (<NMAP>) {
igor@0:         chomp;
igor@0:         push (@res, ($_));
igor@0:         say(".");
igor@0:     }
igor@0:     say("Done. $#res host(s) found.\n");
igor@0:     return @res;
igor@0: }
igor@0: 
igor@0: sub dns_axfr($)
igor@0: {
igor@0:     my @res;
igor@0:     my ($zone,$ns) = split /@/;
igor@0:     if ($ns eq '') {
igor@0:     }
igor@0:     else 
igor@0:     {
igor@0:         say("Doing axfr of the zone $zone from the server $ns\n");
igor@0:         open(DIG, "dig \@$ns axfr $zone | awk '/\tA\t/ {print \$1}' |")
igor@0:             or die "can't make axfr of the zone $zone from the server $ns. Have you dig installed?\n$!";
igor@0:         while (<DIG>) {
igor@0:             chomp;
igor@0:             push (@res, ($_));
igor@0:         }
igor@0:         say("Done. $#res host(s) found.\n");
igor@0:         return @res;
igor@0:     }
igor@0: }
igor@0: 
igor@0: my @dests=();
igor@0: while(<>)
igor@0: {
igor@0:     chomp;
igor@0:     next if /^#/;
igor@0:     if (m@http:@) {
igor@0:     }
igor@0:     elsif (m@/@) {
igor@0:         push(@dests,ping_sweep($_))
igor@0:     }
igor@0:     elsif (m'@') {
igor@0:         push (@dests,dns_axfr($_))
igor@0:     }
igor@0:     else {
igor@0:         push(@dests,($_));
igor@0:     }
igor@0: }
igor@0: 
igor@0: @prefixes=load_prefixes();
igor@0: 
igor@0: for $dest (@dests)
igor@0: {
igor@0:     say("Tracing path to $dest");
igor@0:     open (TRACE,"traceroute $traceroute_options $dest|")
igor@0:         or die "Can't run traceroute:$!";
igor@0:     my $hop='';
igor@0:     $ttl=0;
igor@0:     my $total=0;
igor@0:     while (<TRACE>) {
igor@0:         chomp;
igor@0:         next if not /ms/;
igor@0:         say(".");
igor@0:         $ttl++;
igor@0:         s@^\s*@@;
igor@0:         $previous_hop=$hop;
igor@0:         $previous_time=$time;
igor@0:         my $a;
igor@0:         ($a, $hop, $time) = split(/\s+/, $_, 3);
igor@0:         $time =~ s/\s*ms\s*$//;
igor@0:         $total += $time;
igor@0:         if ($previous_hop eq '') {
igor@0:             print_hop($hop);
igor@0:             $graph =~ s@color=[^],]*[],]@@;
igor@0:             $graph =~ s@(\ label=\")[^"]*(\".*?)$@fontsize=10,color=red,style=filled,label="(YOU)$2@;
igor@0:         }
igor@0:         elsif (not defined $hop_id{$hop} ) {
igor@0:             print_hop($previous_hop);
igor@0:             print_hop($hop);
igor@0:             $graph .= "hop".$hop_id{$previous_hop}." -- hop".$hop_id{$hop}.
igor@0:             " [label=\"".sprintf("%1.2f",+$time-$previous_time)."\",len=".time_to_len($time,$previous_time)."];\n";
igor@0:         }
igor@0:     }
igor@0:     $graph =~ s@(\ label=\")[^"]*(\".*?)$@fontsize=8,style=filled,label=\"$dest$2@;
igor@0:     close(TRACE);
igor@0:     say("Done [last $time, total $total]\n");
igor@0: }
igor@0: #$temp=rand.rand;
igor@0: 
igor@0: open (DOT, ">$dot_file")
igor@0:     or die "can;t open dot file file for writing: $!";
igor@0: print DOT <<EOF;
igor@0: graph G {
igor@0:     margin =1 ;
igor@0:     node [fontname=times,fontsize=7,shape=circle,width=0.1,height=0.1,fixedsize=true,color=blue];
igor@0:     edge [fontname=times,fontsize=5,color=black];
igor@0: $graph
igor@0: }
igor@0: EOF
igor@0: close(DOT);
igor@0: 
igor@0: print `neato -o $png_file -Tpng $dot_file > /dev/null 2>&1; neato -o $svg_file -Tsvg $dot_file > /dev/null 2>&1 `
igor@0:     or die "can't run neato: $!;\ngraphviz is installed?\nYou can tracemap.dot to the hosts where graphviz in installed and run\nneato -o tracemap.png -Tpng tracemap.dot"
igor@0: