#!/usr/local/bin/perl -w
#
#   trcheck.pl
#
# Traceroute to a target and compare the hops to a given set of "must see"
# hops known as "waypoints".  See the WayPaints.txt file for more information.
# Return a true or false status to the shell.
#
# When the netserver machine was upgraded in October 2009, this script
# broke.  Nteserver had been upgraded to Debian "lenny", which
# upgraded Perl from 5.8.4 to 5.10.0 and upgraded the
# "traceroute" binary to a new version.  The new traceroute had a bug:
# command-line option "-m" was broken, and would cause "traceroute" to
# fail. Later versions of traceroute were fixed, but that didn't
# matter at the time.  I decided to bypass the "traceroute" binary
# altogether, and use use a "pure perl" implementation of traceroute.
# I got it working, which is cool, but there were issues:
#
#   1. You now have to run this program as root
#   2. The PurePerl module has a "bug" of it own: it defines a constant
#      named IP_TTL that causes a warning in the new Perl.  To solve
#      this, I made a copy of the PurePerl.pm module in the local
#      directory, and commented out the offending line.  That's why
#      this script uses the local copy of PurePerl.pm.
#
# TODO:
#
# As David suggested, merge the driver script and the Waypoints.txt file into
# this script, so there's only one file to maintain.  I started to do this by
# defining the data structure that would replace the driver script.  It would
# be an array of hashes.  See the commented-out code below that defines
# TracerouteTargets.
#
#
# DNS updates:
#
# Ask Utah to define reverse entries for
#   205.122.102.33
#   205.124.237.10
#
# Here are reasons that a traceroute might "star" on a given hop:
#
#  1. The router at that hop is down.  The traceroute will keep
#  putting out stars, and so will mtr.
#
#  2. The router at that hop doesn't have a route back to the source
#  machine.  The symptoms are the same as #1.
#
#  3. The replies from the router at that hop are blocked.  For
#  example, suppose you're tracerouting from a machine in the State
#  network to a machine outside the State network, and the hop
#  representing the FRGP router stars out, but the succeeding routers
#  don't.  It could be because the packet filter on the State's router
#  blocks inbound packets with IP addresses that are "in" the State's
#  network.  On point-to-point network that connects the State to the
#  FRGP, the IP addresses are "in" the State's range, so they are
#  blocked.  The fix is to have the State tune their packet filter so
#  that instead of blocking any packet with a source address inside
#  the State network, they block all but the packets on the
#  point-to-point link.
#
#  4. The router at that hop has a packet filter that is preventing
#  the UDP packets from being received or sent, or is otherwise not
#  responding to traceroute packets.  The traceroute will continue
#  normally at the next hop.  Perhaps you can avoid the problem by
#  using the "-I" option in your traceroute command to make it use
#  ICMP ECHO instead of UDP datagrams.
#

use strict;
use Getopt::Std;
#use Data::Dumper;
use Net::Traceroute;
use PurePerl;

# Sample of an array of hashes that could replace the
# script that drives this program, and how to access them:
# my @TracerouteTargets = (
#  	{
#  		DnsName          => 'www.ahec.edu',
#  		ShortName        => 'AHEC',
#  		MaxTtl           => 5,
#  		IncludeWaypoints => [ 'FRGP-WAN', 'FRGP-UPoPAHEC' ],
#  		ExcludeWaypoints => [ 'BPoP-ICG', 'FRGP-Commodity', 'l3-transitrail' ]
#  	},
# );
# print Dumper \@TracerouteTargets;
# foreach my $Target (@TracerouteTargets) {
# 	print "The include waypoints for target " . $$Target{DnsName} . " are ";
# 	foreach my $WP (@{$$Target{IncludeWaypoints}}) {
# 		print $WP . " ";
# 	}
# 	print "\n";
# }
# exit;

my $SUCCESS = 0;
my $FAILURE = 1;
my $INCORRECT_USAGE = 2;

my $WaypointsFileName = '/usr/web/nets/tools/trcheck/Waypoints.txt';
my %Waypoints;


sub PrintWaypoints () {
  print "These are the waypoints read from file $WaypointsFileName:\n\n";
  foreach my $key (sort keys %Waypoints) {
    my $pts = join ', ', @{ $Waypoints{$key} };
    my $spaces = 18 - length($key);
    print " $key:" . (' ' x $spaces) . "$pts\n";
  }
  exit $INCORRECT_USAGE;
}


sub ReadWaypoints {
  open WAYPOINTSFILE, "<$WaypointsFileName" or do {
    die "Couldn't open $WaypointsFileName for reading, $!"
  };
  while ( <WAYPOINTSFILE> ) {
    next if /^#/;
    next unless s/^([^ ]+) *:\s*//;
    my $WaypointName = $1;
    if (/[a-zA-Z]/) {        # if it contains letters (it's a composite)
      $Waypoints{$WaypointName} = [];
      foreach my $composite ( split ) {
        foreach my $ip (@{ $Waypoints{$composite} }) {
          push @{ $Waypoints{$WaypointName} }, $ip;
        }
      }
    } else {
      $Waypoints{$WaypointName} = [ split ];
    }
  }
  close WAYPOINTSFILE;
}


sub Usage {
  print <<USAGE;

	Usage:

	trcheck.pl [ -d ] -t <target> [ -s ] [ -n <name> ]
            [ -m <maxttl> ] [ -i <waypointlist> ] [ -e <waypointlist> ]

	-d   debug: display debugging messages while running
	-t   target: a DNS name or IP address of a target
	-n   name: a short name for the target site
	-m   maximum Time-To-Live (aka hopcount), defaults
	     to 30
	-i   include a comma-separated list of waypoints.  The
	     traceroute to the target must include all
	     the waypoints in this list, in order
	-e   exclude a comma-separated list of waypoints.  The
	     traceroute to the target must not include any
	     of the waypoints in this list.
	-h   help: print this message and exit
	-s   silent mode: don't display status or error
                 messages, just return a status.  This is
                 provided so this program can be used in
                 shell scripts.
	-v   verbose: For each traceroute, show the waypoints included
		 and excluded from the path.
        -I   Use ICMP in traceroutes.
}

The -t option must exist and at least one of -i or -e must exist.

Example:

The following executes a "traceroute -m 15 life.ai.mit.edu" command
and verifies that the traceroute goes through the waypoints named
BiSONA and Abilene, and doesn't go through the waypoint named
Commodity.

trcheck.pl -t life.ai.mit.edu -n MIT -m 15 -i BiSONA,Abilene -e Commodity

A "waypoint" is a set of IP addresses that a traceroute might go
through to get from one network to another.  For example, the two IP
addresses at the ends of a point-to-point connection are a waypoint.
Both addresses are specified to allow the script to work regardless
of which direction the traceroute traverses the waypoint.

USAGE

  PrintWaypoints;
}


my $Debug;
my $MaxTtl;
my $SilentMode = 0;
my $Target;
my $TargetName;
my $UseIcmp = 0;
my $Verbose = 0;
my @BadWaypoints;
my @GoodWaypoints;

sub ParseCommandLine() {

  my %options;
  if (getopts('t:n:m:i:e:hsvdI', \%options) == 0) {
    warn "Couldn't parse command line\n";
    Usage();
  }
  if (exists $options{'h'}) {
    Usage();
  }
  if ((!exists $options{'e'}) and (!exists $options{'i'})) {
    warn "must specify -i or -e or both\n";
    Usage();
  }
  if (!exists $options{'t'}) {
    warn "must specify -t\n";
    Usage();
  }
  $Target = $options{'t'};
  $SilentMode = 1 if exists $options{'s'};
  $Verbose = 1 if defined $options{'v'};
  $Debug = 1 if defined $options{'d'};
  $UseIcmp = 1 if defined $options{'I'};
  if (exists $options{'n'}) {
    $TargetName = $options{'n'};
  }
  if (exists $options{'m'}) {
    $MaxTtl = $options{'m'};
  }

  my $BadCommandLine = 0;
  if (exists $options{'i'}) {
    @GoodWaypoints = split /,/, $options{'i'};
    foreach my $wp (@GoodWaypoints) {
      if (!exists $Waypoints{$wp}) {
        print "Unknown waypoint specified with \"-i\" on command line: $wp\n";
        $BadCommandLine = 1;
      }
    }
  }
  if (exists $options{'e'}) {
    @BadWaypoints = split /,/, $options{'e'};
    foreach my $wp (@BadWaypoints) {
      if (!exists $Waypoints{$wp}) {
        print "Unknown waypoint specified with \"-e\" on command line: $wp\n";
        $BadCommandLine = 1;
      }
    }
  }
  if ($BadCommandLine) {
    PrintWaypoints;
  }
}


#
# Given a traceroute and a waypoint, return a boolean value that says
# whether the traceroute goes through the waypoint.
#
sub Contains($$) {
  my $tr = shift;
  my $WaypointName = shift;

  if ($Debug) {
    print "\nContains: WaypointName = \"$WaypointName\"\n";
  }

  foreach my $hop (1..$tr->hops) {
    if ($Debug) {
      print "Contains:     hop = \"$hop\"\n";
    }
    my $trhop = $tr->hop_query_host($hop, 1);
    if (defined $trhop) {
      if ($Debug) {
        print "Contains:        trhop = \"$trhop\"\n";
      }
      foreach my $WaypointIP (@{ $Waypoints{$WaypointName} }) {
        if ($Debug) {
          print "Contains:        comparing $trhop to $WaypointIP\n";
        }
        if ($trhop eq $WaypointIP) {
          if ($Debug) {
            print "Contains:         MATCH!!! returning TRUE\n";
          }
          return 1;
        }
      }
    }
  }
  if ($Debug) {
    print "Contains: returning FALSE\n";
  }

  return 0;
}


#
#  Main  ========================================================================
#

ReadWaypoints;
ParseCommandLine;
select STDOUT; $| = 1;

#
# Do the traceroute and save the results in $tr.
#
my $space1 = 15 - length($TargetName);
my $space2 = 32 - length($Target);
if (!$SilentMode) {
  print "tracerouting to $TargetName" . ('.' x $space1) . " at $Target " . ('.' x $space2);
}

my $proto = $UseIcmp ? 'icmp' : 'udp';
my $t = new Net::Traceroute::PurePerl(
                                      host     => $Target,
                                      max_ttl  => $MaxTtl,
                                      timeout  => 2,
                                      queries  => 1,
                                      protocol => $proto
                                     );
$t->traceroute;
if (($t->stat != TRACEROUTE_OK) and ($t->stat != TRACEROUTE_UNKNOWN)) {
  my $UseIcmpOpt = $UseIcmp ? ' -I' : '';
  print "\n   traceroute failed.  Try \"traceroute$UseIcmpOpt -m $MaxTtl $Target\"\n";
  exit $FAILURE;
}

# $t->pretty_print();  # this is nice when debugging
#
# Check that the traceroute includes all the good waypoints.
#
my $status = $SUCCESS;
foreach my $GoodWaypointName (@GoodWaypoints) {
  if (!Contains($t, $GoodWaypointName)) {
    if (!$SilentMode) {
      print "\n   Wrong path!  The traceroute doesn't go through $GoodWaypointName";
    }
    $status = $FAILURE;
  }
}

#
# Check that the traceroute excludes all the bad waypoints.
#
foreach my $BadWaypointName (@BadWaypoints) {
  if (Contains($t, $BadWaypointName)) {
    if (!$SilentMode) {
      print "\n   Wrong path!  The traceroute goes through $BadWaypointName";
    }
    $status = $FAILURE;
  }
}

#
# If it worked, print results unless Silent Mode is on.
#
if (($status == $SUCCESS) and !$SilentMode) {
  print "Ok";
  if ($Verbose) {
    print ", ";
    if ($#GoodWaypoints != -1) {
      print "traversed " . join(',', @GoodWaypoints);
    }
    if ($#BadWaypoints != -1) {
      if ($#GoodWaypoints != -1) {
        print " and not " . join(',', @BadWaypoints);
      } else {
        print "didn't go through " . join(',', @BadWaypoints);
      }
    }
  }
}
if (!$SilentMode) {
  print "\n";
}
exit $status;