Munin contributed plugins

#! /usr/bin/perl

########################################################################

# Copyright (c) 2012, Adrien Urban

# All rights reserved.

#

# Redistribution and use in source and binary forms, with or without

# modification, are permitted provided that the following conditions are

# met:

#

# 1. Redistributions of source code must retain the above copyright

#    notice, this list of conditions and the following disclaimer.

# 2. Redistributions in binary form must reproduce the above copyright

#    notice, this list of conditions and the following disclaimer in the

#    documentation and/or other materials provided with the

#    distribution.

#

# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS

# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT

# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR

# A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT

# OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,

# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT

# LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,

# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY

# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT

# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE

# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

#

########################################################################

#                                                                      #

#    WARNING    WARNING    WARNING    WARNING    WARNING    WARNING    #

#                                                                      #

#       This plugin does not work properly with multiple master        #

#                                                                      #

########################################################################

#

# multigraph, supersampling, detailed interfaces statistics

#

# require: ifconfig

#   linux only for now. Would need to implement way to gather the same

#   data for other ifconfig usage and output.

# require: Time::HiRes

#

# ENV (default):

#  MUNIN_PLUGSTATE  - pid and cache files gets there

#

# ENV (user defined):

#  MUNIN_UPDATERATE - rate at which to update (default: 1s)

#  MUNIN_CACHEFLUSH_RATE - flush data every N batch (default: 1)

#  MUNIN_IFCONFIG - path for ifconfig (default /sbin/ifconfig)

#

#  MUNIN_IF_INCLUDE - list of interfaces to graph (all by default)

#  MUNIN_IF_EXCLUDE - exclude all of those interfaces (none by default)

#  MUNIN_GRAPH_BYTES - do graph bytes per seconds (default: yes)

#  MUNIN_GRAPH_PACKETS - do graph packets per seconds (default: yes)

#  MUNIN_GRAPH_ERRORS - do graph errors (default: yes)

#

# Parent graphs: none

# child graphs: per interface - bytes, packets, errors

#	interfaces/XXX/{bw,pkt,err}

#

# Known bugs:

#

#   Multi-Master

#     If there are many masters, the data is only sent once. Each master will

#     only have part of the data.

#

#   Everlasting

#     The daemon is launched on first config/fetch. A touch of the pidfile is

#     done on every following config/fetch. The daemon should check if the

#     pidfile is recent (configurable) enough, and stop itself if not.

#

#   Graph Order

#     There is currently (2.0.6) noway to order childgraphs.

#

#   RRD file

#     The master currently (2.0.6) generate rrd file for aggregate values, and

#     complains that no data is provided for them (but the graph still works

#     fine)

#

#%# family=auto

#%# capabilities=autoconf

use strict;

use warnings;

use Time::HiRes;

use IO::Handle;

my $plugin = $0;

$plugin =~ s/.*\///;

# quick failsafe

if (!defined $ENV{MUNIN_PLUGSTATE}) {

	die "This plugin should be run via munin. Try munin-run $plugin\n";

}

########################################################################

# If you want to change something, it's probably doable here

#

sub pidfile() { "$ENV{MUNIN_PLUGSTATE}/munin.$plugin.pid" }

sub cachefile() { "$ENV{MUNIN_PLUGSTATE}/munin.$plugin.cache" }

sub graph_name() { "interfaces" }

#sub graph_title() { "interfaces" }

#sub graph_title_all() { "Overall CPU usage" }

#sub graph_title_n($) { "CPU#" . shift . " usage" }

sub acquire_name() { "<$plugin> collecting information" }

# Default update rate. Can be changed by configuration.

my $update_rate = 1;

# default flush interval. Can be changed by configuration.

my $flush_interval = 1;

# default ifconfig command. Can be changed by configuration

my $ifconfig = '/sbin/ifconfig';

########################################################################

# if you need to change something after that line, It should probably be

# changed to be configurable above it.

#

if (defined $ENV{MUNIN_UPDATERATE}) {

	if ($ENV{MUNIN_UPDATERATE} =~ /^[1-9][0-9]*$/) {

		$update_rate = int($ENV{MUNIN_UPDATERATE});

	} else {

		print STDERR "Invalid update_rate: $ENV{MUNIN_UPDATERATE}";

	}

}

if (defined $ENV{MUNIN_CACHEFLUSH_RATE}) {

	if ($ENV{MUNIN_CACHEFLUSH_RATE} =~ /^[0-9]+$/) {

		$flush_interval = int($ENV{MUNIN_CACHEFLUSH_RATE});

	} else {

		print STDERR "Invalid flush rate: $ENV{MUNIN_CACHEFLUSH_RATE}";

	}

}

if (defined $ENV{MUNIN_IFCONFIG}) {

	if (-f $ENV{MUNIN_IFCONFIG}) {

		print STDERR "MUNIN_IFCONFIG: file not found: $ENV{MUNIN_IFCONFIG}";

	} else {

		$ifconfig = defined $ENV{MUNIN_IFCONFIG};

	}

}

my $include_list = undef;

if (defined $ENV{MUNIN_IF_INCLUDE}) {

	$include_list = [ split(/[[:space:]]+/, $ENV{MUNIN_IF_INCLUDE}) ];

	if (0 == scalar (@$include_list)) {

		$include_list = undef;

	} elsif ('' eq $include_list->[0]) {

		shift @$include_list;

	}

}

my $exclude_list = undef;

if (defined $ENV{MUNIN_IF_EXCLUDE}) {

	$exclude_list = [ split(/[[:space:]]+/, $ENV{MUNIN_IF_EXCLUDE}) ];

	if (0 == scalar (@$exclude_list)) {

		$exclude_list = undef;

	} elsif ('' eq $exclude_list->[0]) {

		shift @$exclude_list;

	}

}

sub configbool($) {

	my $str = shift;

	if ($str =~ /^(y(es)?|1|t(rue)?)$/i) {

		return 1;

	}

	if ($str =~ /^(no?|0|f(alse)?)$/i) {

		return 0;

	}

	print STDERR "$str: unrecognized bool\n";

	return 1;

}

my $should_graph = {

	'bytes' => 1,

	'packets' => 1,

	'errors' => 1,

};

if (defined $ENV{MUNIN_GRAPH_BYTES}) {

	$should_graph->{'bytes'} = configbool($ENV{MUNIN_GRAPH_BYTES});

}

if (defined $ENV{MUNIN_GRAPH_PACKETS}) {

	$should_graph->{'packets'} = configbool($ENV{MUNIN_GRAPH_PACKETS});

}

if (defined $ENV{MUNIN_GRAPH_ERRORS}) {

	$should_graph->{'errors'} = configbool($ENV{MUNIN_GRAPH_ERRORS});

}

unless ($should_graph->{bytes} or $should_graph->{packets}

		or $should_graph->{errors}) {

	die "Nothing to graph!";

}

########################################################################

# Base functions, specific to what we really try to do here.

#

sub included_interface($)

{

	my $if = shift;

	if (defined $exclude_list) {

		foreach my $ifl (@$exclude_list) {

			return 0 if ($if =~ /^($ifl)$/);

		}

	}

	if (defined $include_list) {

		foreach my $ifl (@$include_list) {

			return 1 if ($if =~ /^($ifl)$/);

		}

		return 0;

	}

	return 1;

}

sub if_to_name($)

{

	my $if = shift;

	$if =~ s/[^A-Za-z0-9]/_/g;

	return $if;

}

sub get_data()

{

	open IFCONFIG, "-|", $ifconfig or

		die "open: $ifconfig|: $!\n";

	my $data = {};

	my $current_if = undef;

	while (<IFCONFIG>) {

		if (/^([^[:space:]]+)/) {

			$current_if = $1;

			if (!included_interface($current_if)) {

				$current_if = undef;

				next

			}

			$data->{$current_if} = {};

			next; # nothing else on that line

		}

		next if (!defined $current_if);

		if (/RX packets:([0-9]+) errors:([0-9]+) dropped:([0-9]+) overruns:([0-9]+) frame:([0-9]+)/) {

			$data->{$current_if}{'rx_pkt'} = $1;

			$data->{$current_if}{'rx_err'} = $2;

			$data->{$current_if}{'rx_drp'} = $3;

			$data->{$current_if}{'rx_ovr'} = $4;

			$data->{$current_if}{'rx_frm'} = $5;

			next;

		}

		if (/TX packets:([0-9]+) errors:([0-9]+) dropped:([0-9]+) overruns:([0-9]+) carrier:([0-9]+)/) {

			$data->{$current_if}{'tx_pkt'} = $1;

			$data->{$current_if}{'tx_err'} = $2;

			$data->{$current_if}{'tx_drp'} = $3;

			$data->{$current_if}{'tx_ovr'} = $4;

			$data->{$current_if}{'tx_car'} = $5;

			next;

		}

		if (/RX bytes:([0-9]+) \([^)]*\)  TX bytes:([0-9]+) /) {

			$data->{$current_if}{'rx_byt'} = $1;

			$data->{$current_if}{'tx_byt'} = $2;

		}

	}

	close IFCONFIG;

	return $data;

}

# values names, from a data line

sub get_data_names($)

{

	my $line = shift;

	my $name = $line->[0];

	my $count = scalar(@$line) - 2; # 2: name, and timestamp

	if ($name =~ /\.(bps|pkt)$/ and 2 == $count) {

		return [ 'rx', 'tx' ];

	}

	if ($name =~ /\.err$/ and 8 == $count) {

		return [ 'rxerr', 'txerr', 'rxdrp', 'txdrp',

			 'rxovr', 'txovr', 'rxfrm', 'txcar', ];

	}

	# no idea what it is ? corrupted data

	return undef;

}

sub collect_info_once($$)

{

	my $fh = shift;

	my $now = shift;

	my $data = get_data();

	foreach my $if (keys %$data) {

		my $name = if_to_name($if);

		my $d = $data->{$if};

		if ($should_graph->{'bytes'}) {

			print $fh <<EOF;

$name.bps $now $d->{'rx_byt'} $d->{'tx_byt'}

EOF

#$name.byt $now rx $d->{'rx_byt'}

#$name.byt $now tx $d->{'tx_byt'}

		}

		if ($should_graph->{'packets'}) {

			print $fh <<EOF;

$name.pkt $now $d->{'rx_pkt'} $d->{'tx_pkt'}

EOF

#$name.pkt $now rx $d->{'rx_pkt'}

#$name.pkt $now tx $d->{'tx_pkt'}

		}

		if ($should_graph->{'errors'}) {

			print $fh <<EOF;

$name.err $now $d->{'rx_err'} $d->{'tx_err'} $d->{'rx_drp'} $d->{'tx_drp'} $d->{'rx_ovr'} $d->{'tx_ovr'} $d->{'rx_frm'} $d->{'tx_car'}

EOF

#$name.err $now rxerr $d->{'rx_err'}

#$name.err $now txerr $d->{'tx_err'}

#$name.err $now rxdrp $d->{'rx_drp'}

#$name.err $now txdrp $d->{'tx_drp'}

#$name.err $now rxovr $d->{'rx_ovr'}

#$name.err $now txovr $d->{'tx_ovr'}

#$name.err $now rxfrm $d->{'rx_frm'}

#$name.err $now txcar $d->{'tx_car'}

		}

	}

}

sub show_config()

{

	my $data = get_data();

	my $graph_order = "graph_order";

	foreach my $if (sort keys %$data) {

		my $name = if_to_name($if);

		$graph_order .= " ${name}_bps=${name}.bps.tx";

	}

	print <<EOF;

multigraph @{[ graph_name() ]}

graph_category network

graph_title overall bits per seconds

graph_vlabel bits per seconds

update_rate 1

graph_data_size custom 1d, 10s for 1w, 1m for 1t, 5m for 1y

graph_args --base 1000

$graph_order

EOF

	my $style = 'AREA';

	foreach my $if (keys %$data) {

		my $name = if_to_name($if);

		print <<EOF;

${name}_bps.label $if bps out

${name}_bps.draw $style

${name}_bps.cdef ${name}_bps,8,*

EOF

		$style = 'STACK';

	}

	foreach my $if (keys %$data) {

		my $name = if_to_name($if);

		print <<EOF;

multigraph @{[ graph_name() ]}.@{[ if_to_name($if) ]}

graph_title $if traffic

graph_vlabel kbits/s and pkt/s

graph_order bpsrx=bps.rx bpstx=bps.tx pktrx=pkt.rx pkttx=pkt.tx

bpsrx.label $if kbps in

bpsrx.draw AREA

bpsrx.cdef bpsrx,-125,/

bpstx.label $if kbps out

bpstx.draw AREA

bpstx.cdef bpstx,125,*

pktrx.label $if pkt/s in

pktrx.draw LINE1

pktrx.cdef pktrx,-1,*

pkttx.label $if pkt/s out

pkttx.draw LINE1

EOF

#foo.negative bar

		if ($should_graph->{'bytes'}) {

			print <<EOF;

multigraph @{[ graph_name() ]}.@{[ if_to_name($if) ]}.bps

graph_title $if - bits per seconds

graph_vlabel bits per seconds

graph_args --base 1000

graph_scale no

update_rate 1

graph_data_size custom 1d, 10s for 1w, 1m for 1t, 5m for 1y

rx.label bps received

rx.type DERIVE

rx.min 0

rx.cdef rx,8,*

tx.label bps sent

tx.type DERIVE

tx.min 0

tx.cdef tx,8,*

EOF

		}

		if ($should_graph->{'packets'}) {

			print <<EOF;

multigraph @{[ graph_name() ]}.@{[ if_to_name($if) ]}.pkt

graph_title $if - packets per seconds

graph_vlabel packets per seconds

graph_args --base 1000

graph_scale no

update_rate 1

graph_data_size custom 1d, 10s for 1w, 1m for 1t, 5m for 1y

rx.label packets per second received

rx.type DERIVE

rx.min 0

tx.label packets per second sent

tx.type DERIVE

tx.min 0

EOF

		}

		if ($should_graph->{'errors'}) {

			print <<EOF;

multigraph @{[ graph_name() ]}.@{[ if_to_name($if) ]}.err

graph_title $if - errors

graph_vlabel errors

graph_scale no

update_rate 1

graph_data_size custom 1d, 10s for 1w, 1m for 1t, 5m for 1y

graph_order rxerr txerr rxdrp txdrp rxovr txovr rxfrm txcar

rxerr.label errors per second (in)

rxerr.type DERIVE

rxerr.min 0

txerr.label errors per second (out)

txerr.type DERIVE

txerr.min 0

rxdrp.label drop per second (in)

rxdrp.type DERIVE

rxdrp.min 0

txdrp.label drop per second (out)

txdrp.type DERIVE

txdrp.min 0

rxovr.label overruns per second (in)

rxovr.type DERIVE

rxovr.min 0

txovr.label overruns per second (out)

txovr.type DERIVE

txovr.min 0

rxfrm.label frame per second (in)

rxfrm.type DERIVE

rxfrm.min 0

txcar.label carrier per second (out)

txcar.type DERIVE

txcar.min 0

EOF

		}

	}

}

sub check_req()

{

	my $data = get_data();

	if (0 != scalar(keys %$data)) {

		return 1;

	}

	return 0;

}

########################################################################

# beyond that line, it should be generic stuffs, not dependent on what

# you are trying to graph

#

sub check_running() {

	if (-f pidfile()) {

		my $pid = undef;

		if (open FILE, "<", pidfile()) {

			$pid = <FILE>;

			close FILE;

			chomp $pid;

		}

		if ($pid) {

			# does not exist ? kill it

			if (kill 0, $pid) {

				return 1;

			}

		}

 		unlink(pidfile());

	}

	return 0;

}

# FIXME: should also trap kill sigint and sigterm

# FIXME: check pidfile got touched recently

sub collect_loop() {

	$0 = acquire_name();

	$0 = "<$plugin> collecting information";

	# write our pid

	open PIDFILE, '>', pidfile() or die "open: @{[ pidfile() ]}: $!\n";

	print PIDFILE $$, "\n";

	close PIDFILE;

	# open cache

	my $fh_cache;

	open $fh_cache, ">>", cachefile() or

			die "open: @{[ cachefile() ]}: $!\n";

	my @tick = Time::HiRes::gettimeofday();

	my $flush_count = 0;

	while (1) {

		collect_info_once($fh_cache, $tick[0]);

		if ($flush_interval) {

			if ($flush_interval == ++$flush_count) {

				$fh_cache->flush();

				$flush_count = 0;

			}

		}

		my @now = Time::HiRes::gettimeofday();

		# when should the next tick be ?

		$tick[0] += $update_rate;

		# how long until next tick ?

		my $diff = ($tick[0] - $now[0]) * 1000000

				+ $tick[1] - $now[1];

		if ($diff <= 0) {

			# next tick already passed ? damn!

			@tick = @now;

		} else {

			# sleep what remains

			Time::HiRes::usleep($diff);

		}

	}

	unlink(pidfile());

	unlink(cachefile());

}

# launch daemon if not running

# notify the daemon we still need it (touch its pid)

sub daemon_alive() {

	if (check_running()) {

		my $atime;

		my $mtime;

		$atime = $mtime = time;

		utime $atime, $mtime, pidfile();

	} else {

		if (0 == fork()) {

			close(STDIN);

			close(STDOUT);

			close(STDERR);

			open STDIN, "<", "/dev/null";

			open STDOUT, ">", "/dev/null";

			open STDERR, ">", "/dev/null";

			collect_loop();

			exit(0);

		}

	}

}

sub run_autoconf() {

	if (check_req()) {

		print "yes\n";

	} else {

		print "no\n";

	}

}

sub run_config() {

	daemon_alive();

	show_config();

}

sub fetch_showline($) {

	my $line = shift;

	my $names = get_data_names($line);

	# don't display anything if we don't like what it is

	return unless (defined $names);

	my $graph = shift @$line;

	my $time = shift @$line;

	foreach my $value (@$line) {

		my $name = shift @$names;

		print <<EOF;

$name.value $time:$value

EOF

	}

}

sub run_fetch() {

	daemon_alive();

	if (open CACHE, "+<", cachefile()) {

		my $data = {};

		while (<CACHE>) {

			chomp;

			my $field = [];

			@$field = split(/ /);

			if (not defined $data->{$field->[0]}) {

				$data->{$field->[0]} = [];

			}

			push @{$data->{$field->[0]}}, $field;

		}

		# finished reading ? truncate it right away

		truncate CACHE, 0;

		close CACHE;

		foreach my $graph (keys %$data) {

			print <<EOF;

multigraph @{[ graph_name() ]}.$graph

EOF

			foreach my $line (@{$data->{$graph}}) {

				fetch_showline($line);

			}

		}

	}

}

my $cmd = 'fetch';

if (defined $ARGV[0]) {

	$cmd = $ARGV[0];

}

if ('fetch' eq $cmd) {

	run_fetch();

} elsif ('config' eq $cmd) {

	run_config();

} elsif ('autoconf' eq $cmd) {

	run_autoconf();

} elsif ('daemon' eq $cmd) {

	run_daemon();

} else {

	print STDERR <<EOF;

$0: unrecognized command

Usage:

	$0 autoconf - check if we have everything we need

	$0 config - show plugin configuration

	$0 fetch - fetch latest data

	$0 daemon - launch daemon

EOF

	exit(1);

}

exit(0);