#! @@PERL@@
# -*- cperl -*-
#
# Copyright (C) 2010 Steve Schnepp
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; version 2 dated June,
# 1991.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
#
# $Id$

use strict;
use warnings;

use IO::Socket;
use IO::File;
use File::Path qw(mkpath);
use Getopt::Long;
use Pod::Usage;

use List::Util qw(min max);

use Munin::Node::SpoolWriter;

my $host = "localhost:4949";
my $metahostname;
my $SPOOLDIR = "@@SPOOLDIR@@";
my $intervalsize = 86400;
my $timeout = 3600;
my $minrate = 300;
my $retaincount = 7;
my $nocleanup;
my $do_fork;
my $verbose;
my $debug;
my $help;


GetOptions(
	"host=s" => \$host,
	"spooldir|s=s" => \$SPOOLDIR,
	"interval|i=i" => \$intervalsize,
	"timeout=i" => \$timeout,
	"minrate=i" => \$minrate,
	"retain|r=i" => \$retaincount,

	"fork" => \$do_fork,

	"help|h" => \$help,
	"verbose|v" => \$verbose,
	"nocleanup|n" => \$nocleanup,
	"debug" => \$debug,
) or pod2usage(1);
if ($help) {
	pod2usage(1);
}

# Debug implies Verbose
$verbose = 1 if $debug;

unless (-d $SPOOLDIR) {
	mkpath($SPOOLDIR, { verbose => $verbose, } ) 
		or die ("Cannot create '$SPOOLDIR': $!");
}

my $sock = new IO::Socket::INET(
	PeerAddr        => "$host",
	Proto   => 'tcp'
) || die "Error creating socket: $!";
my $nodeheader = <$sock>;
print $sock "quit\n";
close ($sock);
( $metahostname ) = ( $nodeheader =~ /munin node at (\S+)\n/);
$metahostname = "unknown" unless $metahostname;

my $spoolwriter = Munin::Node::SpoolWriter->new(
	spooldir => $SPOOLDIR,
	interval_size => $intervalsize,
	interval_keep => $retaincount,
	hostname  => $metahostname,
);
$0 = "munin-asyncd [$metahostname] [idle]";

my $process_name = "main";

my $plugin_rate_filename = "$SPOOLDIR/plugin_rates";

my @plugins;
{
	print STDERR "[$$][$process_name] Reading config from $host\n" if $verbose;
	my $sock = new IO::Socket::INET( 
		PeerAddr	=> "$host", 
		Proto	=> 'tcp'
	) || die "Error creating socket: $!"; 

	local $0 = "munin-asyncd [$metahostname] [list]";
	print STDERR "[sock][>] cap multigraph\n" if $debug;
	print $sock "cap multigraph\n";
	print STDERR "[sock][>] list\n" if $debug;
	print $sock "list\n";
	<$sock>; # Read the first header comment line
	<$sock>; # Read the multigraph response line
	my $plugins_line = <$sock>;
	chomp($plugins_line);

	{
		my $fh_list = IO::File->new(
			"$SPOOLDIR/munin-daemon.list",
			"w",
		);

		print $fh_list $plugins_line;
		print $fh_list "\n";
	}

	@plugins = split(/ /, $plugins_line);
}

my $keepgoing = 1;

sub termhandler() {
	$keepgoing = 0;
}

# Q&D child collection
$SIG{CHLD} = 'IGNORE';
$SIG{HUP} = 'IGNORE';
$SIG{INT} = 'termhandler';
$SIG{TERM} = 'termhandler';

# now, update regularly...
# ... but each plugin in its own process to avoid delay-leaking
my %last_updated;
my $last_cleanup=0;
MAIN: while($keepgoing) {
	my $when = time;

	my $when_next = $when + $timeout; # wake up at least every $timeout sec
	my $sock;
	PLUGIN: foreach my $plugin (@plugins) {
		# See if this plugin should be updated
		my $plugin_rate = get_hash($plugin, $plugin_rate_filename) || 300;
		if ($when < ($last_updated{$plugin} || 0) + $plugin_rate) {
			# not yet, next plugin
			next;
		}

		# Should update it
		$last_updated{$plugin} = $when;
		$when_next = min($when_next, $when + max($plugin_rate, $minrate));

		if ($do_fork && fork()) {
			# parent, return directly
			next PLUGIN;
		}

		unless ($sock) {
			$sock = new IO::Socket::INET(
				PeerAddr	=> "$host",
				Proto	=> 'tcp'
			);

			unless ($sock) {
				warn "Error creating socket: $!, moving to next plugin to try again";
				next;
			}

			<$sock>; # skip header
		}


		# Setting the command name for a useful top information
		$process_name = "plugin:$plugin";
		local $0 = "munin-asyncd [$metahostname] [$process_name]";

		fetch_data($plugin, $when, $sock);

		# We end here if we forked
		last MAIN if $do_fork;
	}

	print STDERR "[$$][$process_name][>] quit\n" if $verbose;
	print $sock "quit\n" if $sock;

	print STDERR "[$$][$process_name] closing sock\n" if $verbose;
	$sock = undef;

	$spoolwriter->set_metadata("lastruntime", $when);

	# Clean spool dir
	if (!$nocleanup && $last_cleanup<(time - 600)) {
		$last_cleanup = time;
		$spoolwriter->cleanup();
	}

	# Sleep until next plugin exec.
	my $sleep_sec = $when_next - time;

	if ($sleep_sec > 0) {
		print STDERR "[$$][$process_name] Sleeping $sleep_sec sec\n" if $verbose;
		sleep $sleep_sec;
	} else {
		print STDERR "[$$][$process_name] Already late : should sleep $sleep_sec sec\n" if $verbose;
	}
}
		
print STDERR "[$$][$process_name] Exiting\n" if $verbose;

sub fetch_data
{
	my $plugin = shift;
	my $when = shift;
	my $sock = shift;

		print STDERR "[$$][$process_name][>][$plugin] asking for config\n" if $verbose;

		print STDERR "[sock][>][$plugin] config $plugin\n" if $debug;
		print $sock "config $plugin\n";

		my $output_rows = [];

		while(my $line = <$sock>) {
			chomp($line);
			print STDERR "[sock][<][$plugin] $line\n" if $debug;

			if ($line =~ m/^\./) {
				# Starting with . => end
				last;
			}

			push @$output_rows, $line;
			if ($line =~ m/^update_rate (\d+)/) {
				# The plugin has a special update_rate: overriding it
				# XXX - Doesn't take into account a per field update_rate

				# This has to be sent back to the master
				set_hash($plugin, $1, $plugin_rate_filename);
			}
		}

		print STDERR "[$$][$process_name][>][$plugin] asking for data\n" if $verbose;
		print STDERR "[sock][>][$plugin] fetch $plugin\n" if $debug;
		print $sock "fetch $plugin\n";

		while(my $line = <$sock>) {
			chomp($line);
			print STDERR "[sock][<][$plugin] $line\n" if $debug;

			if ($line =~ m/^\./) {
				# Starting with . => end
				last;
			}

			# Save the line
			push @$output_rows, $line;
		}

		# Write the whole load into the spool
		$spoolwriter->write($when, $plugin, $output_rows);
}

sub get_hash
{
	my ($key, $filename) = @_;
	my %hash;

	use Fcntl;   # For O_RDWR, O_CREAT, etc.
	use DB_File;
	tie (%hash, 'DB_File', $filename, O_RDWR|O_CREAT, 0666) 
		or die "$!";
	my $value = $hash{$key};
	untie(%hash);

	return $value;
}

sub set_hash
{
	my ($key, $value, $filename) = @_;
	my %hash;

	use Fcntl;   # For O_RDWR, O_CREAT, etc.
	use DB_File;
	tie (%hash, 'DB_File', $filename, O_RDWR|O_CREAT, 0666) 
		or die "$!";
	$hash{$key} = $value;
	untie(%hash);
}



__END__

=head1 NAME

munin-asyncd - A program to spool munin-node calls

=head1 SYNOPSIS

munin-asyncd [options]

 Options:
     --host <hostname:port>     Connect to this munin-node [localhost:4949]
     -s --spool <spooldir>      Store the spooled data in this dir [/var/lib/munin-async]
     -i --interval <seconds>    Override default interval size of one day [86400]
        --timeout <seconds>     Wake up at least this number of seconds. [3600]
        --minrate <seconds>     This is the minimal rate you want to poll a node [300]
     -r --retain <count>        Specify number of interval files to retain [7]
     -n --nocleanup             Disable automated spool dir cleanup

        --fork                  Do fork
     -v --verbose               Be verbose
     -h --help                  View this message	
