#!/usr/bin/perl -wT
#
# Copyright (C) 2004 Audun Ytterdal, Jimmy Olsen
#
# 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.
#
#
# $Id: munin-node.in 910 2005-04-15 20:31:27Z jo $
#

package MyPackage;

use strict;
use vars qw(@ISA);
use Getopt::Long;
use Net::Server::Fork; # any personality will do
use Data::Dumper;

my $tls;
my %tls_verified = ( "level" => 0, "cert" => "", "verified" => 0, "required_depth" => 5 );

chdir ("/");

# "Clean" environment to disable taint-checking on the environment. We _know_
# that the environment is insecure, but we want to let admins shoot themselves
# in the foot with it, if they want to.
foreach my $key (keys %ENV)
{
        $ENV{$key} =~ /^(.*)$/;
        $ENV{$key} = $1;
}

$0 =~ /^(.*)$/; # for some strange reason won't "$0 = $0;" work.
$0 = $1;

@ISA = qw(Net::Server::Fork);
my @ORIG_ARGV = @ARGV;
my %services;
my %nodes;
my $servicedir="/etc/munin/plugins";
my $sconfdir="/etc/munin/plugin-conf.d";
my $conffile="/etc/munin/munin-node.conf";
my $FQDN="";
my $do_usage = 0;
my $DEBUG = 0;
my $do_version = 0;
my $VERSION="1.3.2";
my $defuser = getpwnam ("nobody");
my $defgroup= getgrnam ("munin");
my $paranoia= 0;
my @ignores = ();
my %sconf   = ('timeout' => 10);
my $caddr   = "";

$do_usage=1  unless 
GetOptions ( "config=s"     => \$conffile,
             "debug!"       => \$DEBUG,
             "version!"     => \$do_version,
             "paranoia!"    => \$paranoia,
             "help"         => \$do_usage );

if ($do_usage)
{
    print "Usage: $0 [options]

Options:
    --help              View this message.
    --config <file>     Use <file> as configuration file. 
                        [/etc/munin/munin-node.conf]
    --[no]paranoia      Only run plugins owned by root. Check permissions.
                        [--noparanoia]
    --debug             View debug messages.
    --version           View version information.

";
    exit 0;
}

if ($do_version)
{
	print "munin-node (munin-node) version $VERSION.
Written by Audun Ytterdal, Jimmy Olsen, Tore Anderson / Linpro AS

Copyright (C) 2002-2004
This is free software released under the GNU Public License. There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
";
	exit 0;
}

# Reset ARGV (for HUPing)
@ARGV = @ORIG_ARGV;

# Check permissions of configuration

if (!&check_perms ($servicedir) or !&check_perms ($conffile))
{
	die "Fatal error. Bailing out.";
}

if (! -f $conffile) {
  print "ERROR: Cannot open $conffile\n";
  exit 1;
}

# A hack to overide the hostname if everyhing thing else fails
open FILE,$conffile or die "Cannot open $conffile\n";
while (<FILE>) {
  chomp;
  s/#.*//;                # no comments
  s/^\s+//;               # no leading white
  s/\s+$//;               # no trailing white
  next unless length;     # anything left?
  /(^\w*)\s+(.*)/;
  if (($1 eq "host_name" or $1 eq "hostname") and $2)
  {
      $FQDN=$2;
  }
  elsif (($1 eq "default_plugin_user" or $1 eq "default_client_user") and $2)
  {
      my $tmpid = $2;
      $defuser = &get_uid ($tmpid);
      if (! defined ($defuser))
      {
	  die "Default user defined in \"$conffile\" does not exist ($tmpid)";
      }
  }
  elsif (($1 eq "default_plugin_group" or $1 eq "default_client_group") and $2)
  {
      my $tmpid = $2;
      $defgroup = &get_gid ($tmpid);
      if (! defined ($defgroup))
      {
	  die "Default group defined in \"$conffile\" does not exist ($tmpid)";
      }
  }
  elsif (($1 eq "paranoia") and defined $2)
  {
	  if ("$2" eq "no" or "$2" eq "false" or "$2" eq "off" or "$2" eq "0")
	  {
		  $paranoia = 0;
	  }
	  else
	  {
		  $paranoia = 1;
	  }
  }
  elsif (($1 eq "ignore_file") and defined $2)
  {
      push @ignores, $2;
  }
  elsif (($1 eq "timeout") and defined $2)
  {
      $sconf{'timeout'} = $2;
  }
  elsif (defined $1 and defined $2 and not defined $sconf{$1})
  {
      $sconf{$1} = $2;
  }
}

$FQDN ||= &get_fq_hostname;

$ENV{FQDN}=$FQDN;

MyPackage->run(conf_file => $conffile,
	       pid_file => "/var/run/munin/munin-node.pid");
exit;




### over-ridden subs below

sub pre_loop_hook {
    my $self = shift;
	print STDERR "In pre_loop_hook.\n" if $DEBUG;
    &load_services;
    $self->SUPER::pre_loop_hook;
}

sub show_version {
  print "munins node on $FQDN version: $VERSION\n"
}

sub show_nodes {
  for my $node (keys %nodes) {
    net_write ("$node\n");
  }
  net_write (".\n");
}

sub get_fq_hostname {
    my $hostname;
    eval {
        require Net::Domain;
        $hostname = Net::Domain::hostfqdn();
    };
    return $hostname if $hostname;

    $hostname = `hostname`;  # Fall$
    chomp($hostname);
    $hostname =~ s/\s//g;
    return $hostname;
}

sub load_services {
    if (opendir (DIR,$sconfdir))
    {
FILES:
	for my $file (grep { -f "$sconfdir/$_" } readdir (DIR))
	{
	    next if $file =~ m/^\./; # Hidden files
	    next if $file !~ m/^([-\w.]+)$/; # Skip if any weird chars
	    $file = $1; # Not tainted anymore.
	    foreach my $regex (@ignores)
	    {
		next FILES if $file =~ /$regex/;
	    }
	    if (!&load_auth_file ($sconfdir, $file, \%sconf))
	    {
		warn "Something wicked happened while reading \"$servicedir/$file\". Check the previous log lines for spesifics.";
	    }
	}
	closedir (DIR);
    }
    
    opendir (DIR,$servicedir) || die "Cannot open plugindir: $servicedir $!";
FILES:
    for my $file (grep { -f "$servicedir/$_" } readdir(DIR)) {
	next if $file =~ m/^\./; # Hidden files
	next if $file =~ m/.conf$/; # Config files
	next if $file !~ m/^([-\w.]+)$/; # Skip if any weird chars
	$file = $1; # Not tainted anymore.
	foreach my $regex (@ignores)
	{
	    next FILES if $file =~ /$regex/;
	}
	next if (! -x "$servicedir/$file"); # File not executeable
	print "file: '$file'\n" if $DEBUG;
	$services{$file}=1;
	my @rows = &run_service($file,"config", 1);
	my $node = &get_var (\%sconf, $file, 'host_name');

	for my $row (@rows) {
	  print "row: $row\n" if $DEBUG;
	  if ($row =~ m/^host_name (.+)$/) {
	    print "Found host_name, using it\n" if $DEBUG;
	    $node = $1;
	  }
	} 
	$node ||= $FQDN;
	$nodes{$node}{$file}=1;
    }
    closedir DIR;
}

sub print_service {
  my (@lines) = @_;
  for my $line (@lines) {
    net_write ("$line\n");
  }
  net_write (".\n");
}

sub list_services {
    my $node = $_[0] || $FQDN;
    net_write (join " ", grep { &has_access ($_); } keys %{$nodes{$node}});
    #print join " ", keys %{$nodes{$node}};
    net_write ("\n");
}

sub has_access {
	my $serv   = shift;
	my $host   = $caddr;
	my $rights = &get_var_arr (\%sconf, $serv, 'allow_deny');

	unless (@{$rights})
	{
		return 1;
	}
	print STDERR "DEBUG: Checking access: $host;$serv;\n" if $DEBUG;
	foreach my $ruleset (@{$rights})
	{
		foreach my $rule (@{$ruleset})
		{
			logger ("DEBUG: Checking access: $host;$serv;". $rule->[0].";".$rule->[1]) if $DEBUG;
			if ($rule->[1] eq "tls" and $tls_verified{"verified"})
			{ # tls
				if ($rule->[0] eq "allow")
				{
					return 1;
				}
				else
				{
					return 0;
				}
			}
#			elsif ($rule->[1] =~ /\//)
#			{ # CIDR
#				print "DEBUG: CIDR $host;$serv;$rule->[1];\n";
#				return 1;
#			}
			else
			{ # regex
				if ($host =~ m($rule->[1]))
				{
					if ($rule->[0] eq "allow")
					{
						return 1;
					}
					else
					{
						return 0;
					}
				}
			}
		}
	}
	return 1;
}

sub logger {
    my $text  = shift;
    my @date  = localtime (time);

    chomp ($text);
    $text =~ s/\n/\\n/g;

    printf STDERR ("%d/%02d/%02d-%02d:%02d:%02d [$$] %s\n", $date[5]+1900, $date[4]+1, 
	    $date[3], $date[2], $date[1], $date[0], $text);
}

sub reap_children {
  my $child = shift;
  my $text = shift;
  return unless $child;
  if (kill (0, $child)) 
    { 
      net_write ("# timeout pid $child - killing..."); 
      logger ("Plugin timeout: $text (pid $child)");
      kill (-1, $child); sleep 2; 
      kill (-9, $child);
      net_write ("done\n");
    } 
}

sub run_service {
  my ($service,$command,$autoreap) = @_;
  $command ||="";
  my @lines = ();;
  my $timed_out = 0;
  if ($services{$service} and ($caddr eq "" or &has_access ($service))) {
    my $child = 0;
    my $timeout = get_var (\%sconf, $service, 'timeout');
    $timeout = $sconf{'timeout'} 
    	unless defined $timeout and $timeout =~ /^\d+$/;

    if ($child = open (CHILD, "-|")) {
      eval {
	  local $SIG{ALRM} = sub { $timed_out=1; die "$!\n"};
	  alarm($timeout);
	  while(<CHILD>) {
	    push @lines,$_;
	  }
      };
      if( $timed_out ) {
	  reap_children($child, "$service $command: $@");
	  close (CHILD);
          return ();
      }
      unless (close CHILD)
      {
	  if ($!)
	  {
	      # If Net::Server::Fork is currently taking care of reaping,
	      # we get false errors. Filter them out.
	      unless (defined $autoreap and $autoreap) 
	      {
		  logger ("Error while executing plugin \"$service\": $!");
	      }
	  }
	  else
	  {
	      logger ("Plugin \"$service\" exited with status $?. --@lines--");
	  }
      }
    }
    else {
      if ($child == 0) {
	# New process group...
	POSIX::setsid();
        # Setting environment
	$sconf{$service}{user}    = &get_var (\%sconf, $service, 'user');
	$sconf{$service}{group}   = &get_var (\%sconf, $service, 'group');
	$sconf{$service}{command} = &get_var (\%sconf, $service, 'command');
	&get_var (\%sconf, $service, 'env', \%{$sconf{$service}{env}});
	
	if ($< == 0) # If root...
	{
		# Giving up gid egid uid euid
		my $u  = (defined $sconf{$service}{'user'}?
			$sconf{$service}{'user'}:
			$defuser);
		my $g  = $defgroup;
		my $gs = "$g $g" .
			($sconf{$service}{'group'}?" $sconf{$service}{group}":"");

#		net_write ("# Want to run as euid/egid $u/$g\n") if $DEBUG;

		$( = $g    unless $g == 0;
		$) = $gs   unless $g == 0;
		$< = $u    unless $u == 0;
		$> = $u    unless $u == 0;

		if ($> != $u or $g != (split (' ', $)))[0])
		{
#			net_write ("# Can't drop privileges. Bailing out. (wanted uid=",
#			    ($sconf{$service}{'user'} || $defuser), " gid=\"",
#			    $gs, "\"($g), got uid=$> gid=\"$)\"(", 
#			    (split (' ', $)))[0], ").\n");
			logger ("Plugin \"$service\" Can't drop privileges. ".
			    "Bailing out. (wanted uid=".
			    ($sconf{$service}{'user'} || $defuser). " gid=\"".
			    $gs. "\"($g), got uid=$> gid=\"$)\"(". 
			    (split (' ', $)))[0]. ").\n");
			exit 1;
		}
	}
#	net_write ("# Running as uid/gid/euid/egid $</$(/$>/$)\n") if $DEBUG;
	if (!&check_perms ("$servicedir/$service"))
	{
#	    net_write ("# Error: unsafe permissions. Bailing out.");
	    logger ("Error: unsafe permissions. Bailing out.");
	    exit 2;
	}

	# Setting environment...
	if (exists $sconf{$service}{'env'} and
			defined $sconf{$service}{'env'})
	{
	    foreach my $key (keys %{$sconf{$service}{'env'}})
	    {
#		net_write ("# Setting environment $key=$sconf{$service}{env}{$key}\n") if $DEBUG;
		$ENV{"$key"} = $sconf{$service}{'env'}{$key};
	    }
	}
	if (exists $sconf{$service}{'command'} and 
		defined $sconf{$service}{'command'})
	{
	    my @run = ();
	    foreach my $t (@{$sconf{$service}{'command'}})
	    {
		if ($t =~ /^%c$/)
		{
		    push (@run, "$servicedir/$service", $command);
		}
		else
		{
		    push (@run, $t);
		}
	    }
	    print STDERR "# About to run \"", join (' ', @run), "\"\n" if $DEBUG;
#	    net_write ("# About to run \"", join (' ', @run), "\"\n") if $DEBUG;
	    exec (@run) if @run;
	}
	else
	{
#	    net_write ("# Execing...\n") if $DEBUG;
	    exec ("$servicedir/$service", $command);
	}
      }
      else {
#	net_write ("# Unable to fork.\n");
	logger ("Unable to fork.");
      }
    }
    wait;
    alarm(0);
  }
  else {
    net_write ("# Unknown service\n");
  }
  chomp @lines;
  return (@lines);
}

sub process_request {
  my $self = shift;
  $caddr = $self->{server}->{peeraddr};
  $0 .= " [$caddr]";
  net_write ("# munin node at $FQDN\n");
  local $SIG{ALRM} = sub { logger ("Connection timed out."); die "timeout" };
  alarm($sconf{'timeout'});
  while (defined ($_ = net_read())) {
    alarm($sconf{'timeout'});
    chomp;
    logger ("DEBUG: Running command \"$_\".") if $DEBUG;
    if (/^list\s*([0-9a-zA-Z\.\-]+)?/i) {
      &list_services($1);
    }
    elsif (/^quit/i || /^\./) {
      exit 1;
    }
    elsif (/^version/i) {
      &show_version;
	}
    elsif (/^nodes/i) {
      &show_nodes;
    }
    elsif (/^fetch\s?(\S*)/i) {
      print_service (&run_service($1)) 
    }
    elsif (/^config\s?(\S*)/i) {
      print_service (&run_service($1,"config"));
    } 
    elsif (/^starttls\s*$/i) {
      my $mode;
      my $key;
      my $cert;
      my $depth;
      $key = $cert = &get_var (\%sconf, "tls_pem");
      $key = &get_var (\%sconf, "tls_private_key")
	  unless defined $key;
      $key = "/etc/munin/munin-node.pem" unless defined $key;
      $cert = &get_var (\%sconf, "tls_certificate")
	  unless defined $cert;
      $cert = "/etc/munin/munin-node.pem" unless defined $cert;
      $mode = &get_var (\%sconf, 'tls');
      $mode = "auto" unless defined $mode and length $mode;
      $depth = &get_var (\%sconf, 'tls_verify_depth');
      $depth = 5 unless defined $depth;
      start_tls ($mode, $cert, $key,
	      &get_var (\%sconf, 'tls_verify_certificate'),
	      $depth
	      );
      logger ("DEBUG: Returned from starttls.") if $DEBUG;
    }
    else  {
      net_write ("# Unknown command. Try list, nodes, config, fetch, version or quit\n");
    }
  }
}

sub net_read 
{
    if (defined $tls)
    {
	eval { $_ = Net::SSLeay::read($tls); };
	my $err = &Net::SSLeay::print_errs();
	if (defined $err and length $err)
	{
	    logger ("TLS Warning in net_read: $err");
	}
    }
    else
    {
	$_ = <STDIN>;
    }
    logger ("DEBUG: < $_") if $DEBUG;
    return $_;
}

sub net_write 
{
    my $text = shift;
    logger ("DEBUG: > $text") if $DEBUG;
    if (defined $tls)
    {
	eval { Net::SSLeay::write ($tls, $text); };
	my $err = &Net::SSLeay::print_errs();
	if (defined $err and length $err)
	{
	    logger ("TLS Warning in net_write: $err");
	}
    }
    else
    {
	print STDOUT $text;
    }
}

sub tls_verify_callback 
{
    my ($ok, $subj_cert, $issuer_cert, $depth, 
	    $errorcode, $arg, $chain) = @_;

    $tls_verified{"level"}++;

    if ($ok and $tls_verified{"level"} <= $tls_verified{"required_depth"})
    {
    	$tls_verified{"verified"} = 1;
	logger ("TLS Notice: Verified certificate.") if $DEBUG;
        return 1; # accept
    }

    return 1; # accept anyway
}

sub start_tls 
{
    my $tls_paranoia = shift;
    my $tls_cert     = shift;
    my $tls_priv     = shift;
    my $tls_verify   = shift;
    my $tls_vdepth   = shift;

    my $err;
    my $ctx;
    my $local_key = 0;

    %tls_verified = ( "level" => 0, "cert" => "", "verified" => 0, "required_depth" => $tls_vdepth );

    if ($tls_paranoia eq "disabled")
    {
	logger ("TLS Notice: Refusing TLS request from peer.");
	net_write ("TLS NOT AVAILABLE\n");
	return 0
    }

    logger("Enabling TLS.") if $DEBUG;
    if (! eval "require Net::SSLeay;")
    {
	if ($tls_paranoia eq "auto")
	{
	    logger ("Notice: TLS requested by peer, but Net::SSLeay unavailable.");
	    return 0;
	}
	else # tls really required
	{
	    logger ("Fatal: TLS enabled but Net::SSLeay unavailable.");
	    exit 0;
	}
    }

    # Init SSLeay
    Net::SSLeay::load_error_strings();
    Net::SSLeay::SSLeay_add_ssl_algorithms();
    Net::SSLeay::randomize();
    $ctx = Net::SSLeay::CTX_new();
    if (!$ctx)
    {
	logger ("TLS Error: Could not create SSL_CTX: " . &Net::SSLeay::print_errs());
	return 0;
    }

    # Tune a few things...
    if (Net::SSLeay::CTX_set_options($ctx, &Net::SSLeay::OP_ALL))
    {
	logger ("TLS Error: Could not set SSL_CTX options: " . &Net::SSLeay::print_errs());
	return 0;
    }

    # Should we use a private key?
    if (-e $tls_priv or $tls_paranoia eq "paranoid")
    {
        if (defined $tls_priv and length $tls_priv)
        {
	    if (!Net::SSLeay::CTX_use_PrivateKey_file($ctx, $tls_priv, 
		    &Net::SSLeay::FILETYPE_PEM))
	    {
	        logger ("TLS Notice: Problem occured when trying to read file with private key \"$tls_priv\": ".&Net::SSLeay::print_errs().". Continuing without private key.");
	    }
	    else
	    {
	        $local_key = 1;
	    }
        }
    }
    else
    {
	logger ("TLS Notice: No key file \"$tls_priv\". Continuing without private key.");
    }

    # How about a certificate?
    if (-e $tls_cert)
    {
        if (defined $tls_cert and length $tls_cert)
        {
	    if (!Net::SSLeay::CTX_use_certificate_file($ctx, $tls_cert, 
		    &Net::SSLeay::FILETYPE_PEM))
	    {
	        logger ("TLS Notice: Problem occured when trying to read file with certificate \"$tls_cert\": ".&Net::SSLeay::print_errs().". Continuing without certificate.");
	    }
	}
    }
    else
    {
	logger ("TLS Notice: No certificate file \"$tls_cert\". Continuing without certificate.");
    }

    # Tell the other side that we're able to talk TLS
    if ($local_key)
    {
        print "TLS OK\n";
    }
    else
    {
        print "TLS MAYBE\n";
    }

    # Now let's define our requirements of the node
    $tls_vdepth = 5 unless defined $tls_vdepth;
    Net::SSLeay::CTX_set_verify_depth ($ctx, $tls_vdepth);
    $err = &Net::SSLeay::print_errs();
    if (defined $err and length $err)
    {
	logger ("TLS Warning in set_verify_depth: $err");
    }
    Net::SSLeay::CTX_set_verify ($ctx, &Net::SSLeay::VERIFY_PEER, \&tls_verify_callback);
    $err = &Net::SSLeay::print_errs();
    if (defined $err and length $err)
    {
	logger ("TLS Warning in set_verify: $err");
    }

    # Create the local tls object
    if (! ($tls = Net::SSLeay::new($ctx)))
    {
	logger ("TLS Error: Could not create TLS: " . &Net::SSLeay::print_errs());
	return 0;
    }
    if ($DEBUG)
    {
	my $i = 0;
	my $p = '';
	my $cipher_list = 'Cipher list: ';
	$p=Net::SSLeay::get_cipher_list($tls,$i);
	$cipher_list .= $p if $p;
	do {
	    $i++;
	    $cipher_list .= ', ' . $p if $p;
	    $p=Net::SSLeay::get_cipher_list($tls,$i);
	} while $p;
        $cipher_list .= '\n';
	logger ("TLS Notice: Available cipher list: $cipher_list.");
    }

    # Redirect stdout/stdin to the TLS
    Net::SSLeay::set_rfd($tls, fileno(STDIN));
    $err = &Net::SSLeay::print_errs();
    if (defined $err and length $err)
    {
	logger ("TLS Warning in set_rfd: $err");
    }
    Net::SSLeay::set_wfd($tls, fileno(STDOUT));
    $err = &Net::SSLeay::print_errs();
    if (defined $err and length $err)
    {
	logger ("TLS Warning in set_wfd: $err");
    }

    # Try to negotiate the tls connection
    my $res;
    if ($local_key)
    {
        $res = Net::SSLeay::accept($tls);
    }
    else
    {
        $res = Net::SSLeay::connect($tls);
    }
    $err = &Net::SSLeay::print_errs();
    if (defined $err and length $err)
    {
	logger ("TLS Error: Could not enable TLS: " . $err);
	Net::SSLeay::free ($tls);
	Net::SSLeay::CTX_free ($ctx);
	$tls = undef;
    }
    elsif (!$tls_verified{"verified"} and $tls_paranoia eq "paranoid")
    {
	logger ("TLS Error: Could not verify CA: " . Net::SSLeay::dump_peer_certificate($tls));
	Net::SSLeay::free ($tls);
	Net::SSLeay::CTX_free ($ctx);
	$tls = undef;
    }
    else
    {
	logger ("TLS Notice: TLS enabled.");
	logger ("TLS Notice: Cipher `" . Net::SSLeay::get_cipher($tls) . "'.");
	$tls_verified{"cert"} = Net::SSLeay::dump_peer_certificate($tls);
	logger ("TLS Notice: client cert: " .$tls_verified{"cert"});
    }

    return $tls;
}

sub get_uid
{
    my $user = shift;
    return undef if (!defined $user);

    if ($user !~ /\d/)
    {
	$user = getpwnam ($user);
    }
    return $user;
}

sub get_gid
{
    my $group = shift;
    return undef if (!defined $group);

    if ($group !~ /\d/)
    {
	$group = getgrnam ($group);
    }
    return $group;
}

sub load_auth_file 
{
    my ($dir, $file, $sconf) = @_;
    my $service = $file;

    if (!defined $dir or !defined $file or !defined $sconf)
    {
	return undef;
    }

    return undef if (!&check_perms ($dir));
    return undef if (!&check_perms ("$dir/$file"));

    if (!open (IN, "$dir/$file"))
    {
	warn "Could not open file \"$dir/$file\" for reading ($!), skipping plugin\n";
	return undef;
    }
    while (<IN>)
    {
	chomp;
	s/#.*$//;
	next unless /\S/;
	s/\s+$//g;
	net_write ("DEBUG: Config: $service: $_\n") if $DEBUG;
	if (/^\s*\[([^\]]+)\]\s*$/)
	{
	    $service = $1;
	}
	elsif (/^\s*user\s+(\S+)\s*$/)
	{
	    my $tmpid = $1;
	    $sconf->{$service}{'user'} = &get_uid ($tmpid);
	    net_write ("DEBUG: Config: $service->uid = ", $sconf->{$service}{'user'}, "\n") if $DEBUG;
	    if (!defined $sconf->{$service}{'user'})
	    {
		warn "User \"$tmpid\" in configuration file \"$dir/$file\" nonexistant. Skipping plugin.";
		next;
	    }
	}
	elsif (/^\s*group\s+(.+)\s*$/)
	{
	    my $tmpid = $1;
	    foreach my $group (split /\s*,\s*/, $tmpid)
	    {
		my $optional = 0;

		if ($group =~ /^\(([^)]+)\)$/)
		{
		    $optional = 1;
		    $group = $1;
		}

		my $g = &get_gid ($group);
		net_write ("DEBUG: Config: $service->gid = ". $sconf->{$service}{'group'}. "\n")
			if $DEBUG and defined $sconf->{$service}{'group'};
		if (!defined $g and !$optional)
		{
		    warn "Group \"$group\" in configuration file \"$dir/$file\" nonexistant. Skipping plugin.";
		    next;
		}
		elsif (!defined $g and $optional)
		{
		    net_write ("DEBUG: Skipping \"$group\" (optional).\n") if $DEBUG;
		    next;
		}
		if (!defined $sconf->{$service}{'group'})
		{
		    $sconf->{$service}{'group'} = $g;
		}
		else
		{
		    $sconf->{$service}{'group'} .= " $g";
		}
	    }
	}
	elsif (/^\s*command\s+(.+)\s*$/)
	{
	    @{$sconf->{$service}{'command'}} = split (/\s+/, $1);
	}
	elsif (/^\s*host_name\s+(.+)\s*$/)
	{
	    $sconf->{$service}{'host_name'} = $1;
	}
	elsif (/^\s*timeout\s+(\d+)\s*$/)
	{
	    $sconf->{$service}{'timeout'} = $1;
	    net_write ("DEBUG: $service: setting timeout to $1\n")
		if $DEBUG;
	}
	elsif (/^\s*(allow)\s+(.+)\s*$/ or /^\s*(deny)\s+(.+)\s*$/)
	{
	    push (@{$sconf->{$service}{'allow_deny'}}, [$1, $2]);
		print STDERR "DEBUG: Pushing allow_deny: $1, $2\n" if $DEBUG;
	}
	elsif (/^\s*env\s+([^=\s]+)\s*=\s*(.+)$/)
	{
	    $sconf->{$service}{'env'}{$1} = $2;
	    net_write ("Saving $service->env->$1 = $2...\n") if $DEBUG;
	    warn "Warning: Deprecated format in \"$dir/$file\" under \"[$service]\" (\"env $1=$2\" should be rewritten to \"env.$1 $2\").";
	}
	elsif (/^\s*env\.(\S+)\s+(.+)$/)
	{
	    $sconf->{$service}{'env'}{$1} = $2;
	    net_write ("Saving $service->env->$1 = $2...\n") if $DEBUG;
	}
	elsif (/^\s*(\w+)\s+(.+)$/)
	{
	    $sconf->{$service}{'env'}{"lrrd_$1"} = $2;
	    net_write ("Saving $service->env->lrrd_$1 = $2...\n") if $DEBUG;
            warn "Warning: Deprecated format in \"$dir/$file\" under \"[$service]\" (\"$1 $2\" should be rewritten to \"env lrrd_$1=$2\").";
	}
	elsif (/\S/)
	{
	    warn "Warning: Unknown config option in \"$dir/$file\" under \"[$service]\": $_";
	}

    }
    close (IN);

    return 1;
}

sub check_perms
{
    my $target = shift;
    my @stat;
    return undef if (!defined $target);
	return 1 if (!$paranoia);

    if (! -e "$target")
    {
	warn "Failed to check permissions on nonexistant target: \"$target\"";
	return undef;
    }

    @stat = stat ($target);
    if (!$stat[4] == 0 or
	($stat[5] != 0 and $stat[2] & 00020) or
	($stat[2] & 00002))
    {
	warn "Warning: \"$target\" has dangerous permissions (", sprintf ("%04o", $stat[2] & 07777), ").";
	return 0;
    }

    if (-f "$target") # Check dir as well
    {
	(my $dirname = $target) =~ s/[^\/]+$//;
	return &check_perms ($dirname);
    }

    return 1;
}

sub get_var_arr
{
    my $sconf   = shift;
    my $name    = shift;
    my $var     = shift;
    my $result  = [];

    if (exists $sconf->{$name}{$var})
    {
	push (@{$result}, $sconf->{$name}{$var});
    }

    foreach my $wildservice (grep (/\*$/, reverse sort keys %{$sconf}))
    {
	(my $tmpservice = $wildservice) =~ s/\*$//;
	next unless ($name =~ /^$tmpservice/);
	print STDERR "# Checking $wildservice...\n" if $DEBUG;

	if (defined $sconf->{$wildservice}{$var})
	{
	    push (@{$result}, $sconf->{$wildservice}{$var});
	    print STDERR ("DEBUG: Pushing: |", join (';', @{$sconf->{$wildservice}{$var}}), "|\n")
		if $DEBUG;
	}
    }
    return $result;
}

sub get_var
{
    my $sconf   = shift;
    my $name    = shift;
    my $var     = shift;
    my $env     = shift;

    if (!defined $var and defined $name)
    {
	return $sconf{$name};
    }
    if ($var eq 'env' and !defined $env)
    {
	%{$env} = ();
    }
    
    if ($var ne 'env' and exists $sconf->{$name}{$var})
    {
	return $sconf->{$name}{$var};
    }
    # Deciding environment
    foreach my $wildservice (grep (/\*$/, reverse sort keys %{$sconf}))
    {
	(my $tmpservice = $wildservice) =~ s/\*$//;
	next unless ($name =~ /^$tmpservice/);
#	net_write ("# Checking $wildservice...\n") if $DEBUG;

	if ($var eq 'env')
	{
	    if (exists $sconf->{$wildservice}{'env'})
	    {
		foreach my $key (keys %{$sconf->{$wildservice}{'env'}})
		{
		    if (! exists $sconf->{$name}{'env'}{$key})
		    {
			$sconf->{$name}{'env'}{$key} = $sconf->{$wildservice}{'env'}{$key};
			net_write ("Saving $wildservice->$key\n") if $DEBUG;
		    }
		}
	    }
	}
	else
	{
	    if (! exists $sconf->{$name}{$var} and
		    exists $sconf->{$wildservice}{$var})
	    {
		return ($sconf->{$wildservice}{$var});
	    }
	}
    }
    return $env;
}

1;

=head1 NAME

munin-node - A daemon to gather information in cooperation with the main
Munin program

=head1 SYNOPSIS

munin-node [--options]

=head1 OPTIONS

=over 5

=item B<< --config <configfile> >>

Use E<lt>fileE<gt> as configuration file. [/etc/munin/munin-node.conf]

=item B< --[no]paranoia >

Only run plugins owned by root. Check permissions as well. [--noparanoia]

=item B< --help >

View this help message.

=item B< --debug >

View debug messages.

=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 is a small perlscript listening to port 4949 using
Net::Server. It reads all the plugins in /etc/munin/plugins/ on startup.
The node accepts the following commands:

=over 5

=item B<< list [node] >>

list available plugins for host. If no hostname is specified, list plugins
on host running munin-node

=item B<< nodes >>

List nodes that has plugins in this munin-node.

=item B<< config <plugin> >>

output plugin configuration

=item B<< fetch <plugin> >>

output plugin values

=item B<< version >>

Print versionstring

=item B<< quit >>

disconnect

=back

=head2 Plugins

These plugins can be in you language of choice: bash, perl, python, C. The
plugins can be run in two modes: with and without the "config"-parameter. When
run with "config" as parameter, the plugin should output the configuration of
the graph. When run without parameters, the plugin should output just values

	# /etc/munin/plugins/load config
	host_name 
	graph_title Load average
	graph_args --base 1000 -l 0
	graph_vlabel load
	load.label load
	load.draw LINE2
	load.warning 10
	load.critical 120

	# /etc/munin/plugins/load
	load.value 0.43

For more information, see the documentation section at L<http://munin.sf.net/>.

=head1 FILES

	/etc/munin/munin-node.conf
	/etc/munin/plugins/*
	/etc/munin/plugin-conf.d/*
	/var/run/munin/munin-node.pid
	/var/log/munin/munin-node

=head1 VERSION

This is munin-node v1.3.2

=head1 AUTHORS

Audun Ytterdal, Jimmy Olsen, and Tore Anderson.

=head1 BUGS

munin-node does, as of now, not check the syntax of the configuration file.

Please report other bugs in the bug tracker at L<http://munin.sf.net/>.

=head1 COPYRIGHT

Copyright  2002 Audun Ytterdal, Jimmy Olsen, and Tore Anderson / Linpro AS.

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 ts=8
