#!/usr/bin/env perl
# $Id: memstats.pl,v 1.6 2008/11/21 22:23:46 anderson 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 ||= 'mem-stats';
$progname = $1 if $progname =~ m,.*/(.+)$,o;
my(%opts);
getopts('dN:hH:p:S:T:O:Vx', \%opts);
# ZZZ configure here is you want a default suffix added to your
# plain hostname
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

# RRD update interval must be >= 10 sec, or we move the load too much --ksb
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'} < 10) {
		$opts{'p'} = 10;
	}
	$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;
}
# get hostname: CONFIG for your domain, not  ".fedex.com" and ".sac"
my($host) = hostname();
	$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);
$opts{'N'} ||= $opts{'n'};	# backwards compatibility with old Linix
$host = $opts{'N'} if ($opts{'N'});

my($peghost) = shift(@ARGV);
$peghost ||= $opts{'H'};	# backwards compatible with HPUX
my($pegport);
$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: memstats.pl,v 1.6 2008/11/21 22:23:46 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'}) {
	print "$progname: usage [-dx] [-p delay] [-N node] [-O admin] [-S suffix] [-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 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 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);
}

sub mkUpdate()
{

# RedHat version
	my(%s) = ();
	my($line,$key,$value,$total,$used,$free,$shared,$buffers,$cached,$data,$trash);
	my($softint,$sysload);

	open (FREE, "/usr/bin/free -b|") || die "no free : $!\n";
	while (<FREE>) {
		chomp;
		if ( $_ =~ /^Mem:/ )  {
			($trash,$data) = split(/:/,$_);
			$_ = $data;
			($total,$used,$free,$shared,$buffers,$cached) = split;
			$s{'mem_total'} = $total;
			$s{'mem_used'} = $used;
			$s{'mem_free'} = $free;
			$s{'mem_shared'} = $shared;
			$s{'mem_buffer'}  = $buffers;
			$s{'mem_cache'} = $cached;
		} elsif ( $_ =~ m#\Q-/+ buffers/cache:\E# ) {
			($trash,$data) = split(/:/);
			$_ = $data;
			($used,$free) = split;
			$s{'prog_used'} = $used;
			$s{'prog_free'} = $free;
		} elsif ( $_ =~ /^Swap:/ ) {
			($trash,$data) = split(/:/);
			$_ = $data;
			($total,$used,$free) = split;
			$s{'swap_total'} = $total;
			$s{'swap_used'}  = $used;
			$s{'swap_free'}  = $free;
		}
	}
	close(FREE);
	return "host/$host/app-memory.rrd ".join(':',keys(%s)).' N:'.join(':',values(%s));

}

# Send to peg's rrdd, peg could move over time, so we look up up
my($update,$ipout,$proto,$sockaddr);
$proto = getprotobyname('udp');
socket(SOCKET, PF_INET, SOCK_DGRAM, $proto) ||
	die "socket: inet: $!";
while ($ipout = inet_aton($peghost)) {
	sleep($stall);
	$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);
	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);