#!/usr/bin/env perl
# $Id: networkstats.pl,v 1.3 2009/01/16 15:49:02 ksb Exp $
# This is the networkstats peg sampler (coded in perl)
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 ||= 'networkstats';
$progname =~ s,.*/,,;
my(%opts);
getopts('dhnN:O:p:S:t:T:Vx', \%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'});


# RRD update interval must be >= 10 sec, or we move the load too much --ksb
my $min_stall = 30;
my($stall,$remainder);
# Under -p (persistant) we are a service run at boot, otherwise assume we
# are run from cron once a minute or so, or the command line -x to test.
if ($opts{'p'}) {
	if ($opts{'p'} < $min_stall) {
		$opts{'p'} = $min_stall;
	}
	$stall = $opts{'x'} ? 0 : floor(0.5+rand($opts{'p'}));
	$remainder = $opts{'p'}-$stall;
} else {
	$stall = $opts{'x'} ? 0 : floor(3.5+rand(55));
	$remainder = undef;
}
my($peghost,$pegport);
$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: networkstats.pl,v 1.3 2009/01/16 15:49:02 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] [-S suffix] [-t peg[:port]] [-T toplevel] [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",
		"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",
		"peg        sample collection host, running rrdd\n",
		"port       rrdd update port (otherwise $pegport)\n";
	exit(0);
}

# Any setup we need to locate data sources
my $uname = `uname -s`;
chomp $uname;

# crud, we need to find the index for each interface
my(%inote) = ();
if ('HP-UX' eq $uname) {
	my ($line, $interface, @s);
	if (open LOUT, "lanscan|") {
		for $line (<LOUT>) {
			next if ($line =~ m/^Hardware/o);
			next if ($line =~ m/^Path/o);
			@s = split(/\s+/o, $line);
			for $interface (@ARGV) {
				$inote{$interface} = $s[6] if ($s[4] eq $interface);
			}
		}
		close LOUT;
	}
	for $interface (@ARGV) {
		die "$progname: $interface: no index found\n" unless (exists($inote{$interface}));
	}
} else {
	die "$progname: os not supported yet.\n";
}

# Gather the update we need to send, we allow NO white-space before	(ksb)
# the path to the RRD file.  Return the update as a string:
#    "sample-dir/object/attribute.rrd Ds1:Ds2:... N:sample1:sample2..."
sub mkUpdate($)
{
	my($interface) = shift;
	local *STATS;
	my($stats, @s, $key, $count);

	if ($uname eq 'Linux') {
		$key = 'iucast:oucast:ierr:oerr';
		open STATS, "netstat -ni |" or die "open: netstat";
		while (<STATS>) {
			next unless $_ =~ m/^$interface[\s]/;
			@s = split qr/[\s]/o;
			$stats = "$s[4]:$s[8]:$s[5]:$s[9]";
		}
		close STATS;
	} elsif ($uname eq 'HP-UX') {
		$key = 'ibyte:iucast:inucast:ierr:obyte:oucast:onucast:oerr';
		open STATS, "(echo lan; echo display; echo ''; echo quit )|/usr/sbin/lanadmin -t $inote{$interface} 2>/dev/null|" or die "open: lanadmin";
		@s= ();
		while (<STATS>) {
			chomp;
			$s[0] = $1 if ($_ =~ m/^Inbound Octets.*=[\D]*(\d+)\s*$/o);
			$s[1] = $1 if ($_ =~ m/^Inbound Unicast.*=[\D]*(\d+)\s*$/o);
			$s[2] = $1 if ($_ =~ m/^Inbound Non-Unicast.*=[\D]*(\d+)\s*$/o);
			$s[3] = $1 if ($_ =~ m/^Inbound Errors.*=[\D]*(\d+)\s*$/o);
			$s[4] = $1 if ($_ =~ m/^Outbound Octets.*=[\D]*(\d+)\s*$/o);
			$s[5] = $1 if ($_ =~ m/^Outbound Unicast.*=[\D]*(\d+)\s*$/o);
			$s[6] = $1 if ($_ =~ m/^Outbound Non-Unicast.*=[\D]*(\d+)\s*$/o);
			$s[7] = $1 if ($_ =~ m/^Outbound Errors.*=[\D]*(\d+)\s*$/o);
		}
		close STATS;
		$stats = join(':', @s);
	} else {
		open STATS, "netstat -nI $interface|" or die "open: netstat";
		$count = 1;
		while (<STATS>) {
			if (2 == $count) {
				@s = split qr/[\s]/o;
				$stats = "$s[5]:$s[7]:$s[6]:$s[8]";
			}
			++$count;
		}
		close STATS;
	}
	return "host/$host/net-$interface.rrd $key N:$stats";
}

# 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: $!";
while ($ipout = inet_aton($peghost)) {
	sleep($stall) unless $opts{'d'};
	for my $interface (@ARGV) {
		$update = mkUpdate($interface);
		if ($opts{'d'}) {
			$update =~ s/\s.*//;
			print "$update\n";
			next;
		}
		print $update, "\n" if ($opts{'x'});
		$sockaddr = sockaddr_in($pegport, $ipout);
		send(SOCKET, '00 '.$update, 0, $sockaddr) unless $opts{'n'};
	}
	last if ($opts{'d'});
	last unless defined($remainder);
	sleep($remainder);
	next unless (0 == $stall);	# -x set stall to 0, recompute it
	$stall = floor(0.5+rand($opts{'p'}));
	$remainder = $opts{'p'}-$stall;
}
close(SOCKET);
exit(0);