#!/usr/bin/perl -wT
# -*- cperl -*-
#
# Copyright (C) 2002-2008 Audun Ytterdal, Jimmy Olsen, Tore Anderson,
#    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.
#
# $Id: munin-node.in 1442 2008-02-06 15:09:59Z janl $
#

package MyPackage;

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

# Variable is set at build, with values detected by the makefiles
my $HAS_SETR = 1;

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

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 || ''; # It sometimes happens that the match was empty
}

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

# Make configuration settings available at runtime.
$ENV{'MUNIN_PREFIX'}     = '/usr';
$ENV{'MUNIN_CONFDIR'}    = '/etc/munin';   # /etc/munin,/etc/opt/munin or such
$ENV{'MUNIN_BINDIR'}     = '/usr/bin';
$ENV{'MUNIN_SBINDIR'}    = '/usr/sbin';
$ENV{'MUNIN_DOCDIR'}     = '{_docdir}/munin-1.3.4';
$ENV{'MUNIN_LIBDIR'}     = '/usr/share/munin';    # LIBDIR/plugins contains plugin.sh
$ENV{'MUNIN_HTMLDIR'}    = '/var/www/munin';
$ENV{'MUNIN_CGIDIR'}     = '/var/www/cgi-bin';
$ENV{'MUNIN_DBDIR'}      = '/var/lib/munin';
$ENV{'MUNIN_PLUGSTATE'}  = '/var/lib/munin/plugin-state'; # Put plugin state files here!
$ENV{'MUNIN_MANDIR'}     = '/usr/share/man';
$ENV{'MUNIN_LOGDIR'}     = '/var/log/munin';
$ENV{'MUNIN_STATEDIR'}   = '/var/run/munin';  # This is for .pid files
$ENV{'MUNIN_USER'}       = 'munin';      # User munin runs as (mostly)
$ENV{'MUNIN_GROUP'}      = 'munin';     # Group ditto
$ENV{'MUNIN_PLUGINUSER'} = 'nobody';# Default user for plugin running
$ENV{'MUNIN_VERSION'}    = '1.3.4';
$ENV{'MUNIN_PERL'}       = '/usr/bin/perl';
$ENV{'MUNIN_PERLLIB'}    = '/usr/lib/perl5/vendor_perl/5.10.0';
$ENV{'MUNIN_GOODSH'}     = '/bin/sh';
$ENV{'MUNIN_BASH'}       = '/bin/bash';
$ENV{'MUNIN_PYTHON'}     = '/usr/bin/env python';
$ENV{'MUNIN_OSTYPE'}     = 'linux';
$ENV{'MUNIN_HOSTNAME'}   = 'deborah.mandriva.com';
$ENV{'MUNIN_MKTEMP'}     = 'mktemp -p /tmp/ $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=$Muninnode::VERSION;
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-2005

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
";
	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;

# Some locales uses "," as decimal separator. This can mess up a lot
# of plugins.
$ENV{'LC_ALL'}='C';

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 Sys::Hostname;
        $hostname = (gethostbyname(Sys::Hostname::hostname()))[0];
    };
    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}} )
		     ) )
      if exists $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;

		if ($HAS_SETR)
		{
			$( = $g    unless $g == 0;
			$< = $u    unless $u == 0;
		}
		$) = $gs   unless $g == 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;

  my $tls_started = 0;
  my $mode;

  $mode = &get_var (\%sconf, 'tls');
  $mode = "auto" unless defined $mode and length $mode;

  $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;
    if(!$tls_started and ($mode eq "paranoid" or $mode eq "enabled"))
    {
      if(!(/^starttls\s*$/i))
      {
        logger ("ERROR: Client did not request TLS. Closing.");
	net_write ("# I require TLS. Closing.\n");
        last;
      }
    }
    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 $key;
      my $cert;
      my $depth;
      my $ca_cert;
      my $tls_verify;
      $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;
      $ca_cert = &get_var(\%sconf, "tls_ca_certificate");
      $ca_cert = "/etc/munin/cacert.pem" unless defined $ca_cert;
      $depth = &get_var (\%sconf, 'tls_verify_depth');
      $depth = 5 unless defined $depth;
      $tls_verify = &get_var (\%sconf, 'tls_verify_certificate');
      $tls_verify = "no" unless defined $tls_verify;
      if (!start_tls ($mode, $cert, $key, $ca_cert, $tls_verify, $depth))
      {
          if ($mode eq "paranoid" or $mode eq "enabled")
          {
              logger ("ERROR: Could not establish TLS connection. Closing.");
              last;
          }
      }
      else
      {
          $tls_started=1;
      }
      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");
	}
	if($_ eq '') { undef $_; } #returning '' signals EOF
    }
    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) = @_;
#    logger ("ok is ${ok}");

    $tls_verified{"level"}++;

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

    if(!($tls_verified{"verify"} eq "yes"))
    {
        logger ("TLS Notice: Certificate failed verification, but we aren't verifying.") if $DEBUG;
	$tls_verified{"verified"} = 1;
        return 1;
    }

    if ($tls_verified{"level"} > $tls_verified{"required_depth"})
    {
        logger ("TLS Notice: Certificate verification failed at depth ".$tls_verified{"level"}.".");
        $tls_verified{"verified"} = 0;
        return 0;
    }

    return 0; # Verification failed
}

sub start_tls 
{
    my $tls_paranoia = shift;
    my $tls_cert     = shift;
    my $tls_priv     = shift;
    my $tls_ca_cert  = 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, "verify" => $tls_verify );

    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.");
    }

    # How about a CA certificate?
    if (-e $tls_ca_cert)
    {
        if(!Net::SSLeay::CTX_load_verify_locations($ctx, $tls_ca_cert, ''))
        {
            logger ("TLS Notice: Problem occured when trying to read file with the CA's certificate \"$tls_ca_cert\": ".&Net::SSLeay::print_errs("").". Continuing without CA's 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.";
		return undef;
	    }
	}
	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.";
		    return undef;
		}
		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. Ignored.\").";
	}
	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.$1 $2. Ignored.\").";
	}
	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 to fetch data. This
data is stored 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 network protocol is documented at
L<http://munin.projects.linpro.no/wiki/network-protocol>

These plugins can be in your 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.  Writing plugins is
easy and fun; please refer to
L<http://munin.projects.linpro.no/wiki/HowToWritePlugins> and
L<http://munin.projects.linpro.no/wiki/plugins>

=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.4

=head1 AUTHORS

Audun Ytterdal, Jimmy Olsen, and Tore Anderson.

=head1 BUGS

Please see L<http://munin.projects.linpro.no/report/1>

munin-node does, as of now, not check the syntax of the configuration
file.  It also does not check that plugins produces legal field names
and observes other niceties.

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

=head1 COPYRIGHT

Copyright  2002-2006 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

=head1 SEE ALSO

For information on configuration options, please refer to the man page for
F<munin-node.conf>.

=cut

# vim:syntax=perl ts=8
