#!/usr/bin/perl -w
#
# $Id: mtraceroute.pl,v 1.10 2003/01/13 05:28:42 jmates Exp $
#
# Copyright (c) 2000-2001, Jeremy Mates.  This script is free
# software; you can redistribute it and/or modify it under the same
# terms as Perl itself.
#
# Run perldoc(1) on this file for additional documentation.
#
######################################################################
#
# REQUIREMENTS

require 5;

use strict;

######################################################################
#
# MODULES

use Carp;         # better error reporting
use Getopt::Std;  # command line option processing

######################################################################
#
# VARIABLES

my $VERSION;
($VERSION = '$Revision: 1.10 $ ') =~ s/[^0-9.]//g;

my (%opts, %data, %stats, $traceroute);

# change to suit your needs
$traceroute = '/usr/sbin/traceroute';

######################################################################
#
# MAIN

# parse command-line options
getopts('h?', \%opts);

help() if exists $opts{'h'} or exists $opts{'?'};

# read from STDIN if no args left
chomp(@ARGV = <STDIN>) unless @ARGV;

# and flag the help text if nothing from STDIN
help() unless @ARGV;

# reference on the data structure used herein:
# %data = (
# 'hostname' => {
#   array of anon hashes holding traceroute output...
#   array index is -1 the hop, hash holds 'ip' 'hostname' 
#   and then 'times' => array of probe times
# in case of '* * *' timeout, usual ip/host/times will be undef,
# so be sure to check for it!

# ref on stats, which holds additional (global) info...
# %stats = (
# 'hostname' => {
#    'timeouts' = count of number of timeouts (* * *) along path
#    'maxhops' = total number of hops to target host

# assume incoming data is wave of hosts/ip addresses to traceroute to
for my $host (@ARGV) {
  unless (open TRACE, "$traceroute $host 2>/dev/null |") {
    die "Problem with traceroute on $host: $!\n";
  } else {
    $stats{$host}->{'timeouts'} = 0;

    while (<TRACE>) {

      # head off timeouts at the pass, otherwise rip by regex
      if (m/^\s*\d+\s+\* \* \*$/) {
        push @{$data{$host}}, undef;
        $stats{$host}->{'timeouts'}++;

      } elsif (
        m/^\s*\d+[ *]+    # optional leading whitespace & index
		     (\S+)\s+	       # hostname   $1
		     \(([^\)]+)\)\s+   # ip address (inside ()'s)   $2
		     (.*?)$/x  # the probe times $3
       ) {

        # extract probe times manually
        my (@times) = $3 =~ m/(\d+\.\d+)\sms\s/g;

        # catch triple failed probes; mean/stddev don't like
        # null arrays, as it turns out...
        push @times, -1 unless @times;

        # righty, form up data thingy...
        push @{$data{$host}},
         {
          'ip'       => $2,
          'hostname' => $1,
          'times'    => \@times,
          'mean'     => mean(\@times),
          'stddev'   => standard_deviation_data(\@times),
         };
      }
    }

    close TRACE;

    # now a good time to store some stats...
    if (defined $data{$host}) {
      $stats{$host}->{'maxhops'} = @{$data{$host}};
    } else {
      warn "Warning: no data gained for $host\n";
    }
  }
}

# simple display until I can figure out better stuff to do with
# the data...
for (@ARGV) {
  next unless $stats{$_}->{'maxhops'};

  print $stats{$_}->{'maxhops'}, " hops to host ", $_;
  if ($stats{$_}->{'timeouts'} > 0) {
    print " errors ", $stats{$_}->{'timeouts'};
  } else {
    print " no errors";
  }
  print "\n";

  # and let's look at some specific stuff
  #    foreach my $info (@{$data{$_}}) {
  #	print $info->{'mean'}, "\t", $info->{'stddev'}, "\n";
  #    }
}

exit;

######################################################################
#
# SUBROUTINES

# $sd = standard_deviation_data(\@array) computes the standard
# deviation of an array of numbers.
#
sub standard_deviation_data {
  my $arrayref = shift;
  my $mean     = mean($arrayref);
  return sqrt(mean([map $_**2, @$arrayref]) - ($mean**2));
}

# $mean = mean(\@array) computes the mean of an array of numbers.
#
sub mean {
  my ($arrayref) = shift;
  my $result;
  foreach (@$arrayref) { $result += $_ }
  return $result / @$arrayref;
}

# a generic help blarb
sub help {
  print <<"HELP";
Usage: $0 [options] [host1 host2 .. hostN]

A mass tracerouter that summarizes the results.

Options for version $VERSION:
  -h/-?  Display this message

Run perldoc(1) on this script for more documentation.

HELP
  exit;
}

__END__

######################################################################
#
# DOCUMENTATION

=head1 NAME

mtraceroute.pl - summarizes multiple traceroutes.

=head1 SYNOPSIS

To find out the hops count to some hosts, simply run:

  $ mtraceroute.pl example.com example.org

=head1 DESCRIPTION

=head2 Overview

This script performs multiple traceroutes, and stores the results for
later viewing by the user.  The typical use is to figure out which
host among many has the least hops.

=head2 Normal Usage

  $ mtraceroute.pl [options] [host1 host2 .. hostN]

See L<"OPTIONS"> for details on the command line switches supported.

The list of hosts can either be supplied on the command line, or,
failing that, passed in on STDIN.

The script does no error checking on the supplied data, which should
consist of hostnames or ip addresses passed directly to traceroute(8).

=head1 OPTIONS

This script currently supports the following command line switches:

=over 4

=item B<-h>, B<-?>

Prints a brief usage note about the script.

=back

=head1 FILES

This script relies on traceroute(8) being present on your system.  The
path to traceroute is hardcoded in the VARIABLES section of the
script, and may need to be changed.

=head1 BUGS

=head2 Reporting Bugs

Newer versions of this script may be available from:

http://sial.org/code/perl/

If the bug is in the latest version, send a report to the author.
Patches that fix problems or add new features are welcome.

=head2 Known Issues

No known bugs.

=head1 TODO

Variety of output formats, e.g. dump-to-perl-data-structure or perhaps
XML output.

Better way specifying traceroute/path to and also means of passing
command line switches to said program.

=head1 SEE ALSO

perl(1), traceroute(8)

=head1 AUTHOR

Jeremy Mates, http://sial.org/contact/

=head1 COPYRIGHT

Copyright (c) 2000-2001, Jeremy Mates.  This script is free
software; you can redistribute it and/or modify it under the same
terms as Perl itself.

=head1 VERSION

  $Id: mtraceroute.pl,v 1.10 2003/01/13 05:28:42 jmates Exp $

=cut