#!/usr/bin/env perl
# $Id: tracestats.pl,v 1.1 2012/08/09 19:22:03 ksb Exp $

use lib '/usr/local/lib/sac/perl'.join('.', unpack('c*', $^V)),
	'/usr/local/lib/sac';
use strict;
use Socket;
use Sys::Hostname;
use Getopt::Std;
use POSIX qw(floor);

my($progname) = $0;
$progname ||= 'tracestats';
$progname =~ s,.*/,,;
my(%opts);
getopts('dhnN:O:p:S:t:T:VxR:X:', \%opts);
# string math for default suffix added/removed for this host's name
my($suffix) ||= $opts{'S'};	#  e.g. "prod", or "lab", or "test"
my($common) = $opts{'T'};
$common ||= "fedex.com";	# common tail to remove
my($admindept) = $opts{'O'};
$admindept ||= "sac";		# default admin department
my($host) = hostname();
if (!defined($host)) {
	$host = `uname -n`;
	chomp $host;
}
$host =~ m/(.*)\.$common$/ and do {
	$host = $1;
	$host =~ m/(.*)\.$admindept$/ and do {
		$host = $1;
	};
};
# If our hostname is not a FQDN under $common we might have to adjust the
# results from the above.  Or just force it on the command line with
# -N real-name.
$host .= ".$suffix" if ($suffix && $suffix ne $admindept);
$host = $opts{'N'} if ($opts{'N'});
my($target) = $opts{'R'} || 'adm1.sac.fedex.com';
my($xfix) = $opts{'X'};
$xfix ||= $1 if ($target =~ m/([^.]+)/o);
$xfix ||= '';

# RRD update interval must be >= 10 sec, or we move the load too much --ksb
my $min_stall = 10;
my($stall);
# We always need a default -p.
$opts{'p'} ||= 60;
if ($opts{'p'} < $min_stall) {
	$opts{'p'} = $min_stall;
}
$stall = $opts{'x'} ? 0 : floor(0.5+rand($opts{'p'}));
my($peghost,$pegport);
$peghost = shift(@ARGV);
$peghost ||= $opts{'t'};
$peghost ||= 'peg.sac.fedex.com:31415';
if ($peghost =~ m/^([^:]+):([0-9]+)$/) {
	$pegport = $2;
	$peghost = $1;
}
if ($peghost =~ m/^:([0-9]+)$/) {
	$pegport = $1;
}
$pegport ||= 31415;

if ($opts{'V'}) {
	print "$progname: ", '$Id: tracestats.pl,v 1.1 2012/08/09 19:22:03 ksb Exp $', "\n",
		"update: $peghost:$pegport\n",
		"node: $host", ($opts{'N'} ? " [forced]": ''), "\n";
	if (defined($admindept) && defined($common)) {
		print "remove: admin \"$admindept\" after toplevel \"$common\"\n";
	} elsif (defined $common) {
		print "remove: toplevel \"$common\"\n";
	} elsif (defined $admindept) {
		print "squelch: admin \"$admindept\"\n";
	}
	if (defined($suffix) && (!defined $admindept || $suffix ne $admindept)) {
		print "add: suffix $suffix\n";
	}
	exit(0);
}

if ($opts{'h'}) {
	print "$progname: usage [-dx] [-p delay] [-N node] [-O admin] [-R target] [-S suffix] [-t peg[:port]] [-T toplevel] [-X as] [peg][:port]\n",
		"$progname: -h|-V\n",
		"d          display RRD path only, and exit\n",
		"h          output a brief help message\n",
		"n          do not really update peg\n",
		"N node     use this node name, rather than our hostname\n",
		"O admin    set the administrators department suffix\n",
		"p delay    update persistantly, about every delay seconds\n",
		"R target   remote target to sample via traceroute\n",
		"S suffix   remove this suffix after toplevel, if present\n",
		"t peg:port another way to provide our sample destination\n",
		"T toplevel remove this from the end of our hostname\n",
		"V          output the standard version information\n",
		"x          trace updates on stdout\n",
		"X as       specify the traceroute rrd file suffix, \"trace\".as.\".rrd\"\n",
		"peg        sample collection host, running rrdd\n",
		"port       rrdd update port (otherwise $pegport)\n";
	exit(0);
}

# Any setup you need to locate data sources %% here %%
my($ph, $seq, $peer);
$seq = 0;
die "open: traceroute"
	unless ($peer = open $ph, "while traceroute -q 1 -z 50 -n $target 2>&1; do sleep $opts{'p'}; done|");
# outputs something like:
#traceroute to foobie.*
# 1  199.81.77.5  0.629 ms
# 2  161.135.250.2  1.206 ms
# 3  161.135.255.69  29.839 ms
# 4  161.135.255.82  30.474 ms
# 5  165.150.252.22  30.352 ms
# 6  165.150.4.174  30.541 ms
# 7  199.82.95.166  30.617 ms
#<delay>
#traceroute to foobie.*
# 1  199.81... <repeat hops with new times>
# DS number of hops in this sample, max delay, t1,t2,t3...tN  N < 64
# So the RRD file has 66 DSs "hops" "mh" h1 h2 h3 h4... h64 all gauges
# the renders renders all the DS up to mh as a stacked graphic

# Send to peg's rrdd, peg could move over time, so we look it up each round
my($update,$ipout,$proto,$sockaddr);
$proto = getprotobyname('udp') ||
	die "getprotbyname: udp: $!";
socket(SOCKET, PF_INET, SOCK_DGRAM, $proto) ||
	die "socket: inet: $!";
my($time,$ttl,$loss,$temp);
my(@htl) = (0.0);		# DS trace latency
my(@hds) = ('maxrtt');		# DS names
my($line,$hops);
$hops = 0;
while ($line = <$ph>) {
	chomp($line);

	# 5  165.150.252.22  30.352 ms
	if ($line =~ m/\s*(\d+)\s+([0-9.]+)\s+([0-9.]*)\s*ms\s*$/o) {
		$hds[$1] = "h$1";
		$htl[$1] = $3;
		$hops = $1 if ($hops < $1);
		$htl[0] = $3 if ($htl[0] < $3);
		next;
	#traceroute header
	} elsif ($line !~ m/traceroute\sto\s/io) {
		print STDERR "$progname: not traceroute output I grok:\n\t$line\n";
		last;
	}
	next if (0 == $hops);
	next unless (defined($htl[1]));

	# We have an update, yay!  Is Peg still in DNS?
	last unless ($ipout = inet_aton($peghost));
	$update = "host/$host/app-trace$xfix.rrd hops:mt:".join(':', @hds)." N:$hops:".join(':', @htl);
	if ($opts{'d'}) {
		$update =~ s/\s.*//;
		print "$update\n";
		kill 15, $peer;
		last;
	}
	print $update, "\n" if ($opts{'x'});
	@htl = (0.0);
	@hds = ('maxrtt');
	$hops = 0;
	#$sockaddr = sockaddr_in($pegport, $ipout);
	#send(SOCKET, '00 '.$update, 0, $sockaddr) unless $opts{'n'};
}
close(SOCKET);
exit(0);