#!/usr/bin/env perl
# We collect the stats from a V9 bind instance.
#	+++ Statistics Dump +++ (1216140220)
#	success 5191902
#	referral 4915526
#	nxrrset 1214569
#	nxdomain 1226360
#	recursion 1271
#	failure 953557
#	duplicate 0
#	dropped 0
#	--- Statistics Dump --- (1216140220)
#
# $Id: namedstats.pl,v 1.6 2008/10/30 22:47:44 anderson Exp $
# $Source: /usr/msrc/usr/local/libexec/namedstats/RCS/namedstats.pl,v $

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($stall,$remainder);
my($update);
my($ipout,$proto,$sockaddr);
my($rndcprog);

# rrd update interval must be >= 60 sec
my($progname) = $0;
$progname =~ s,.*/,,;
my(%opts);
getopts('F:hnt:xVN:p:S:T:O:', \%opts);
if ($opts{'p'}) {
	$opts{'p'} -= 60;
	if ($opts{'p'} < 0) {
		$opts{'p'} = 0;
	}
	$stall = floor(0.5+rand($opts{'p'}));
	$remainder = $opts{'p'}-$stall;
} else {
	$stall = floor(2.5+rand(56));
	$remainder = 0;
}
# get hostname: CONFIG for your domain, not ".fedex.com" and ".sac"
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";		# admin default department
my($host) = hostname();
$host =~ m/(.*)\.$common$/i and do {
	$host = $1;
	$host =~ m/(.*)\.$admindept$/i and do {
		$host = $1;
	};
};
$host .= ".$suffix" if (defined($suffix) && $suffix ne $admindept);
if ($opts{'N'}) {
	$host = $opts{'N'};
}

my($trace) = $opts{'x'};
my($exec) = $opts{'n'};
my($port) = 31415;
my($peg) = $opts{'t'};
$peg = $ARGV[0] if defined($ARGV[0]);
$peg ||= 'peg.sac.fedex.com';
if (($peg =~ s/:(\d*)//) && '' ne $1) {
	($peg, $port) = ($1, $2);
}
if ($opts{'h'}) {
	print "$progname: usage [-46nx] [-F stats] [-N node] [-p delay] [-P proto] [-t peg[:port]]\n",
		"$progname: -h\n",
		"$progname: -V\n",
		"h        show this help message\n",
		"F stats  specify a path to named's stats cache file\n",
		"n        do not send updates to peg\n",
		"N node   rename this host for peg\n",
		"O admin  set the administrators department suffix\n",
		"p delay  send an update every about delay seconds\n",
		"S suffix remove this suffix after toplevel, if present\n",
		"t peg    target a local peg instance\n",
		"T toplevel remove this from the end of our hostname\n",
		"V        show the version of the program running\n",
		"x        trace updates sent to peg\n",
		"peg:port where the sample goes\n";
	exit(0);
}
if ($opts{'V'}) {
	print "$progname: ",'$Id: namedstats.pl,v 1.6 2008/10/30 22:47:44 anderson Exp $',"\n",
		"$progname: update $peg:$port as $host/app-named.rrd\n";
	exit(0);
}

if ( -e "/usr/sbin/rndc" ) {
	$rndcprog = "/usr/sbin/rndc";
} elsif ( -e "/usr/local/sbin/rndc" ) { 
	$rndcprog = "/usr/local/sbin/rndc";
} else { 
	print "no rndc found!\n";
	exit (1);
}


# We depend on STATS being an open file.
my($named_stats) = $opts{'F'};
$named_stats ||= '/var/named/var/stats/named.stats';

# do the work, run rndc,
# wait for a minimal update, about 140c for 9.4, 100c for 9.3 (ksb/gcr)
# read the stats we got and return the NVP to the generic sampler.
sub gather
{
	my(@ret) = ();
	local($_);
	my($i, $tval, $size);

	truncate $named_stats, 0;
	0 == system($rndcprog, 'stats') or
		die "$progname: rndc could not run: $!\n";
	while (sleep(1)) {
		(undef,undef,undef,undef,undef,undef,undef,$size,undef,undef,undef,undef,undef) = stat($named_stats);
		die "$progname: stat: $named_stats: $!\n" unless defined($size);
		last if ($size > 100);
	}

	if (open STATS, "<$named_stats") {
		while (<STATS>) {
			last if $_ =~ /^[+][+][+]\s+statistics.*\(\d+\)\s$/oi;
		}
		while (<STATS>) {
			last if $_ =~ /^[-][-][-]\s+statistics.*\(\d+\)\s$/oi;
			push(@ret, "$1=$2") if ($_ =~ m/\s*(\w+)\s+(\d+)/o);
		}
		close STATS;
	}
	return @ret;
}

$| = 1;
my(%param);
# Send to peg's rrdd, peg could move in weeks, but udp should never change
# we could keep the same socket as long as peg's address has not changed,
# I would think (LLL).
$proto = getprotobyname('udp');
while ($ipout = inet_aton($peg)) {
	sleep($stall);
	foreach (gather()) {
		next unless m/^(.*)=(.*)/o;
		$param{$1} = $2;
	}
	$update = "host/$host/app-named.rrd ". join(':', keys(%param)). " ". join(':', 'N', values(%param));

	# send off the update
	$sockaddr = sockaddr_in($port, $ipout);
	socket(SOCKET, PF_INET, SOCK_DGRAM, $proto);
	send(SOCKET, "00 $update", 0, $sockaddr) unless $exec;
	print 'update ', $update, "\n" if $trace;
	close(SOCKET);
	last unless defined($opts{'p'});

	# compensate for the sleep 1 in gather
	sleep(59+$remainder);
	$stall = floor(0.5+rand($opts{'p'}));
	$remainder = $opts{'p'}-$stall;
}

exit(0);