#!/usr/bin/env perl
# $Id: sampler.pl,v 1.4 2008/10/30 22:47:44 anderson Exp $
# This is the generic peg sampler (coded in perl), you should search
# for the "%% comment %%" lines to fill in the parts for your needs (ksb)

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 ||= '%%name of your sampler%%';
$progname =~ s,.*/,,;
my(%opts);
getopts('dhnN:O:p:S:t:T:Vx'.'%% your options %%', \%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
# %% you could change the 10 below, but I'd only make it bigger %%
my $min_stall = 10;
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 = 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: sampler.pl,v 1.4 2008/10/30 22:47:44 anderson 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'}) {
	# %% add any option you put in getopt above here too %%
	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 you need to locate data sources %% here %%

# Gather the update you 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()
{
	# %% Usually one collects the samples in a hash, then builds the
	# update at the return.  This is not the only way to do it. %%
	my %s;
	%s = {};
	return "host/$host/%%my%%.rrd ".join(':',keys(%s)).' N:'.join(':',values(%s));
}

# 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'};
	$update = mkUpdate();
	if ($opts{'d'}) {
		$update =~ s/\s.*//;
		print "$update\n";
		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);
	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);