#!/usr/bin/perl -w
# -*- perl -*-
#
# Copyright (C) 2003-2006 Jimmy Olsen, Nicolai Langfeldt.
#
# 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., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
#
# Program to suggest what plugins to use and not

$| = 1; # Flush after every write to stdout

use strict;
use Getopt::Long;
# use Data::Dumper;

# plugins run in taint mode because the uid is changed, so the path
# must not contain writable directories.
$ENV{PATH}='/bin:/sbin:/usr/bin:/usr/sbin:/usr/local/bin:/usr/local/sbin';

my $version    = "1.2.6";
my $config     = "/etc/munin/munin-node.conf";
my $servicedir = "/etc/munin/plugins";
my $libdir     = "/usr/local/libexec/munin/plugins";
my $bindir     = "/usr/local/sbin";
my $installed  = undef;
my $plugins    = undef;
my $debug      = 0;
my $suggest    = 0;
my $shell      = 0;
my @afamilies  = ("auto", "manual", "contrib");
my @dfamilies  = ("auto");
my @families   = ();
my @snmp       = ();
my $snmpver    = undef;
my $snmpcomm   = undef;
my $removes    = 0;
my $do_usage   = 0;
my $do_error   = 0;
my $do_version = 0;
my $newer      = undef;
my $debugopt   = '--debug'; # Pass --debug to children or not
my @errors     = ();

$do_error = 1 unless GetOptions (
	"help"            => \$do_usage,
	"shell!"          => \$shell,
	"debug!"          => \$debug,
	"suggest!"        => \$suggest,
	"config=s"        => \$config,
	"servicedir=s"    => \$servicedir,
	"remove-also!"    => \$removes,
	"libdir=s"        => \$libdir,
	"families=s"      => \@families,
	"version!"        => \$do_version,
	"snmp=s"          => \@snmp,
	"snmpversion=s"   => \$snmpver,
	"snmpcommunity=s" => \$snmpcomm,
	"newer=s"         => \$newer
);

if ($do_error or $do_usage)
{
	print "Usage: $0 [options]
	
Options:
	--help			View this help page
	--version		Show version information
	--debug			View debug information (very verbose)
	--config <file>		Override configuration file 
	                        [$config]
	--servicedir <dir>	Override plugin dir [$servicedir]
	--libdir <dir>		Override plugin lib [$libdir]
	--families <family,...>	Override families (", join(',',@afamilies),") [",join(',',@dfamilies),"]
	--suggest		Show suggestions instead of status
	--shell			Show shell commands (implies --suggest)
	--remove-also		Also show rm-commands when doing --shell
	--newer <version>	Only show suggestions related to plugins newer
	                        than version <version>. [0.0.0]
	--snmp <host|cidr>      Do SNMP probing on the host or CIDR network.
	--snmpversion <ver>     Set SNMP version (1, 2c or 3) [2c]
	--snmpcommunity <comm>  Set SNMP community [public]

By default this program shows which plugins are activated on the
system.  If you specify --suggest it will present a table of plugins
that will probably work (according to the plugins autoconf command).
If you specify --shell shell commands to install those same plugins
will be printed.  These can be reviewed or piped directly into a shell
to install the plugins.

";

	exit ($do_error); # 1 if error, 0 if --help
}

if ($do_version)
{
    print <<"EOT";
munin-node-configure (munin-node) version $version.
Written by Jimmy Olsen

Copyright (C) 2003-2006 Jimmy Olsen

This is free software released under the GNU General Public License. There
is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR
PURPOSE. For details, please refer to the file COPYING that is included
with this software or refer to
  http://www.fsf.org/licensing/licenses/gpl.txt
EOT
    exit 0;
}

if (defined $newer and (!$shell or $removes))
{
    print STDERR "Fatal: --newer only supported along with --shell.\n";
    exit 2;
}

if (!@families)
{
    if (@snmp)
    {
	@families = ();
	$shell=1;
    }
    elsif ($suggest or $shell)
    {
	@families = @dfamilies;
    }
    else
    {
	@families = @afamilies;
    }
}

# Normalize input in case it was taken from commandline?
# This seems like a noop no matter what went before.
# @families = split (/,/, join (',', @families));
# @snmp = split (/,/, join (',', @snmp));

if (@snmp and !$shell)
{
    print STDERR "Fatal: --snmp only supported along with --shell.\n";
    exit 3;
}

if (@families)
{
    $plugins   = &get_plugins   ($plugins  , $libdir);
    $installed = &get_installed ($installed, $servicedir);

    if (! $shell and $suggest)
    {
	&normal ("Plugin", "Used", "Suggestions");
	&normal ("------", "----", "-----------");
    }
    elsif (! $shell)
    {
	&normal ("Plugin", "Used", "Extra information");
	&normal ("------", "----", "-----------------");
    }

    foreach my $plug (sort keys %{$plugins})
    {
#	print "New plugin: ", Dumper $plugins->{$plug},"\n";

	next unless defined $plugins->{$plug}->{'family'};
	next unless (grep (/^$plugins->{$plug}->{'family'}$/, @families));

	my $now   = (exists $installed->{$plug}?"yes":"no");
	my $want  = (exists $plugins->{$plug}->{'default'}?$plugins->{$plug}->{'default'}:"no");
	my $snow  = (exists $installed->{$plug}->{'suggest'}?$installed->{$plug}->{'suggest'}:undef);
	my $swant = (exists $plugins->{$plug}->{'suggest'}?$plugins->{$plug}->{'suggest'}:undef);
	my $sugg  = "";


	if ($shell)
	{
	    if ($plug =~ /_$/) # Wildcard plugin...
	    {
		if ($now eq "yes" and $want eq "no")
		{
		    if ($snow and @{$snow})
		    {
			foreach my $wild (sort @{$snow})
			{
			    &link_remove ("$plug$wild");
			}
		    }
		}
		else
		{
		    if ($snow and @{$snow})
		    {
			foreach my $wild (sort @{$snow})
			{
			    if (! grep (/^$wild$/, @{$swant}))
			    {
				&link_remove ("$plug$wild");
			    }
			}
		    }
		    if ($swant and @{$swant})
		    {
			foreach my $wild (sort @{$swant})
			{
			    next if -e "$servicedir/$plug"."_".$wild; # None of our business...
			    if (! grep (/^$wild$/, @{$snow}))
			    {
				&link_add ($plug, $wild);
			    }
			}
		    }
		}
	    }
	    else
	    {
		if ($now eq "yes" and $want eq "no")
		{
		    &link_remove ($plug);
		}
		elsif ($now eq "no" and $want eq "yes")
		{
		    next if -e "$servicedir/$plug"; # None of our business...
		    &link_add ($plug);
		}
	    }
	}
	elsif ($suggest)
	{
	    if ($plug =~ /_$/) # Wildcard plugin...
	    {
		if ($now eq "yes" && $want eq "no" or
			$now eq "no" && $want eq "yes" && $swant && @{$swant})
		{
		    $sugg = "$want ";
		}
		if ($snow and @{$snow})
		{
		    foreach my $wild (sort @{$snow})
		    {
			if (! grep (/^$wild$/, @{$swant}))
			{
			    $sugg .= "-$wild ";
			}
		    }
		}
		if ($swant and @{$swant})
		{
		    foreach my $wild (sort @{$swant})
		    {
			next if -e "$servicedir/$plug"."_".$wild; # None of our business...
			if (! grep (/^$wild$/, @{$snow}))
			{
			    $sugg .= "+$wild ";
			}
		    }
		}
		&normal ($plug, $now, $sugg);
	    }
	    else
	    {
		next if -e "$servicedir/$plug"; # None of our business...
		if ($now ne $want)
		{
		    $sugg = $want;
		}
		elsif (defined $plugins->{$plug}->{'defaultreason'} and
			$plugins->{$plug}->{'defaultreason'} =~ /^[^\(]*\((.+)\)\s*$/)
		{
		    $sugg = "[$1]";
		}

		&normal ($plug, $now, $sugg);
	    }
	}
	else
	{
	    if ($plug =~ /_$/) # Wildcard plugin...
	    {
		if ($snow and @{$snow})
		{
		    $sugg = join ' ', @{$snow};
		}
		&normal ($plug, $now, $sugg);
	    }
	    else
	    {
		&normal ($plug, $now, "");
	    }
	}
    }
}


if (@snmp and $shell)
{
    if (-x "$bindir/munin-node-configure-snmp")
    {
	if (eval "require Net::SNMP;")
	{
	    my @params;
	    push (@params, "$bindir/munin-node-configure-snmp");
	    push (@params, "--snmpversion", $snmpver) if defined $snmpver;
	    push (@params, "--community", $snmpcomm) if defined $snmpcomm;
	    push (@params, $debugopt) if $debug;
	    push (@params, @snmp);
	    print "# executing: ",join(' ',@params),"\n" if $debug;
	    exec (@params);
	    # NOTREACHED
	}
	else
	{
	    print STDERR "# ERROR: Cannot perform SNMP probe. SNMP operations require the perl module\n";
	    print STDERR "# Net::SNMP, which is currently not installed (or not in one of the following\n";
	    print STDERR "# directories: @INC\n";
	}
    }
    else
    {
	print STDERR "# ERROR: Cannot perform SNMP probe. SNMP operations require the SNMP part\n";
	print STDERR "# of Munin to be installed, which is currently not installed, or not in the \n";
	print STDERR "# rigt directory: $bindir\n";
    }
}

if (@errors) {
    print STDERR "# There were some errors:\n";
    print STDERR "# ",join("\n# ",@errors),"\n";

    exit 1;
}

sub link_remove
{
    my $plug = shift;

    return unless $removes;
    return unless (-l "$servicedir/$plug"); # Strange...

    print "rm -f $servicedir/$plug\n";
}

sub link_add
{
    my $plug = shift;
    my $wild = shift;

    if (defined $wild)
    {
	print "ln -s $libdir/$plug $servicedir/$plug$wild\n";
    }
    else
    {
	print "ln -s $libdir/$plug $servicedir/$plug\n";
    }
}

sub normal
{
    printf ("%-26s | %-4s | %-39s\n", @_);
}

sub get_installed {
	(my $ps, my $dir) = @_;

	print "# Opening \"$dir\" for reading...\n" if $debug;
	opendir (DIR, $dir) or die "Could not open \"$dir\" for reading: $!\n";
	my @installed = readdir (DIR);
	print "# Found ",scalar(@installed)," files\n" if $debug;
	close (DIR);

	foreach my $inst (@installed) {
		my $realfile = undef;

		next unless -l "$dir/$inst"; # None of our business...
		next unless ($realfile = readlink ("$dir/$inst"));
		next unless ($realfile =~ /^$libdir\//); # None of our business...
		$realfile =~ s/^.+\///;

		print "# Checking file: $inst..." if $debug;
		if ($realfile =~ /_$/) # Wildcard plugin...
		{
		    print "# $realfile..." if $debug;
		    (my $wild = $inst) =~ s/^$realfile//;
		    print "# $wild..." if $debug;
		    push @{$ps->{$realfile}->{'suggest'}}, $wild;
		}
		$ps->{$realfile}->{'installed'} = "yes";

		print "\n" if $debug;
	}

	return $ps;
}

sub get_plugins {
    (my $ps, my $dir) = @_;
    my %versions = ();

    if (defined $newer and -f "$dir/plugins.history") {
	if (open (HIST, "$dir/plugins.history")) {
	    my @slurp = <HIST>;
	    my $reached_version = 0;
	    my $ver = "0.0.0";
	    close (HIST);
	    my $uname = lc `uname`;
	    chomp $uname;

	    foreach my $line (@slurp) {
		chomp $line;
		$line =~ s/#.*//g;
		$line =~ s/^\s+//g;
		$line =~ s/\s+$//g;
		next unless $line =~ /\S/;

		if ($line =~ /^\[([^\]]+)\]$/) {
		    $ver = $1;
		    print "# Setting version to \"$ver\".\n" if $debug;
		    if ($ver eq $newer) {
			$reached_version = 1;
		    } elsif ($reached_version) {
			$reached_version++;
		    }
		} elsif ($reached_version < 2) {
		    next;
		} elsif ($line =~ /^([^\/]+)\/(.+)$/) {
		    if ($uname eq $1) {
			$ps->{$2}->{'version'} = $ver;
			print "# - Adding plugin '$2' to version tree ",
			  "($ver)...\n" if $debug;
		    }
		} elsif ($line =~ /^(.+)$/) {
		    $ps->{$1}->{'version'} = $ver;
		    print "# - Adding plugin \"$1\" to version tree ",
		      "($ver)...\n" if $debug;
		}
	    }
	} else {
	    warn "Warning: Could not open \"$dir/plugins.history\": $!\n";
	}
    }

    print "# Opening \"$dir\" for reading...\n" if $debug;
    opendir (DIR, $dir) or die "Could not open \"$dir\" for reading: $!\n";
    my @plugins = readdir (DIR);
    print "# Found ",scalar(@plugins)," files\n" if $debug;
    close (DIR);

    foreach my $plug (@plugins) {
	my $path = "$dir/$plug";
	next if $plug =~ /^\./;
	print "# Considering $dir/$plug for checking\n" if $debug;
	# If anyone ever uses a relative symlink this will break so bad
	$path = readlink($path) and
	  $path = $path =~ /^\// ? $path : "$dir/$path"
	    while -l $path;
	if (!-f $path) {
	    print "# File is not a file\n" if $debug;
	    next;
	}
	if (!-x _) {
	    print "# File is not executable\n" if $debug;
	    next;
	}
	if ($plug =~ /~$/    or # Emacs droppings
	    $plug =~ /.bak$/ or # Backup file
	    $plug =~ /.swp$/) { # Vi droppings
	    print "# File is a backup/leftover file\n" if $debug;
	    next;
	}

	$ps->{$plug}->{'family'} = "contrib"; # Set default family...

	print "# Checking plugin: $plug..." if $debug;
	if (! open (FILE, "$dir/$plug")) {
	    warn "WARNING: Could not open file '$dir/$plug' for reading $!.".
	      "Skipping.\n";
	    next;
	}
	while (<FILE>) {
	    chomp;
	    if (/#%#\s+family\s*=\s*(\S+)\s*$/) {
		$ps->{$plug}->{'family'} = $1;
		print "# $1..." if $debug;
	    } elsif (/#%#\s+capabilities\s*=\s*(.+)$/) {
		foreach my $cap (split (/\s+/, $1)) {
		    $ps->{$plug}->{'capability'}->{$cap} = 1;
		    print "# $cap..." if $debug;
		}
	    }
	}
	close (FILE);

	unless (grep (/^$ps->{$plug}->{'family'}$/, @families)) {
	    print "\n" if $debug;
	    next;
	}
	if ($ps->{$plug}->{'family'} eq "auto" and defined $newer and
	    !defined $ps->{$plug}->{'version'}) {
	    print "\n" if $debug;
	    next;
	}

	if ($ps->{$plug}->{'capability'}->{'autoconf'}) {

	    my @cmd=("$bindir/munin-run");
	    push(@cmd,$debugopt) if $debug;
	    push(@cmd,"--servicedir",$libdir, $plug, "autoconf");

	    print "\n# Running: ",join(' ',@cmd),"\n" if $debug;

	    my $fork = open (PLUG, "-|");

	    if ($fork == -1) {
		die "ERROR: Unable to fork: $!\n"
	    } elsif ($fork == 0) { # Child
		close (STDERR);
		open (STDERR, ">&STDOUT");
		exec (@cmd);
	    } else {
		# The join map we used here before was somehow
		# fragile.  This construct is possible to
		# debug.

		my @pr = ();	# Plugin response

		while (<PLUG>) {
		    chomp;
		    if (m/^yes$/ or m/^no(.*)?$/) {
			# Some recognized response
			print "# Got yes/no: $_\n" if $debug;
			push(@pr,$_);
		    } else {
			# Something else
			push(@errors,"Got junk from $plug: $_");
			print "# Got junk: $_\n" if $debug;
		    }
		}

		$ps->{$plug}->{'defaultreason'}=join(' ',@pr);
	    }
	    close (PLUG);
	    if ($?) {
		$ps->{$plug}->{'default'} = "no";
	    } else {
		$ps->{$plug}->{'default'} = "yes";
	    }
	    print "# ",$ps->{$plug}->{'default'}, ":",
	      $ps->{$plug}->{'defaultreason'}, "..."
		if $debug;
	}

	if ($ps->{$plug}->{'capability'}->{'suggest'}) {
	    if (exists $ps->{$plug}->{'default'} and
		$ps->{$plug}->{'default'} eq "yes") {

		my @cmd=("$bindir/munin-run");
		# Debug here breaks stuff.
		# push(@cmd,$debugopt) if $debug;
		push(@cmd,"--servicedir",$libdir, $plug, "suggest");

		print "\n# Running: ",join(' ',@cmd),"\n" if $debug;

		my $fork = open (PLUG, "-|");

		if ($fork == -1) {
		    die "ERROR: Unable to fork: $!\n"
		} elsif ($fork == 0) { # Child
		    # We would redirect stderr, but with suggest
		    # it's hard to sort errors from the suggestions
		    # as we have no idea what the suggestions might
		    # be.
		    exec (@cmd);
		} else {
		    # Fragile loop, blah blah (se above)

		    my @sugg;

		    while (<PLUG>) {
			chomp;
			if (m/^#/) {
			    # debug output from munin-run
			    print "# Got junk: $_\n" if $debug;
			} else {
			    # This ought to be a suggestion.
			    print "# Got suggestion: $_\n" if $debug;
			    push(@sugg,$_);
			}
		    }
		    @{$ps->{$plug}->{'suggest'}} = @sugg;
		}
		close (PLUG);
		if ($?) {
		    @{$ps->{$plug}->{'suggest'}} = ();
		}
		print "# Suggested: ",
		  join (' ', @{$ps->{$plug}->{'suggest'}}),"\n"
		    if $debug;

		push(@errors,"ERROR: empty suggest from $plug")
		    if ! @{$ps->{$plug}->{'suggest'}};
	    }
	}
	print "\n" if $debug;
    }
    #	print Dumper $ps;
    return $ps;
}

1;

=head1 NAME

munin-node-configure - A program to view configurations for munin-node

=head1 SYNOPSIS

munin-node-configure [options]

=head1 OPTIONS

=over 5

=item B<< --help >>

View this help page

=item B<< --version >>

Show version information

=item B<< --debug >>

Print debug information (very verbose).  All debugging output is
printed on STDOUT but each line is prefixed with '#'.  Only errors are
printed on STDERR.

=item B<< --config <file> >>

Override configuration file [/etc/munin/client.conf]

=item B<< --servicedir <dir> >>

Override plugin dir [/etc/munin/plugins/]

=item B<< --libdir <dir> >>

Override plugin lib [/usr/local/libexec/munin/plugins]

=item B<< --families <family,...> >>

Override families [auto]

=item B<< --suggest >>

Show suggestions instead of status

=item B<< --shell >>

Show shell commands (implies --suggest)

=item B<< --remove-also >>

Also show rm-commands when doing --shell

=item B<< --snmp <host|cidr,...> >>

Do SNMP probing on the host or CIDR network (e.g. "192.168.1.0/24"). This
may take some time, especially if the probe includes many hosts. This option
can be specified multiple times, or once with a comma-separated list, to
include more than one host/CIDR.

=item B<< --snmpversion <ver> >>

Set the SNMP version (1, 2c or 3) to use when probing. Default is "2c".

=item B<< --snmpcommunity <comm> >>

Set SNMP community to use when probing. Default is "public".

=back

=head1 DESCRIPTION

Munin's node is a daemon that Munin connects to fetch data. This data is
stored in .rrd-files, and later graphed and htmlified. It's designed to
let it be very easy to graph new datasources.

Munin-node-configure is a script to show the current configuration of which
plugins the host is running, as well as suggestions on what changes to make
to this configuration. Munin-node-configure does this by using munin-run(1) to
ask the plugins themselves of wether they should be run or not.

=head1 FILES

	/etc/munin/munin-node.conf
	/etc/munin/plugin-conf.d/*
	/etc/munin/plugins/*
	/usr/local/libexec/munin/plugins/*

=head1 VERSION

This is munin-node-configure v1.2.6.

=head1 AUTHORS

Jimmy Olsen, Nicolai Langfeldt

=head1 BUGS

None known.

=head1 COPYRIGHT

Copyright (C) 2003-2006 Jimmy Olsen, Nicolai Langfeldt.

This is free software; see the source for copying conditions. There is
NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR
PURPOSE.

This program is released under the GNU General Public License

=cut

# vim:syntax=perl
