#! /usr/bin/perl
# Munin node that presents as many virtual hosts, plugins & fields
# as needed to be able to:
# - emulate a HUGE network to stress the munin-master server
# - serve as a basis for protocol debugging
#
# Copyright (C) 2010 Steve Schnepp
#
# License: GPLv2

use strict;
use warnings;

use IO::Socket;
use IO::Select;
use Getopt::Long;

# No buffering
$| = 1;

my $nb_servers = 3;
my $nb_servers_per_port = 1;
my $nb_plugins = 30;
my $fields_per_plugin = 5;
my $starting_port = 24949;
my $spoolfetch;
my $starting_epoch = -3600; # 1 hour from now
my $dump_config;
my $is_debug;
my $is_fun;
my $help;
my $update_rate = 10;
my $spoolfetch_rate = 5;
my $listen = "localhost";

my %services;

my $arg_ret = GetOptions(
	"nb-plugins|n=i" => \$nb_plugins,
	"nb-fields|f=i" => \$fields_per_plugin,
	"nb-servers|s=i" => \$nb_servers,
	"nb-servers-port|v=i" => \$nb_servers_per_port,
	"update-rate=i" => \$update_rate,

	"startint-port|p=i" => \$starting_port,

	"listen=s" => \$listen,

	"update-rate=i" => \$update_rate,
	"spoolfetch" => \$spoolfetch,
	"spoolfetch-rate=i" => \$spoolfetch_rate,
	"starting-epoch=i" => \$starting_epoch,

	"dump|d" => \$dump_config,
	"help|h" => \$help,
	"debug" => \$is_debug,

	"fun" => \$is_fun,
);

if ($help) {
	print qq{Usage: $0 [options]

Options:
    --help                   View this message.

    -s --nb-servers <int>      Number of servers [3]
    -v --nb-servers-port <int> Number of virtual servers per port [1]
    -p --start-port <int>      Starting TCP listening port [24949]

    -n --nb-plugins <int>     Number of plugins per server [30]
    -f --nb-fields  <int>     Number of fields per plugins [5]
    --update-rate <int>       Update rate of plugins (in seconds) [10]

       --listen    <host>     Which IP to bind [localhost].
                              Use '' or '*' to bind to every interface.

    --spoolfetch              Be spoolfetch capable
    --starting-epoch          Starting epoch: no data will available before.
                               Can be relative to now if negative [-3600]

    -d --dump                 Only dump a generated munin.conf part [no]
       --debug                Print debug information [no]

};
	exit 0;
}

my $fun_names = {};
init_fun_names();

# Convert relatives starting_epoch to absolute
$starting_epoch = time + $starting_epoch if ($starting_epoch < 0);

if ($dump_config) {
	for (my $i = 0; $i < $nb_servers; $i++) {
		my $port = $starting_port + $i;
		for (my $p = 0; $p < $nb_servers_per_port; $p++) {
			my $hostname = get_hostname($i, $p);
			my $group = get_group($i, $p);
			print "[$group;$hostname]\n";
			print "     address 127.0.0.1\n";
			print "     port $port\n";
			print "\n";
		}
	}

	# Only dump config
	exit;
}

# start the servers
my @servers;
for (my $i = 0; $i < $nb_servers; $i ++) {
	my $port = $starting_port + $i;
	# LocalAddr == * doesn't work, it has to be empty
	my $localaddr = ($listen eq '*') ? '' : $listen;
	debug("starting server on port $listen:$port");
	my $server = IO::Socket::INET->new(
		"LocalPort" => $port,
		"LocalAddr" => $localaddr,
		"Listen" => 5,
		"ReuseAddr" => 1,
		"Proto" => "tcp",
	) or die($!);

	push @servers, $server;
}

# Ignoring SIG_CHILD
debug("Ignoring SIG_CHILD");
$SIG{CHLD} = 'IGNORE';

# Init the plugin names
for (my $i = 0; $i < $nb_plugins; $i ++) {
	my $service = get_service($i);

	# Save the number to retrieve it later, since
	# it's no longer encoded in the plugin name
	$services{$service} = $i;
}

my $select = IO::Select->new(@servers);
while (my @ready = $select->can_read()) {
	foreach my $ready_fh (@ready) {
		my $client = $ready_fh->accept();
		if (! fork()) {
			debug("[$$] Serving new client");
			service($client);
			# Exit the child
			debug("[$$] Finished");
			exit;
		}
	}
}

sub service
{
	my $client = shift;
	my $sockport = $client->sockport();
	debug("[$$] client connected on $sockport");

	my $hostname = get_hostname($sockport);

	print $client "# munin node at $hostname\n";

	while (my $line = <$client>) {
		chomp($line);
		debug("[$$] client of $hostname asked : $line");
		if ($line =~ m/^list$/ || $line =~ m/^list /) {
			for (my $i = 0; $i < $nb_plugins; $i ++) {
				my $service = get_service($i);
				print $client "$service ";
			}
			print $client "\n";
		} elsif ($line =~ m/^cap (\w+)/) {
			my @caps = "multigraph";
			push @caps, "spool" if $spoolfetch;
			print $client "cap @caps\n";
		} elsif ($line =~ m/^config (\w+)/) {
			my $plugin_number = get_plugin_number($1);
			my $plugin_name = get_service($plugin_number);
			debug("[$$] plugin asked:$1, number:$plugin_number, name:$plugin_name");
			print $client "graph_title " . get_service_title($plugin_number) . "\n";
			print $client "graph_category " . get_service_category($plugin_number) . "\n";

			print $client "update_rate $update_rate";
			if ($plugin_number % 4 == 1) {
				print $client " aligned";
			} elsif ($plugin_number % 4 == 2) {
				print $client " garbled";
			}
			print $client "\n";

			my $graph_data_size = "debug";
			$graph_data_size = "normal" if $plugin_number == 0;
			$graph_data_size = "custom 10,10 5,10 10" if $plugin_number == 1;
			$graph_data_size = "custom 10,10 for 5, 5m for 1d" if $plugin_number == 2;
			$graph_data_size = "huge" if $plugin_number == 3;
			for (my $i = 0; $i < $fields_per_plugin; $i ++) {
				my $ds = get_ds($plugin_number, $i);
				my $ds_info = get_ds_info($plugin_number, $i);
				print $client "$ds.label $ds_info\n";
				my @PLUGIN_TYPES = qw/
					GAUGE
					DERIVE
					ABSOLUTE
				/;
				my $plugin_type = $PLUGIN_TYPES[($i + $plugin_number) % 3];

				print $client "$ds.graph_data_size $graph_data_size\n" if $graph_data_size;
				print $client "$ds.type $plugin_type\n";
			}
			print $client ".\n";
		} elsif ($line =~ m/^fetch (\w+)/) {
			my $plugin_number = get_plugin_number($1);
			for (my $i = 0; $i < $fields_per_plugin; $i ++) {
				my $value = sin( (time / 3600) * $plugin_number + $i) * (4 ** $plugin_number);

				$value = int($value * 1024) if ($plugin_number + $i) % 3;
				print $client get_ds($plugin_number, $i) . ".value $value\n";
			}
			print $client ".\n";
		} elsif ($line =~ m/^spoolfetch (\d+)/) {
			my $timestamp = $1;
			print "asked $timestamp, " if $is_debug;
			my $now = time;

			# Cannot start before $starting_epoch
			$timestamp = $starting_epoch if ($timestamp < $starting_epoch);
			print "starting at $starting_epoch\n" if $is_debug;

			# Only send something every $spoolfetch_rate * $update_rate
			if ( $timestamp > $now - $spoolfetch_rate * $update_rate) {
				goto END_SPOOL_CMD;
			}

			# Sends spools strictly > LastSpooled
			for (my $epoch = ($timestamp - $timestamp % $update_rate + $update_rate);
				$epoch < time; $epoch += $update_rate) {
			for (my $plugin_number = 0; $plugin_number < $nb_plugins; $plugin_number ++) {
				my $plugin_name = get_service($plugin_number);
				print $client "multigraph $plugin_name\n";
				print $client "graph_title " . get_service_title($plugin_number) . "\n";
				print $client "update_rate $update_rate\n";
				for (my $i = 0; $i < $fields_per_plugin; $i ++) {
					my $ds = get_ds($plugin_number, $i);
					my $ds_info = get_ds_info($plugin_name, $i);
					print $client "$ds.label field $ds_info\n";
					print $client "$ds.type GAUGE\n";

					my $value = sin( ($epoch / 3600) * $plugin_number + $i);
					print $client "$ds.value $epoch:$value\n";
				}
			}
		}
	END_SPOOL_CMD:
			print $client ".\n";
		} elsif ($line =~ m/^quit/) {
			return;
		} elsif ($line =~ m/^nodes/) {
			print "asked nodes:" if $is_debug;
			for (my $p = 0; $p < $nb_servers_per_port; $p++) {
				my $vhost = get_hostname($sockport, $p);
				print $client "$vhost ";
				print " $vhost" if $is_debug;
			}
			print $client "\n";
			print "\n" if $is_debug;
		} else {
			print $client "# Command not found\n";
		}
	}
}

sub get_plugin_number
{
	my $plugin_name = shift;
	$plugin_name =~ s/^(\s+)//;
	$plugin_name =~ s/(\s+)$//;
	my $plugin_number = $services{$plugin_name} || 0;
	return ($plugin_number+0);
}

sub debug
{
	print join(" ", @_) . "\n" if $is_debug;
}

sub _get_from_array
{
	my ($i, $ary, $is_unique) = @_;

	my $offset_id = ($is_unique) ? int($i / scalar @$ary) : 0;
	my $offset = ($offset_id) ? "$offset_id" : "";
	my $name = $ary->[$i % scalar @$ary] . $offset;

	return $name;
}

sub get_hostname
{
	my ($i, $j) = @_;

	my @gods = sort keys( %{ $fun_names->{gods} } );
	my @worlds = sort keys( %{ $fun_names->{worlds} } );
	my @groups = sort keys( %{ $fun_names->{groups} } );


	my $hostname = _get_from_array($i, \@gods, 1);

	# prefix with the virtual node part
	$hostname = "v$j-$hostname" if $j;

	my $world = _get_from_array($i, \@worlds, 0);
	my $group = _get_from_array($i, \@groups, 0);


	return "$hostname.$world.$group";
}

sub get_group
{
	my ($i, $j) = @_;

	my @gods = sort keys( %{ $fun_names->{gods} } );
	my @worlds = sort keys( %{ $fun_names->{worlds} } );
	my @groups = sort keys( %{ $fun_names->{groups} } );


	my $world = _get_from_array($i, \@worlds, 0);
	my $group = _get_from_array($i, \@groups, 0);

	return "$group;$world.$group";
}

sub get_category
{
	return "other";
}

sub get_service
{
	my ($plugin_number) = @_;

	my @giants = sort keys( %{ $fun_names->{giants} } );
	my $giant = _get_from_array($plugin_number, \@giants, 1);

	return $giant;
}

sub get_service_title
{
	my ($plugin_number)= @_;

	my @giants = sort keys( %{ $fun_names->{giants} } );
	my $giant = _get_from_array($plugin_number, \@giants, 0);

	return $giant . " : " . $fun_names->{giants}->{$giant};
}

sub get_service_category
{
	my ($plugin_number)= @_;

	my @locations = sort keys( %{ $fun_names->{locations} } );
	my $location = _get_from_array($plugin_number, \@locations, 0);

	return $location;
}

sub get_ds
{
	my ($plugin_number, $i) = @_;

	my @weapons = sort keys( %{ $fun_names->{weapons} } );
	my $weapon = _get_from_array($i, \@weapons, 1);

	return $weapon;
}

sub get_ds_info
{
	my ($plugin_name, $i) = @_;
	my @weapons = sort keys( %{ $fun_names->{weapons} } );
	my $weapon = _get_from_array($i, \@weapons, 0);

	return $fun_names->{weapons}->{$weapon};
}

sub init_fun_names
{
	my $fun_key = "";
	while (<DATA>) {
		next unless m/\S/; # Empty line

		# Header contains the key
		if ( m/# *(.*)/ ) {
			$fun_key = lc($1);
			next;
		}

		my ($key, $value) = split(/\s+/, $_, 2);
		$key = lc($key);
		$fun_names->{$fun_key}->{$key} = $value;
	}
}

__END__

# Worlds
Alfheim		World of the Light Elves
Asgard		World of the Aesir, the warrior gods. The gods built their halls here.
Jotunheim	World of the Giants.
Midgard		Middle World, land of men.
Muspellheim	World of fire, the first world.
Nifleim		World of the dead.
Nidavellir	World of the Dwarfs
Svartalfheim	World of the Dark Elves
Vanaheim	World of Vanir

# Locations
Gladsheim	the hall of the gods in asgard
Godheim		another name for asgard
Utgard		Hall of the giants
Valhalla	Hall of the slain
Vanaheim	Home of the vanir, located in asgard
Bifrost		The Bridge between Asgard and Midgard

# Groups
Aesir		The primary race of the norse gods. They lived in Asgard.
Asynjur		The group of Norse goddesses belonging to the Aesir
Svartalfar	The black elves
Valkyries	Choosers of the Slain, beautiful females upon winged horses.
Vanir		A group of gods and goddesses.

# Gods
Aegir		god of the sea
Alaisiagae	Noric War Goddess
Astrild		goddess of love
Atla		Water goddess
Balder		god of beauty
Bragi		god of eloquence
Eastre		saxon goddess resurrection of nature
Eir		goddess of healing
Elli		goddess of old age
Forseti		god of meditation
Freya		a goddess of fertility and love
Freyr		god of sun and rain
Frigg		a goddess of love and fertility
Gefion		a fertility goddess
Heimdall	god of light, guards bifrost
Hodur		god of darkness
Holler		god of death and destruction
Idun		goddess of eternal youth
Laga		goddess of wells and springs
Lofn		goddess of illicit love
Loki		god of fire (trickster)
Niord		god of Summer
Njord		god of winds, sea and fire
Odin		All other gods are descendants of Odin
Ran		goddess of storms
Saga		goddess of poetry and history
Skadi		goddess of winter and hunting
Snotra		goddess of virtue and master of all knowedge
Syn		goddess that guarded the door of frigg's palace
Thor		god (ruler) of the sky and thunder
Tyr		god of war
Ull		god of justice and dueling
Uller		god of winter
Vali		sole purpose is to vengeance upon Loki for Balder's death
Var		a goddess of marriage
Vidar		god of silence and revenge
Vili		hall of vidar located in asgard
Vidar		only god to survive Ragnarok. Avenges Odin's death

# Giants
Geirrod		frost giant
Gerd		beautiful giant, an earth goddess
Hymir		Sea giant
Jormungand	serpent giant
Mjollnir	norse giant father of Sol and Mani (sun and moon)
Surt		fire giant, destroys the world during ragnarok
Thiazi		giant
Ymir		primordial giant, creator of the frost giants
Load		Will be used for sparklines

# Weapons
Balmung		Odin's sword
Mjollnir	the hammer of Thor
Gungnir		Spear of Odin

# Credits for the names to http://namingschemes.com/Norse_Mythology
