MINI SHELL

Server : Apache/2.2.2 (Fedora)
System : Linux App1.pathumtani.go.th 2.6.20-1.2320.fc5smp #1 SMP Tue Jun 12 19:40:16 EDT 2007 i686
User : apache ( 48)
PHP Version : 5.2.9
Disable Function : NONE
Directory :  /usr/lib/perl5/vendor_perl/5.8.5/

Upload File :
current_dir [ Writeable ] document_root [ Writeable ]

 

Current File : //usr/lib/perl5/vendor_perl/5.8.5/Munin.pm
package Munin;
#!/usr/bin/perl
#
# Copyright (C) 2003-2004 Jimmy Olsen, Audun Ytterdal
#
# 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.pm.in 1142 2006-10-17 12:27:35Z tore $
#
# $Log$
# Revision 1.44.2.4  2005/03/09 17:57:37  jimmyo
# Escape regexps more properly (Deb#296575).
#
# Revision 1.44.2.3  2005/03/06 22:22:40  jimmyo
# Make sure all rrd-tunes are correct after an upgrade (Deb#296454, Deb#296645).
#
# Revision 1.44.2.2  2005/03/06 19:32:45  jimmyo
# Make sure all rrd-tunes are correct after an upgrade (Deb#296454, Deb#296645).
#
# Revision 1.44.2.1  2005/02/01 22:02:30  jimmyo
# Added category_order, to complete the *_order options.
#
# Revision 1.44  2005/01/05 18:32:49  jimmyo
# Main: Tables in service-view now containt the correct "Type" when using data aliases.
#
# Revision 1.43  2005/01/05 18:08:01  jimmyo
# Main: Tables in service-view now sorted according to graph_order.
#
# Revision 1.42  2005/01/05 17:43:34  jimmyo
# Main: Bugfix with graphs using both "graph_sums" and data aliases.
#
# Revision 1.41  2004/12/25 18:56:59  jimmyo
# Allow dots in PNG paths (patch by Jacques Caruso).
#
# Revision 1.40  2004/12/22 21:08:30  jimmyo
# Bugfix when using long labels and CGI graphing.
#
# Revision 1.39  2004/12/22 20:13:30  jimmyo
# Added option cgiurl_graph.
#
# Revision 1.38  2004/12/22 20:01:14  jimmyo
# Optimised munin-cgi-graph a bit.
#
# Revision 1.37  2004/12/09 22:12:56  jimmyo
# Added "graph_period" option, to make "graph_sums" usable.
#
# Revision 1.36  2004/12/08 08:47:44  jimmyo
# Fix bug where munin-limits didn't warn properly in all situations.
#
# Revision 1.35  2004/11/26 13:06:00  jimmyo
# Bugfix in munin-html, when using groups/host names with more than one dot.
#
# Revision 1.34  2004/11/21 14:39:23  jimmyo
# Renamed function munin_get_val to munin_get.
#
# Revision 1.33  2004/11/21 14:30:55  jimmyo
# Added new field option "line", which draws HRULEs.
#
# Revision 1.32  2004/11/19 23:01:41  jimmyo
# Fixed irqstats plugin so it doesn't use numbers as field names. Also expanded the label if possible, since munin-graph now handles long labels.
#
# Revision 1.31  2004/11/19 22:09:48  jimmyo
# Write out contact info to datafile correctly.
#
# Revision 1.30  2004/11/19 21:32:38  jimmyo
# Added a --force option to munin-limits, to force sending absolutely all messages.
#
# Revision 1.29  2004/11/19 20:51:24  jimmyo
# New notification system finished (I think).
#
# Revision 1.28  2004/11/18 00:22:01  jimmyo
# Midway implementation of new notification scheme.
#
# Revision 1.27  2004/11/16 20:00:43  jimmyo
# License cleanups.
#
# Revision 1.26  2004/11/14 20:10:38  jimmyo
# Made sure the latest feature additions also work with the CGI option.
#
# Revision 1.25  2004/11/12 23:18:52  jimmyo
# Added new options notify_enable and notify_text, to allow more finely tuned notifications (both what to notify and what text to send.)
#
# Revision 1.24  2004/09/23 19:46:01  jimmyo
# Added option "compare".
#
# Revision 1.23  2004/09/23 16:52:55  jimmyo
# Don't show warnings/criticals in the HTML interface if the field/graph isn't plotted.
#
# Revision 1.22  2004/09/23 16:43:39  jimmyo
# Don't show warnings/criticals in the HTML interface if the field/graph isn't plotted.
#
# Revision 1.21  2004/09/13 21:00:38  jimmyo
# Added new config option "local_address", to specify which local address outgoing connections (from munin-update) should be used.
#
# Revision 1.20  2004/09/10 19:24:18  jimmyo
# Added new option "graph_sums" which creates summarised graphs.
#
# Revision 1.19  2004/09/07 21:45:37  jimmyo
# Changes of min and max values now causes corresponding changes in the RRD files.
#
# Revision 1.18  2004/09/04 21:33:13  jimmyo
# Handle strange characters better.
#
# Revision 1.17  2004/09/01 19:00:22  jimmyo
# Moved function get_picture_filename from munin-graph to Munin.pm.
#
# Revision 1.16  2004/09/01 18:30:21  jimmyo
# Added new options "graph_height" and "graph_width", to beter control size.
#
# Revision 1.15  2004/08/23 10:01:07  jimmyo
# Better error handling when fetching data from RRD files.
#
# Revision 1.14  2004/08/23 09:23:46  jimmyo
# Better error handling when fetching data from rrd files.
#
# Revision 1.13  2004/07/02 14:19:06  jimmyo
#   * Munin-graph: Added 'graph_sources' option. This is (in effect) the same as
#     graph_order, but with a default of 'graph no'.
#
# Revision 1.12  2004/06/24 14:32:17  jimmyo
# More work on output_graphs (renamed to graph_strategy, amongst others).
#
# Revision 1.11  2004/06/23 17:38:39  jimmyo
# * Created munin-cgi-graph, which creates dynamic graphs.
# * Added munin.conf option "output_graphs (cgi|cron)" which
#   defaults to cron.
#
# Revision 1.10  2004/06/08 15:30:31  jimmyo
# The server programs now open the log file at an earlier point.
#
# Revision 1.9  2004/06/08 15:18:21  jimmyo
# The server programs now open the log file at an earlier point.
#
# Revision 1.8  2004/05/20 22:30:08  jimmyo
# * Munin-limits added to distro.
# * Breached limis now show up in overview and node view.
#
# Revision 1.7  2004/05/20 20:47:19  jimmyo
# The server programs now open the log file at an earlier point.
#
# Revision 1.6  2004/05/20 12:20:24  jimmyo
# Added "graph_category" option, to categorise plugins.
#
# Revision 1.5  2004/05/16 11:27:39  jimmyo
# Added warning and critical statuses to the info table in the service view.
#
# Revision 1.4  2004/05/16 00:33:07  jimmyo
# Added a descriptionary table at the bottom of the service view page. Also added "graph_info" and "<field>.info" which can be used by plugins to supply supplementary information for it.
#
# Revision 1.3  2004/01/29 18:19:58  jimmyo
# Made Munin compatible with perl 5.005_03 (patch by Lupe Christoph) (SF#884622)
#
# Revision 1.2  2004/01/15 15:20:01  jimmyo
# Making things workable after name change. Upping for test verwion.
#
# Revision 1.1  2004/01/02 18:50:01  jimmyo
# Renamed occurrances of lrrd -> munin
#
# Revision 1.1.1.1  2004/01/02 15:18:07  jimmyo
# Import of LRRD CVS tree after renaming to Munin
#
# Revision 1.29  2003/12/12 18:59:30  jimmyo
# Change \1 to  to make lrrd-update shut up.
#
# Revision 1.28  2003/12/10 11:59:39  jimmyo
# Enable/disable notifications at any level
#
# Revision 1.27  2003/12/06 20:19:55  jimmyo
# Typo fix
#
# Revision 1.26  2003/12/06 19:12:57  jimmyo
# Added max_processes config variable. Also, removed zombie-generation code. :-P
#
# Revision 1.25  2003/12/06 17:13:56  jimmyo
# Can now escape #. Can now use \ to join lines.
#
# Revision 1.24  2003/12/02 11:48:56  jimmyo
# Forgot small change
#
# Revision 1.23  2003/12/02 10:14:43  jimmyo
# Moved some functions to LRRD.pm, since other programs use them as well.
#
# Revision 1.22  2003/11/24 16:25:51  jimmyo
# Make sure LRRD doesn't write any illegal lines to the datafile
#
# Revision 1.21  2003/11/24 14:22:10  jimmyo
# 0.9.9 release 2. Fixes a couple of stupid (minor) bugs
#
# Revision 1.20  2003/11/24 12:58:01  jimmyo
# minor bugfix - no noise about "extinfo"
#
# Revision 1.19  2003/11/16 11:33:16  jimmyo
# Minor bugfixes
#
# Revision 1.18  2003/11/15 13:26:01  jimmyo
# Added warn to legal options
#
# Revision 1.17  2003/11/15 11:10:29  jimmyo
# Various fixes
#
# Revision 1.16  2003/11/10 16:09:00  jimmyo
# Be nice to Nagios - don't DOS it.
#
# Revision 1.15  2003/11/07 23:57:05  jimmyo
# Remove trailing whitespace from config file
#
# Revision 1.14  2003/11/07 22:58:09  jimmyo
# Documentation of new features/changes
#
# Revision 1.13  2003/11/07 20:46:12  jimmyo
# Only require Config::General if using old config format.
#
# Revision 1.12  2003/11/07 20:12:02  jimmyo
# datafile now saved in new config format
#
# Revision 1.11  2003/11/07 17:43:16  jimmyo
# Cleanups and log entries
#
#


use Exporter;
@ISA = ('Exporter');
@EXPORT = ('munin_trend', 
	   'munin_fetch', 
	   'munin_nscasend', 
	   'munin_createlock',
	   'munin_removelock',
	   'munin_runlock',
	   'munin_getlock',
	   'munin_readconfig',
	   'munin_writeconfig',
	   'munin_delete',
	   'munin_overwrite',
	   'munin_config',
	   'munin_draw_field',
	   'munin_get_bool',
	   'munin_get_bool_val',
	   'munin_get',
	   'munin_field_status',
	   'munin_service_status',
	   'munin_node_status',
	   'munin_category_status',
	   'munin_get_picture_filename',
	   'munin_get_filename',
	   'munin_graph_column_headers',
	   'munin_get_max_label_length',
	   'munin_get_field_order',
	   'munin_get_rrd_filename'
	   );

use strict;
use RRDs;
use Fcntl qw(:DEFAULT :flock);
use IO::Handle;
use Symbol 'gensym';

my $nsca = new IO::Handle;
my $config = undef;

my $VERSION = "1.2.5";

my $DEBUG=0;
my $configfile="/etc/munin/munin.conf";

my @legal = ("tmpldir", "ncsa", "ncsa_server", "ncsa_config", "rundir",
	"dbdir", "logdir", "htmldir", "include", "domain_order", "node_order", 
	"graph_order", "graph_sources", "fork", "graph_title", "create_args", 
	"graph_args", "graph_vlabel", "graph_vtitle", "graph_total", 
	"graph_scale", "graph", "update", "host_name", "label", "cdef", "draw", 
	"graph", "max", "min", "negative", "skipdraw", "type", "warning", 
	"critical", "special_stack", "special_sum", "stack", "sum", "address", 
	"htaccess", "warn", "use_default_name", "use_node_name", "port", 
	"graph_noscale", "nsca", "nsca_server", "nsca_config", "extinfo", 
	"fetch_data", "filename", "max_processes", "nagios", "info", 
	"graph_info", "graph_category", "graph_strategy", "graph_width", 
	"graph_height", "graph_sums", "local_address", "compare",
	"text", "command", "contact", "contacts",  "max_messages", 
	"always_send", "notify_alias", "line", "state", "graph_period",
	"cgiurl_graph", "cgiurl", "service_order", "category_order",
	"version", "colour"
    );

my %legal_expanded = map { $_ => 1 } @legal;

# Fields to copy when "aliasing" a field
my @copy_fields    = ("label", "draw", "type", "rrdfile", "fieldname", "info"); 


sub munin_trend {
    my (@array) = @_;
    return ($array[$#array] - $array[0]);
}

sub munin_fetch {
    my ($file,$last,$type) = @_;
    my ($start,$step,$names,$data) = RRDs::fetch $file,$type || "AVERAGE";
    unless (defined $data)
    {
        ::logger ("Could not fetch data from $file(".($type||"AVERAGE")."): ". RRDs::error);
        return undef;
    }
    my @array = map { @$_[0] } splice(@$data, $#$data - ($last || 1));
    return $array[0] if (!$last);
    return @array;
}

sub munin_draw_field {
    my $node    = shift;
    my $service = shift;
    my $field   = shift;

    $field =~ s/=.*//;

    print "DEBUG: munin_draw_field: Checking $service -> $field: " . &munin_get_bool_val ($node->{client}->{$service}->{$field.".graph"}, 1) . ".\n" if $DEBUG;;
    return 0 if (exists $node->{client}->{$service}->{$field.".skipdraw"});
    return (&munin_get_bool_val ($node->{client}->{$service}->{$field.".graph"}, 1));
}

sub munin_nscasend {
    my ($name,$service,$label,$level,$comment) = @_;

    if (!$nsca->opened)
    {
	open ($nsca ,"|$config->{nsca} $config->{nsca_server} -c $config->{nsca_config} -to 60");
    }
    if ($label)
    {
	print $nsca  "$name\t$service: $label\t$level\t$comment\n";
	print ("$name;$service: $label;$level;$comment\n") if $DEBUG;
    }
    else
    {
	print $nsca  "$name\t$service\t$level\t$comment\n";
	print ("$name;$service;$level;$comment\n") if $DEBUG;
    }
}

sub munin_createlock {
  my ($lockname) = @_;
  if (-e $lockname && (! -w $lockname || ! -f $lockname)) {
      die "Error writing to $lockname, wrong permissions";
  }
  if (sysopen (LOCK,$lockname,O_WRONLY | O_CREAT | O_EXCL)) {
    print "Creating lock : $lockname succeded\n" if $DEBUG;
    print LOCK $$; # we want the pid inside for later use
    close LOCK;
    return 1;
  } else {
    print "Creating lock : $lockname failed, skipping\n" if $DEBUG;
    return 0;
  }
}

sub munin_removelock {
  my ($lockname) = @_;
  if (-e $lockname && ! -w $lockname) {
      die "Error deleting $lockname, wrong permissions";
  }
  if (-e $lockname) {
    unlink $lockname;
    print "Deleting lock : $lockname\n" if $DEBUG;
  } else {
    print "Deleting lock : $lockname not found, skipping\n" if $DEBUG;
  }
}

sub munin_runlock {
    my ($lockname) = @_;
    unless (&munin_getlock($lockname)) {
	print "Lock already exists: $lockname. Dying.\n";
	exit 0;
    }
    return 1;
}

sub munin_getlock {
  my ($lockname) = @_;
    unless (&munin_createlock($lockname)) {
      # Is the lockpid alive?
      open LOCK,$lockname;
      my $pid = <LOCK>;
      if ($pid =~ /^\d+$/ and kill(0,$pid)) {
	  return 0;
      }
      &munin_removelock ($lockname);
      &munin_createlock($lockname);
    }
    return 1;
}


sub munin_delete {
    my ($config,$data) = @_;
    for my $domain (keys %{$data->{domain}}) {
	unless ($config->{domain}->{$domain}) {
	    ::logger("Removing domain: $domain");
	    delete ($data->{domain}->{$domain});
	    next;
	}
	for my $node (keys %{$data->{domain}->{$domain}->{node}}) {
	    unless ($config->{domain}->{$domain}->{node}->{$node}) {
		::logger("Removing node from $domain: $node");
		delete ($data->{domain}->{$domain}->{node}->{$node});
	    }
	}
    }
    return ($data);
}
sub munin_overwrite {
    my ($configfile,$overwrite) = @_;
    for my $key (keys %$overwrite) {
	if (ref $overwrite->{$key}) {
	    &munin_overwrite($overwrite->{$key},$configfile->{$key});
	}
	$configfile->{$key} = $overwrite->{$key};
    }
    return ($configfile);
}

sub munin_readconfig {
    my ($conf, $missingok, $corruptok) = @_;
    my $config   = undef;
    my @contents = undef;

    $conf ||= $configfile;
    if (! -r $conf and ! $missingok) {
		::logger ("munin_readconfig: cannot open '$conf'");
		return undef;
    }
    if (open (CFG, $conf))
    {
	@contents = <CFG>;
	close (CFG);
    }

    $config = &munin_parse_config (\@contents);

    # Some important defaults before we return...
    $config->{'rundir'} ||= "/tmp/";
    $config->{'dbdir'}  ||= "/var/lib/munin/";
    $config->{'logdir'} ||= "/var/log/";
    $config->{'tmpldir'}||= "/etc/munin/templates/";
    $config->{'htmldir'}||= "/var/www/html/munin/";
    return ($config);
}

sub munin_parse_config
{
    my $lines    = shift;
    my $hash     = undef;
    my $prefix   = "";
    my $prevline = "";

    foreach my $line (@{$lines})
    {
	chomp $line;
#$line =~ s/(^|[^\\])#.*/$1/g if $line =~ /#/;  # Skip comments...
	if ($line =~ /#/)
	{ 
	    next if ($line =~ /^#/);
	    $line =~ s/(^|[^\\])#.*/$1/g;
	}
	next unless ($line =~ /\S/);  # And empty lines...
	if (length $prevline)
	{
	    $line = $prevline . $line;
	    $prevline = "";
	}
	if ($line =~ /\\\\$/)
	{
	    $line =~ s/\\\\$/\\/;
	}
	elsif ($line =~ /\\$/)
	{
	    ($prevline = $line) =~ s/\\$//;
	    next;
	}
	$line =~ s/\s+$//g;           # And trailing whitespace...
	$line =~ s/^\s+//g;           # And heading whitespace...

	if ($line =~ /^\.(\S+)\s+(.+)\s*$/)
	{
	    my ($var, $val) = ($1, $2);
	    $hash = &munin_set_var_path ($hash, $var, $val);
	}
	elsif ($line =~ /^\s*\[([^\]]*)]\s*$/)
	{
	    $prefix = $1;
	    if ($prefix =~ /^([^:;]+);([^:;]+)$/)
	    {
		$prefix .= ":";
	    }
	    elsif ($prefix =~ /^([^:;]+);$/)
	    {
		$prefix .= "";
	    }
	    elsif ($prefix =~ /^([^:;]+);([^:;]+):(.*)$/)
	    {
		$prefix .= ".";
	    }
	    elsif ($prefix =~ /^([^:;]+)$/)
	    {
		(my $domain = $prefix) =~ s/^[^\.]+\.//;
		$prefix = "$domain;$prefix:";
	    }
	    elsif ($prefix =~ /^([^:;]+):(.*)$/)
	    {
		(my $domain = $prefix) =~ s/^[^\.]+\.//;
		$prefix = "$domain;$prefix.";
	    }
	}
	elsif ($line =~ /^\s*(\S+)\s+(.+)\s*$/)
	{
	    my ($var, $val) = ($1, $2);
	    $hash = &munin_set_var_path ($hash, "$prefix$var", $val);
	}
	else
	{
	    warn "Malformed configuration line \"$line\".";
	}
    }

    return $hash;
}

sub munin_get_var_path
{
    my $hash = shift;
    my $var  = shift;
    my $val  = shift;

    print "DEBUG: Getting var \"$var\" = \"$val\"\n" if $DEBUG;
    if ($var =~ /^\s*([^;:]+);([^;:]+):(\S+)\s*$/)
    {
	my ($dom, $host, $rest) = ($1, $2, $3);
	my @sp = split (/\./, $rest);

	if (@sp == 3)
	{
	    return $hash->{domain}->{$dom}->{node}->{$host}->{client}->{$sp[0]}->{"$sp[1].$sp[2]"};
	}
	elsif (@sp == 2)
	{
	    return $hash->{domain}->{$dom}->{node}->{$host}->{client}->{$sp[0]}->{$sp[1]};
	}
	elsif (@sp == 1)
	{
	    return $hash->{domain}->{$dom}->{node}->{$host}->{$sp[0]};
	}
	else
	{
	    warn "munin_set_var: Malformatted variable path \"$var\".";
	}
    }
    elsif ($var =~ /^\s*([^;:]+);([^;:]+)\s*$/)
    {
	my ($dom, $rest) = ($1, $2);
	my @sp = split (/\./, $rest);

	if (@sp == 1)
	{
	    return $hash->{domain}->{$dom}->{$sp[0]};
	}
	else
	{
	    warn "munin_set_var: Malformatted variable path \"$var\".";
	}
    }
    elsif ($var =~ /^\s*([^;:\.]+)\s*$/)
    {
	return $hash->{$1};
    }
    else
    {
	warn "munin_set_var: Malformatted variable path \"$var\".";
    }

    return undef;
}

sub munin_set_var_path
{
    my $hash = shift;
    my $var  = shift;
    my $val  = shift;

    print "DEBUG: Setting var \"$var\" = \"$val\"\n" if $DEBUG;
    if ($var =~ /^\s*([^;:]+);([^:]+):(\S+)\s*$/)
    {
	my ($dom, $host, $rest) = ($1, $2, $3);
	my @sp = split (/\./, $rest);

	if (@sp == 3)
	{
	    ::logger ("Warning: Unknown option \"$sp[2]\" in \"$dom;$host:$sp[0].$sp[1].$sp[2]\".")
		unless defined $legal_expanded{$sp[2]};
	    $hash->{domain}->{$dom}->{node}->{$host}->{client}->{$sp[0]}->{"$sp[1].$sp[2]"} = $val;
	}
	elsif (@sp == 2)
	{
	    ::logger ("Warning: Unknown option \"$sp[1]\" in \"$dom;$host:$sp[0].$sp[1]\".")
		unless defined $legal_expanded{$sp[1]};
	    $hash->{domain}->{$dom}->{node}->{$host}->{client}->{$sp[0]}->{$sp[1]} = $val;
	}
	elsif (@sp == 1)
	{
	    ::logger ("Warning: Unknown option \"$sp[0]\" in \"$dom;$host:$sp[0]\".")
		unless defined $legal_expanded{$sp[0]};
	    $hash->{domain}->{$dom}->{node}->{$host}->{$sp[0]} = $val;
	}
	else
	{
	    warn "munin_set_var: Malformatted variable path \"$var\".";
	}
    }
    elsif ($var =~ /^\s*([^;:]+);([^;:]+)\s*$/)
    {
	my ($dom, $rest) = ($1, $2);
	my @sp = split (/\./, $rest);

	if (@sp == 1)
	{
	    ::logger ("Warning: Unknown option \"$sp[0]\" in \"$dom;$sp[0]\".")
		unless defined $legal_expanded{$sp[0]};
	    $hash->{domain}->{$dom}->{$sp[0]} = $val;
	}
	else
	{
	    warn "munin_set_var: Malformatted variable path \"$var\".";
	}
    }
    elsif ($var =~ /^\s*([^;:\.]+)\s*$/)
    {
	::logger ("Warning: Unknown option \"$1\" in \"$1\".")
	    unless defined $legal_expanded{$1};
	$hash->{$1} = $val;
    }
    elsif ($var =~ /^\s*([^\.]+)\.([^\.]+)\.([^\.]+)$/)
    {
	::logger ("Warning: Unknown option \"$1\" in \"$var\".")
	    unless defined $legal_expanded{$1};
	::logger ("Warning: Unknown option \"$3\" in \"$var\".")
	    unless defined $legal_expanded{$3};
	$hash->{$1}->{$2}->{$3} = $val;
    }
    else
    {
	warn "munin_set_var: Malformatted variable path \"$var\".";
    }

    return $hash;
}

sub munin_writeconfig_loop {
    my ($data,$fh,$pre) = @_;
    $pre |= "";

    # Write datafile
    foreach my $a (keys %{$data})
    {
	if (ref ($data->{$a}) eq "HASH")
	{
	    if ($a eq "domain" or $a eq "node" or $a eq "client")
	    {
		&munin_writeconfig_loop ($data->{$a}, $fh, "$pre");
	    }
	    elsif ($a eq "contact" and $pre eq "")
	    {
		&munin_writeconfig_loop ($data->{$a}, $fh, "contact.");
	    }
	    else
	    {
		my $lpre = $pre;
		if ($lpre eq "")
		{
		    $lpre = $a.";";
		}
		elsif ($lpre =~ /;$/)
		{
		    $lpre .= $a.":";
		}
		else
		{
		    $lpre .= $a.".";
		}
		&munin_writeconfig_loop ($data->{$a}, $fh, "$lpre");
	    }
	}
	elsif (defined $data->{$a} and length $data->{$a})
	{
	    next if "$pre$a" eq "version"; # Handled separately
	    print "Writing: $pre$a $data->{$a}\n" if $DEBUG;
	    if ($data->{$a} =~ /\\$/)
	    { # Backslash as last char has special meaning. Avoid it.
		print $fh "$pre$a $data->{$a}\\\n"; 
	    } else {
		print $fh "$pre$a $data->{$a}\n";
	    }
	}
    }
}
sub munin_writeconfig {
    my ($datafilename,$data,$fh) = @_;
#   my $datafile = new Config::General();
#   $datafile->save_file($datafilename,$data);

    if (!defined $fh)
    {
	$fh = gensym();
	unless (open ($fh, ">$datafilename"))
	{
	    die "Fatal error: Could not open \"$datafilename\" for writing: $!";
	}
    }

    # Write version
    print $fh "version $VERSION\n";
    # Write datafile
    &munin_writeconfig_loop ($data, $fh, "");
    
    if (defined $fh)
    {
	print "DEBUG: Closing filehandle \"$datafilename\"...\n" if $DEBUG;
	close ($fh);
    }
}
    
sub munin_config {
    my $conffile = shift;
    $config = shift;
    $conffile ||= $configfile;
    $config = &munin_readconfig ($conffile);
    ::logger_open ($config->{logdir});
    my $data = &munin_readconfig("$config->{dbdir}/datafile", 1, 1);
    
    $data = &munin_overwrite($data,$config);
    return ($data);
}

sub munin_get_picture_filename {
    my $config  = shift;
    my $domain  = shift;
    my $name    = shift;
    my $service = shift;
    my $scale   = shift;
    my $sum     = shift;
    my $dir     = $config->{'htmldir'};

    # Sanitise
    $dir =~ s/[^\w_\/"'\[\]\(\)+=-]\./_/g;
    $domain =~ s/[^\w_\/"'\[\]\(\)+=\.-]/_/g;
    $name =~ s/[^\w_\/"'\[\]\(\)+=\.-]/_/g;
    $service =~ s/[^\w_\/"'\[\]\(\)+=-]/_/g;
    $scale =~ s/[^\w_\/"'\[\]\(\)+=-]/_/g;

    if (defined $sum and $sum)
    {
	    return "$dir/$domain/$name-$service-$scale-sum.png";
    }
    else
    {
	    return "$dir/$domain/$name-$service-$scale.png";
    }
}

sub munin_get_filename {
	my ($config,$domain,$node,$service,$field) = @_;

	return ($config->{'dbdir'} . "/$domain/$node-$service-$field-" . lc substr (($config->{domain}->{$domain}->{node}->{$node}->{client}->{$service}->{$field.".type"}||"GAUGE"), 0,1). ".rrd");

}

sub munin_get_bool
{
    my $conf     = shift;
    my $field    = shift;
    my $default  = shift;
    my $domain   = shift;
    my $node     = shift;
    my $service  = shift;
    my $plot     = shift;

    return undef unless defined $field;

    my $ans = &munin_get ($conf, $field, $default, $domain, $node, $service, $plot);
    return undef if not defined $ans;

    if ($ans =~ /^yes$/i or
        $ans =~ /^true$/i or
        $ans =~ /^on$/i or
        $ans =~ /^enable$/i or
        $ans =~ /^enabled$/i
       )
    {
    return 1;
    }
    elsif ($ans =~ /^no$/i or
        $ans =~ /^false$/i or
        $ans =~ /^off$/i or
        $ans =~ /^disable$/i or
        $ans =~ /^disabled$/i
      )
    {
    return 0;
    }
    elsif ($ans !~ /\D/)
    {
    return $ans;
    }
    else
    {
    return undef;
    }
}

sub munin_get_bool_val
{
    my $field    = shift;
    my $default  = shift;

    if (!defined $field)
    {
    if (!defined $default)
    {
        return 0;
    }
    else
    {
        return $default;
    }
    }

    if ($field =~ /^yes$/i or
        $field =~ /^true$/i or
        $field =~ /^on$/i or
        $field =~ /^enable$/i or
        $field =~ /^enabled$/i
       )
    {
    return 1;
    }
    elsif ($field =~ /^no$/i or
        $field =~ /^false$/i or
        $field =~ /^off$/i or
        $field =~ /^disable$/i or
        $field =~ /^disabled$/i
      )
    {
    return 0;
    }
    elsif ($field !~ /\D/)
    {
    return $field;
    }
    else
    {
    return undef;
    }
}

sub munin_get
{
    my $conf     = shift;
    my $field    = shift;
    my $default  = shift;
    my $domain   = shift;
    my $node     = shift;
    my $service  = shift;
    my $plot     = shift;

    if (defined $field)
    {
	return $conf->{domain}->{$domain}->{node}->{$node}->{client}->{$service}->{"$plot.$field"}
		if (defined $domain and defined $node and defined $service and defined $plot and 
			defined $conf->{domain}->{$domain}->{node}->{$node}->{client}->{$service}->{"$plot.$field"});

	

	return $conf->{domain}->{$domain}->{node}->{$node}->{client}->{$service}->{$field}
		if (defined $domain and defined $node and defined $service and 
			defined $conf->{domain}->{$domain}->{node}->{$node}->{client}->{$service}->{$field});
	return $conf->{domain}->{$domain}->{node}->{$node}->{$field}
		if (defined $domain and defined $node and 
			defined $conf->{domain}->{$domain}->{node}->{$node}->{$field});
	return $conf->{domain}->{$domain}->{$field}
		if (defined $domain and defined $conf->{domain}->{$domain}->{$field});
	return $conf->{$field}
		if (defined $conf->{$field});
	return $default;
    }
    else
    {
	return $conf->{domain}->{$domain}->{node}->{$node}->{client}->{$service}
		if (defined $domain and defined $node and defined $service and 
			defined $conf->{domain}->{$domain}->{node}->{$node}->{client}->{$service});
	return $conf->{domain}->{$domain}->{node}->{$node}
		if (defined $domain and defined $node and 
			defined $conf->{domain}->{$domain}->{node}->{$node});
	return $conf->{domain}->{$domain}
		if (defined $domain and defined $conf->{domain}->{$domain});
	return $conf
		if (defined $conf);
	return $default;
    }
}

sub munin_node_status
{
    my ($config, $limits, $domain, $node, $check_draw) = @_;
    my $state = "ok";

    return undef unless defined $config->{domain}->{$domain}->{node}->{$node};
    my $snode = $config->{domain}->{$domain}->{node}->{$node};

    foreach my $service (keys %{$snode})
    {
	my $fres  = &munin_service_status ($config, $limits, $domain, $node, $service, $check_draw);
	if (defined $fres)
	{
	    if ($fres eq "critical")
	    {
		$state = $fres;
		last;
	    }
	    elsif ($fres eq "warning")
	    {
		$state = $fres;
	    }
	}
    }

    return $state;
}

sub munin_category_status
{
    my ($config, $limits, $domain, $node, $category, $check_draw) = @_;
    my $state = "ok";

    return undef unless defined $config->{domain}->{$domain}->{node}->{$node};
    my $snode = $config->{domain}->{$domain}->{node}->{$node};

    foreach my $service (keys %{$snode->{client}})
    {
	next if ((not defined $snode->{client}->{$service}->{graph_category}) and
		$category ne 'other');
	next if ((defined $snode->{client}->{$service}->{graph_category}) and 
		 ($snode->{client}->{$service}->{graph_category} ne $category));

	my $fres  = &munin_service_status ($config, $limits, $domain, $node, $service, $check_draw);
	if (defined $fres)
	{
	    if ($fres eq "critical")
	    {
		$state = $fres;
		last;
	    }
	    elsif ($fres eq "warning")
	    {
		$state = $fres;
	    }
	}
    }

    return $state;
}

sub munin_service_status
{
    my ($config, $limits, $domain, $node, $service, $check_draw) = @_;
    my $state = "ok";

    return undef unless defined $config->{domain}->{$domain}->{node}->{$node}->{client}->{$service};
    foreach my $key (keys %{$config->{domain}->{$domain}->{node}->{$node}->{client}->{$service}})
    {
	next unless $key =~ /^([^\.]+)\.label$/;
	my $field = $1;
	my $fres  = &munin_field_status ($config, $limits, $domain, $node, $service, $field, $check_draw);
	if (defined $fres)
	{
	    if ($fres eq "critical")
	    {
		$state = $fres;
		last;
	    }
	    elsif ($fres eq "warning")
	    {
		$state = $fres;
	    }
	}
    }

    return $state;
}

sub munin_field_status
{
    my ($config, $limits, $domain, $node, $service, $field, $check_draw) = @_;
    my $state = undef;

    # Return undef if nagios is turned off, or the field doesn't have any limits
    unless ((defined $config->{domain}->{$domain}->{node}->{$node}->{client}->{$service}->{"$field.warning"}) or
	(defined $config->{domain}->{$domain}->{node}->{$node}->{client}->{$service}->{"$field.critical"}))
    {
	return undef;
    }

    if (defined $limits->{domain}->{$domain}->{node}->{$node}->{client}->{$service}->{"$field.critical"} and (!defined $check_draw or !$check_draw or 
		&munin_draw_field ($config->{domain}->{$domain}->{node}->{$node}, $service, $field)))
    {
	return "critical";
    }
    elsif (defined $limits->{domain}->{$domain}->{node}->{$node}->{client}->{$service}->{"$field.warning"} and (!defined $check_draw or !$check_draw or 
		&munin_draw_field ($config->{domain}->{$domain}->{node}->{$node}, $service, $field)))
    {
	return "warning";
    }
    else
    {
	return "ok";
    }
}

sub munin_graph_column_headers
{
    my ($config, $domain, $node, $serv) = @_;
    my $ret = 0;
    my @fields = ();

    foreach my $field (keys %{$config->{domain}->{$domain}->{node}->{$node}->{client}->{$serv}})
    {
	if ($field =~ /^([^\.]+)\.negative$/ and munin_draw_field ($config->{domain}->{$domain}->{node}->{$node}, $serv, $1))
	{
	    return 1;
	}
	elsif ($field =~ /^([^\.]+)\.label$/ and munin_draw_field ($config->{domain}->{$domain}->{node}->{$node}, $serv, $1))
	{
	    push @fields, $1;
	}
    }

    return 1 if (munin_get_max_label_length ($config->{'domain'}->{$domain}->{'node'}->{$node}, $config, $domain, $node, $serv, \@fields) > 20);

    return $ret;
}

sub munin_get_max_label_length
{
    my $node    = shift;
    my $config  = shift;
    my $domain  = shift;
    my $host    = shift;
    my $service = shift;
    my $order   = shift;
    my $result  = 0;

    for my $field (@$order) {
	my $path = undef;
	(my $f = $field) =~ s/=.+//;
	next if (exists $node->{client}->{$service}->{$f.".process"} and
		 $node->{client}->{$service}->{$f.".process"} ne "yes");
	next if (exists $node->{client}->{$service}->{$f.".skipdraw"});
	next unless (!exists $node->{client}->{$service}->{$f.".graph"} or
			$node->{client}->{$service}->{$f.".graph"} eq "yes");
	if ($result < length ($node->{client}->{$service}->{$f.".label"} || $f)) {
	    $result = length ($node->{client}->{$service}->{$f.".label"} || $f);
	}
	if (exists $node->{client}->{$service}->{graph_total} and 
		length $node->{client}->{$service}->{graph_total} > $result)
	{
	    $result = length $node->{client}->{$service}->{graph_total};
	}
    }
    return $result;
}

sub munin_get_field_order
{
    my $node    = shift;
    my $config  = shift;
    my $domain  = shift;
    my $host    = shift;
    my $service = shift;
    my $result  = [];

    if ($node->{client}->{$service}->{graph_sources}) 
    {
	foreach my $gs (split /\s+/, $node->{client}->{$service}->{'graph_sources'})
	{
	    push (@$result, "-".$gs);
	}
    } 
    if ($node->{client}->{$service}->{graph_order}) 
    {
	push (@$result, split /\s+/, $node->{client}->{$service}->{'graph_order'});
    } 

    for my $key (keys %{$node->{client}->{$service}}) 
    {
	my ($client,$type)="";
	($client,$type) = split /\./,$key;
	if (defined $type and $type eq "label") 
	{
	    push @$result,$client if !grep /^\Q$client\E(?:=|$)/, @$result;;
	} 
    }
    
    return $result;
}

sub munin_get_rrd_filename {
    my $node    = shift;
    my $config  = shift;
    my $domain  = shift;
    my $name    = shift;
    my $service = shift;
    my $field   = shift;
    my $path    = shift;
    my $result  = "unknown";

    if ($node->{client}->{$service}->{$field.".filename"})
    {
	$result = $node->{client}->{$service}->{$field.".filename"};
    }
    elsif ($path)
    {
	if (!defined ($node->{client}->{$service}->{$field.".label"}))
	{
	    print "DEBUG: Setting label: $field\n" if $DEBUG;
	    $node->{client}->{$service}->{$field.".label"} = $field;
	}

	if ($path =~ /^\s*([^:;]+)[:;]([^:]+):([^:\.]+)[:\.]([^:\.]+)\s*$/)
	{
	    $result = munin_get_filename ($config, $1, $2, $3, $4);
	    print "\nDEBUG1: Expanding $path...\n" if $DEBUG;
	    if (! defined $node->{client}->{$service}->{$field."label"})
	    {
		for my $f (@copy_fields)
		{
		    if (not exists $node->{client}->{$service}->{"$field.$f"} and
			    exists $config->{'domain'}->{$1}->{'node'}->{$2}->{'client'}->{$3}->{"$4.$f"})
		    {
			$node->{client}->{$service}->{"$field.$f"} = $config->{'domain'}->{$1}->{'node'}->{$2}->{'client'}->{$3}->{"$4.$f"};
		    }
		}
	    }
	}
	elsif ($path =~ /^\s*([^:]+):([^:\.]+)[:\.]([^:\.]+)\s*$/)
	{
	    print "\nDEBUG2: Expanding $path...\n" if $DEBUG;
	    $result = munin_get_filename ($config, $domain, $1, $2, $3);
	    for my $f (@copy_fields)
	    {
		if (not exists $node->{client}->{$service}->{"$field.$f"} and
			exists $config->{'domain'}->{$domain}->{'node'}->{$1}->{'client'}->{$2}->{"$3.$f"})
		{
		    print "DEBUG: Copying $f...\n" if $DEBUG;
		    $node->{client}->{$service}->{"$field.$f"} = $config->{'domain'}->{$domain}->{'node'}->{$1}->{'client'}->{$2}->{"$3.$f"};
		}
	    }
	}
	elsif ($path =~ /^\s*([^:\.]+)[:\.]([^:\.]+)\s*$/)
	{
	    print "\nDEBUG3: Expanding $path...\n" if $DEBUG;
	    $result = munin_get_filename ($config, $domain, $name, $1, $2);
	    for my $f (@copy_fields)
	    {
		if (not exists $node->{client}->{$service}->{"$field.$f"} and
			exists $node->{client}->{$1}->{"$2.$f"})
		{
		    $node->{client}->{$service}->{"$field.$f"} = $node->{client}->{$1}->{"$2.$f"};
		}
	    }
	}
	elsif ($path =~ /^\s*([^:\.]+)\s*$/)
	{
	    print "\nDEBUG4: Expanding $path...\n" if $DEBUG;
	    $result = munin_get_filename ($config, $domain, $name, $service, $1);
	    for my $f (@copy_fields)
	    {
		if (not exists $node->{client}->{$service}->{"$field.$f"} and
			exists $node->{client}->{$service}->{"$1.$f"})
		{
		    $node->{client}->{$service}->{"$field.$f"} = $node->{client}->{$service}->{"$1.$f"};
		}
	    }
	}
    }
    else
    {
	print "\nDEBUG5: Doing path...\n" if $DEBUG;
	$result = munin_get_filename($config, $domain,$name,$service,$field);
    }
    return $result;
}


1;

# vim: syntax=perl ts=8

Anon7 - 2021