#!/usr/bin/env perl
# $Id: pingstats.pl,v 1.4 2012/02/28 20:56:56 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 ||= 'pingstats';
$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,$remainder);
# 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'}));
$remainder = $opts{'p'}-$stall;
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: pingstats.pl,v 1.4 2012/02/28 20:56:56 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";
	}
	if (defined $remainder) {
		print "updates: every ", $stall+$remainder, ", at offset $stall\n";
	} else {
		print "update: once, stalling for $stall\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 ping\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 ping rrd file suffix, \"ping\".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: ping"
	unless ($peer = open $ph, "ping -i $opts{'p'} $target|");

# 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);
while ($ipout = inet_aton($peghost)) {
	my($line) = <$ph>;
	chomp($line);
	if ($line =~ m/[0-9]* bytes* from [^:]*: icmp_seq=([0-9]*) ttl=([0-9]*) time=([0-9.]*)[ ms]*/) {
		($temp,$ttl,$time) = ($1,$2,$3);
	} elsif ($line =~ m/[0-9]* bytes* from [^:]*: icmp_seq=([0-9]*) ttl=([0-9]*) time=([0-9.]*)[ ms]*/i) {
		($temp,$ttl,$time) = ($1,0,$3);
	} else {
		print STDERR "$progname: unknown ping output format:\n	$line\n";
		last;
	}
	$loss = $temp - $seq;
	$update = "host/$host/app-ping$xfix.rrd time:ttl:loss N:$time:$ttl:$loss";
	$seq = $temp+1;
	if ($opts{'d'}) {
		$update =~ s/\s.*//;
		print "$update\n";
		kill 9, $peer;
		last;
	}
	print $update, "\n" if ($opts{'x'});
	$sockaddr = sockaddr_in($pegport, $ipout);
	send(SOCKET, '00 '.$update, 0, $sockaddr) unless $opts{'n'};
	last unless defined($remainder);
}
close(SOCKET);
exit(0);