#!/usr/bin/perl

use strict;

## Wait 10 seconds for traceroutes to finish
use constant TIMEOUT => 5;

use Net::DNS ();
use Net::Traceroute ();
use GraphViz ();
use Memoize qw( memoize );
use DB_File ();
use Fcntl;

die "usage: $0 hostfile\n" unless @ARGV;
my $file = shift;

my %dns_cache;
tie %dns_cache, DB_File => ".trmap_dns_cache", O_RDWR|O_CREAT, 0666
  or die "Can't tie dns cache hash: $!\n";
memoize( 'lookup_host', SCALAR_CACHE => [ HASH => \%dns_cache ] );
END { untie %dns_cache }

my @hosts;

open( HOST, $file ) or die "Can't open `$file': $!\n";
while( <HOST> ) {
  chomp;
  push @hosts, $_;
}
close( HOST );

my %host_addrs;
$host_addrs{ lookup_host( $_ ) } = $_ foreach @hosts;

my %hops;
my %edges;

my $tr = Net::Traceroute->new( timeout => TIMEOUT );
foreach my $host ( @hosts ) {
  my $t = $tr->clone( host => $host );

  unless( $t->found ) {
    warn "Problem tracerouting to $host\n";
    next;
  }

  print STDERR "## $host: ", $t->hops(), " hops\n";
  my @rtrs;
  push @rtrs, $t->hop_query_host( $_, 0 ) for 1 .. $t->hops;

  $hops{ $_ }++ for @rtrs;
  my $cur = shift @rtrs;
  while( @rtrs ) {
    $edges{ $cur . "=>" . $rtrs[0] }++;
    $cur = shift @rtrs
  }
}

print STDERR "##\n## done traceroute'ing, frobnicating graph\n##\n";

my $g = GraphViz->new(
              directed => 0,
              width => 16, height => 10,
              pagewidth => 8.5, pageheight => 11
             );

for( keys %hops ) {
  my $host = lookup_host( $_ );
  my @extra;
  if( $host =~ /main-router\.example\.com/ ) {
    push @extra, style => filled => color => ".5 .5 .5";
  }
  if( $host =~ /^et-/ ) {
    push @extra, style => filled => color => ".75 .75 .75";
  }
  $g->add_node( $_, fontsize=> 10, label => $host, @extra )
}


for my $hop ( map { [ split( /=>/ ), $edges{$_} ] } keys %edges ) {
  $g->add_edge( @{$hop}[0,1], label => $hop->[2] )
}

print $g->as_canon;

exit 0;

{
  ## $r holds our Net::DNS::Resolver instance between calls
  my $r;

  sub lookup_host {
    my $host = shift;
    $r ||= Net::DNS::Resolver->new();

    return $host_addrs{ $host } if exists $host_addrs{ $host };

    my $q = $r->search( $host );
    unless( defined( $q ) ) {
      warn "Couldn't resolve `$host'\n";
      return $host
    }
    my $ans = ($q->answer())[0];

    return $ans->type eq "PTR" ? $ans->ptrdname : $ans->address;
  }
}

__END__
[download]