|
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/local/src/munin-1.2.6/server/ |
Upload File : |
#!@@PERL@@ -w
# -*- cperl -*-
#
# Copyright (C) 2002-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.
#
# Script to update the RRD-files with current information.
#
# $Id: munin-update.in 1474 2008-02-18 01:00:00Z matthias $
$|=1;
use strict;
use IO::Socket;
use Munin;
use Time::HiRes;
use RRDs;
use Getopt::Long;
use POSIX qw(strftime);
use POSIX ":sys_wait_h";
use Storable qw(fd_retrieve nstore_fd);
my $TIMEOUT = 240;
my $DEBUG=0;
my $VERSION="@@VERSION@@";
my $serversocket = "munin-server-socket.$$";
my $conffile = "@@CONFDIR@@/munin.conf";
my $force_root = 0;
my $do_usage = 0;
my @limit_hosts = ();
my @limit_services = ();
my $update_time= Time::HiRes::time;
my $do_fork = 1;
my $do_version = 0;
my $timeout = 180;
my $cli_do_fork;
my $cli_timeout;
my $print_stdout = 0;
my $log = new IO::Handle;
# Get options
$do_usage=1 unless
GetOptions ( "host=s" => \@limit_hosts,
"force-root!" => \$force_root,
"service=s" => \@limit_services,
"config=s" => \$conffile,
"debug!" => \$DEBUG,
"version!" => \$do_version,
"fork!" => \$cli_do_fork,
"timeout=i" => \$cli_timeout,
"stdout!" => \$print_stdout,
"help" => \$do_usage );
if ($do_usage)
{
print "Usage: $0 [options]
Options:
--[no]force-root Force running, even as root. [--noforce-root]
--version View version information.
--help View this message.
--service <service> Limit graphed services to <service>. Multiple --service
options may be supplied.
--host <host> Limit graphed hosts to <host>. Multiple --host options
may be supplied.
--config <file> Use <file> as configuration file.
[@@CONFDIR@@/munin.conf]
--[no]debug View debug messages. [--nodebug]
--[no]fork Don't fork one instance for each host. [--fork]
--[no]stdout Print log messages to stdout as well. [--nostdout]
--timeout=<seconds> TCP timeout when talking to clients. [$timeout]
";
exit 0;
}
if ($do_version)
{
print "munin-update version $VERSION.\n";
print "Written by Audun Ytterdal, Jimmy Olsen, Tore Anderson / Linpro AS\n";
print "\n";
print "Copyright (C) 2002-2004\n";
print "This is free software released under the GNU Public License. There is NO\n";
print "warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n";
exit 0;
}
if ($> == 0 and !$force_root)
{
print "You are running this program as root, which is neither smart nor necessary.
If you really want to run it as root, use the --force-root option. Else, run
it as the user \"munin\". Aborting.\n\n";
exit (1);
}
my $config= &munin_readconfig ($conffile);
my $oldconfig;
if (-e "$config->{dbdir}/datafile") {
$oldconfig= &munin_readconfig("$config->{dbdir}/datafile", 1, 1);
}
# CLI parameters override the configuration file.
if (defined $cli_timeout)
{
$timeout = $cli_timeout;
}
elsif (exists $config->{'timeout'})
{
$timeout = $config->{'timeout'};
}
if (defined $cli_do_fork)
{
$do_fork = $cli_do_fork;
}
elsif (exists $config->{'fork'})
{
$do_fork = ($config->{'fork'} =~ /yes/i ? 1 : 0);
}
if (! -d $config->{rundir})
{
mkdir ($config->{rundir}, 0700);
}
munin_runlock("$config->{rundir}/munin-update.lock");
if (!open (STATS,">$config->{dbdir}/munin-update.stats.tmp")) {
logger("Unable to open $config->{dbdir}/munin-update.stats");
# Use /dev/null instead - if the admin won't fix he won't care
open(STATS,">/dev/null") or die "Could not open STATS to /dev/null: $?";
}
my %children = ();
my @queue = ();
my $bad_procs = 0;
my $uaddr;
if ($do_fork)
{
# Set up socket
$uaddr = sockaddr_un("$config->{rundir}/$serversocket");
socket (Server, PF_UNIX, SOCK_STREAM, 0) || die "socket: $!";
unlink ("$config->{'rundir'}/$serversocket");
bind (Server, $uaddr);
chmod (0700, "$config->{rundir}/$serversocket");
listen (Server, SOMAXCONN);
}
logger("Starting munin-update");
for my $key (keys %{$config->{domain}}) {
my $domain_time = Time::HiRes::time;
logger ("Processing domain: $key");
process_domain($key);
$domain_time = sprintf ("%.2f",(Time::HiRes::time - $domain_time));
print STATS "UD|$key|$domain_time\n";
logger ("Processed domain: $key ($domain_time sec)");
}
#sub REAPER {
# my $child;
# my $waitedpid;
# while (($waitedpid = waitpid(-1,WNOHANG)) > 0) {
# logger ("reaped $waitedpid" . ($? ? " with exit $?" : ''));
# }
# $SIG{CHLD} = \&REAPER; # loathe sysV
#}
#
#$SIG{CHLD} = \&REAPER;
if ($do_fork)
{
my $timeout_start = time();
$SIG{ALRM} = sub { die "Timed out waiting for children. $!\n"};
alarm ($TIMEOUT);
for (;(scalar (keys %children) - $bad_procs > 0);)
{
eval {
$SIG{ALRM} = sub {
foreach my $key (keys %children)
{
if (waitpid ($key, WNOHANG) != 0)
{
my $domain = $children{$key}->[0];
my $name = $children{$key}->[1];
my $oldnode = $children{$key}->[3];
logger ("Child has unexpectedly died: $domain -> $name.");
delete $children{$key};
use_old_config ($domain, $name, $oldnode);
}
}
die;
};
alarm (10);
accept (Client, Server);
};
alarm ($TIMEOUT - time() + $timeout_start);
if ($@)
{
if (@queue and defined $config->{max_processes} and
$config->{max_processes})
{
while (keys %children < ($config->{max_processes}-1-$bad_procs))
{
my $args = pop @queue;
logger ("de-queueing new connection: $args->[1]");
do_node($args->[0], $args->[1], $args->[2], $args->[3]);
}
}
next;
}
close STDIN;
open (STDIN, "<&Client") || die "can't dup client to stdin";
my $pid;
my $name;
my $domain;
my $tmpref;
eval {
$tmpref = fd_retrieve (\*STDIN);
};
if ($@)
{
$bad_procs++;
logger ("Error communicating with process: $@");
}
else
{
($pid, $domain, $name) = ($tmpref->[0], $tmpref->[1], $tmpref->[2]);
logger ("connection from $domain -> $name ($pid)");
eval {
$config->{domain}->{$domain}->{node}->{$name} = fd_retrieve (\*STDIN);
};
if ($@)
{
logger ("Error during fd_retrieve of config: $@");
my $domain = $children{$pid}->[0];
my $name = $children{$pid}->[1];
my $oldnode = $children{$pid}->[3];
use_old_config ($domain, $name, $oldnode);
}
delete $children{$pid};
waitpid ($pid, 0);
logger ("connection from $domain -> $name ($pid) closed");
}
if (@queue and defined $config->{max_processes} and
$config->{max_processes} and
scalar (keys %children) < (($config->{max_processes})-1-$bad_procs))
{
my $args = pop @queue;
logger ("de-queueing new connection: $args->[1]");
do_node($args->[0], $args->[1], $args->[2], $args->[3]);
close (Client);
}
}
alarm (0);
}
if ($bad_procs) # Use old configuration for killed children
{
foreach my $key (keys %children)
{
my $domain = $children{$key}->[0];
my $name = $children{$key}->[1];
my $node = $children{$key}->[2];
my $oldnode = $children{$key}->[3];
use_old_config ($domain, $name, $oldnode);
logger ("Attempting to use old configuration for $domain -> $name.");
}
}
unlink ("$config->{rundir}/$serversocket");
my $overwrite = &munin_readconfig($conffile);
$config = &munin_overwrite($config,$overwrite);
&compare_configs ($oldconfig, $config);
if (&munin_getlock("$config->{rundir}/munin-datafile.lock")) {
&munin_writeconfig("$config->{dbdir}/datafile",$config);
} else {
die "Could not create lockfile '$config->{rundir}/munin-update.lock'";
}
$update_time = sprintf ("%.2f",(Time::HiRes::time - $update_time));
print STATS "UT|$update_time\n";
close (STATS);
rename ("$config->{dbdir}/munin-update.stats.tmp", "$config->{dbdir}/munin-update.stats");
logger("Munin-update finished ($update_time sec)");
munin_removelock("$config->{rundir}/munin-datafile.lock");
munin_removelock("$config->{rundir}/munin-update.lock");
close ($log);
# compare_configs is used to monitor for config changes which we
# have to act upon.
sub compare_configs {
my $old = shift;
my $new = shift;
foreach my $dom (%{$new->{domain}})
{
foreach my $host (%{$new->{domain}->{$dom}->{node}})
{
foreach my $serv (%{$new->{domain}->{$dom}->{node}->{$host}->{client}})
{
foreach my $field (%{$new->{domain}->{$dom}->{node}->{$host}->{client}->{$serv}})
{
next unless $field =~ /\.label$/;
my $just_upgraded = 0;
if (!defined $old->{version} or
$old->{version} ne $VERSION)
{
$just_upgraded = 1;
}
$field =~ s/\.label$//;
if ($just_upgraded or &is_changed ($old, $new, $dom, $host, $serv, $field, "max"))
{
&change_max ($config, $dom, $host, $serv, $field,
(defined $new->{domain}->{$dom}->{node}->{$host}->{client}->{$serv}->{$field.".max"} ?
$new->{domain}->{$dom}->{node}->{$host}->{client}->{$serv}->{$field.".max"} : undef));
}
if ($just_upgraded or &is_changed ($old, $new, $dom, $host, $serv, $field, "min"))
{
&change_min ($config, $dom, $host, $serv, $field,
(defined $new->{domain}->{$dom}->{node}->{$host}->{client}->{$serv}->{$field.".min"} ?
$new->{domain}->{$dom}->{node}->{$host}->{client}->{$serv}->{$field.".min"} : undef));
}
if ($just_upgraded or &is_changed ($old, $new, $dom, $host, $serv, $field, "type"))
{
&change_type ($oldconfig, $config, $dom, $host, $serv, $field,
(defined $new->{domain}->{$dom}->{node}->{$host}->{client}->{$serv}->{$field.".type"} ?
$new->{domain}->{$dom}->{node}->{$host}->{client}->{$serv}->{$field.".type"} : undef));
}
}
}
}
}
}
sub is_changed
{
my $old = shift;
my $new = shift;
my $dom = shift;
my $host = shift;
my $serv = shift;
my $field = shift;
my $setting = shift;
if (defined $new->{domain}->{$dom}->{node}->{$host}->{client}->{$serv}->{$field.".".$setting})
{
if ((!defined $old->{domain}->{$dom}->{node}->{$host}->{client}->{$serv}->{$field.".".$setting}) or
($old->{domain}->{$dom}->{node}->{$host}->{client}->{$serv}->{$field.".".$setting} ne
$new->{domain}->{$dom}->{node}->{$host}->{client}->{$serv}->{$field.".".$setting}
))
{
return 1;
}
}
if (defined $old->{domain}->{$dom}->{node}->{$host}->{client}->{$serv}->{$field.".".$setting})
{
if (!defined $new->{domain}->{$dom}->{node}->{$host}->{client}->{$serv}->{$field.".".$setting})
{
return 1;
}
}
return 0;
}
sub change_type
{
my $oconf = shift;
my $nconf = shift;
my $domain = shift;
my $host = shift;
my $serv = shift;
my $field = shift;
my $val = shift;
my $ofile = &munin_get_filename ($oconf, $domain, $host, $serv, $field);
my $nfile = &munin_get_filename ($nconf, $domain, $host, $serv, $field);
logger ("INFO: Changing type of $domain -> $host -> $serv -> $field to " . (defined $val?$val:"GAUGE") . ".\n");
RRDs::tune ($ofile, "-d", "42:".(defined $val?$val:"GAUGE"));
unless (rename ($ofile, $nfile))
{
logger ("ERROR: Could not rename file: $!\n");
}
}
sub change_max
{
my $config = shift;
my $domain = shift;
my $host = shift;
my $serv = shift;
my $field = shift;
my $val = shift;
my $file = &munin_get_filename ($config, $domain, $host, $serv, $field);
logger ("INFO: Changing max of $domain -> $host -> $serv -> $field to " . (defined $val?$val:"undef") . ".\n");
RRDs::tune ($file, "-a", "42:".(defined $val?$val:"U"));
}
sub change_min
{
my $config = shift;
my $domain = shift;
my $host = shift;
my $serv = shift;
my $field = shift;
my $val = shift;
my $file = &munin_get_filename ($config, $domain, $host, $serv, $field);
logger ("INFO: Changing min of $domain -> $host -> $serv -> $field to " . (defined $val?$val:"undef") . ".\n");
RRDs::tune ($file, "-i", "42:".(defined $val?$val:"U"));
}
sub process_domain {
my ($domain) = @_;
for my $key ( keys %{$config->{domain}->{$domain}->{node}}) {
if (@limit_hosts and !grep (/^$key$/, @limit_hosts))
{
print "Skipping host \"$key\" - not in hostlist\n" if $DEBUG;
next;
}
if (defined $config->{max_processes} and $config->{max_processes} and
($config->{max_processes}-1-$bad_procs) < keys %children)
{
push (@queue, [$domain, $key, $config->{domain}->{$domain}->{node}->{$key},$oldconfig->{domain}->{$domain}->{node}->{$key}]);
}
else
{
do_node($domain,$key ,$config->{domain}->{$domain}->{node}->{$key},$oldconfig->{domain}->{$domain}->{node}->{$key});
}
}
}
sub do_node {
my ($domain, $name, $config, $oldconfig) = @_;
my $node_time = Time::HiRes::time;
logger("Processing node: $name");
process_node($domain,$name ,$config,$oldconfig);
$node_time = sprintf ("%.2f",(Time::HiRes::time - $node_time));
print STATS "UN|$domain|$name|$node_time\n";
logger ("Processed node: $name ($node_time sec)");
}
sub process_node {
my ($domain,$name,$node,$oldnode) = @_;
return if (exists ($node->{fetch_data}) and !$node->{fetch_data});
return if (exists ($node->{update}) and $node->{update} ne "yes");
unless ($node->{address}) {
logger("No address defined for node: $name");
return;
}
# Then we fork...
if ($do_fork)
{
my $pid = fork;
if (!defined($pid))
{ # Something went wrong
warn "cannot fork: $!";
return;
} elsif ($pid)
{ # I'm the parent
$children{$pid} = [$domain, $name, $node, $oldnode];
return;
} # else I'm the child -- go spawn
}
$0 .= " [$name]";
# First we get lock...
unless (&munin_getlock("$config->{rundir}/munin-$domain-$name.lock"))
{
logger ("Could not get lock for $node -> $name. Skipping node.");
if ($do_fork)
{ # Send the old config to the server before we die
socket (SOCK, PF_UNIX, SOCK_STREAM, 0) || die "socket: $!";
connect (SOCK, sockaddr_un ("$config->{rundir}/$serversocket")) || die "connect: $!";
if (ref $oldnode) {
$config->{domain}->{$domain}->{node}->{$name} = $oldnode;
alarm (0); # Don't want to interrupt this.
my @tmp = ($$, $domain, $name);
nstore_fd \@tmp, \*SOCK || die "Could not nstore_fd: $!";
nstore_fd \%{$config->{domain}->{$domain}->{node}->{$name}}, \*SOCK;
close SOCK;
}
exit 1;
}
else
{
return 0;
}
}
my $socket;
if (&munin_get ($config, "local_address", undef, $domain, $node))
{
$socket = new IO::Socket::INET ('PeerAddr' => "$node->{address}:".
($node->{port} || $config->{domain}->{$domain}->{port} ||
$config->{port} || "4949"),
'LocalAddr' => &munin_get ($config, "local_address", undef, $domain, $node),
'Proto' => "tcp", "Timeout" => $timeout);
} else {
$socket = new IO::Socket::INET ('PeerAddr' => "$node->{address}:".
($node->{port} || $config->{domain}->{$domain}->{port} ||
$config->{port} || "4949"),
'Proto' => "tcp", "Timeout" => $timeout);
}
my $err = ($socket ? "" : $!);
if ($do_fork) {
$SIG{ALRM} = sub { close $socket; die "$!\n"};
alarm ($timeout);
my @tmp = ($$, $domain, $name);
if (!$socket) {
logger ("Could not connect to $name($node->{address}): $err - Attempting to use old configuration");
# If we can't reach the client. Using old Configuration.
if (ref $oldnode) {
$config->{domain}->{$domain}->{node}->{$name} = $oldnode;
alarm (0); # Don't want to interrupt this.
socket (SOCK, PF_UNIX, SOCK_STREAM, 0) || die "socket: $!";
connect (SOCK, sockaddr_un ("$config->{rundir}/$serversocket")) || die "connect: $!";
nstore_fd \@tmp, \*SOCK || die "Could not nstore_fd: $!";
nstore_fd \%{$config->{domain}->{$domain}->{node}->{$name}}, \*SOCK;
alarm ($timeout);
close SOCK;
}
else
{ # Well, we'll have to give _something_ to the server, or it'll time out.
socket (SOCK, PF_UNIX, SOCK_STREAM, 0) || die "socket: $!";
connect (SOCK, sockaddr_un ("$config->{rundir}/$serversocket")) || die "connect: $!";
nstore_fd \@tmp, \*SOCK || die "Could not nstore_fd: $!";
nstore_fd ({}, \*SOCK);
}
} else {
if (!&config_node($domain,$name,$node,$oldnode,$socket))
{
$config->{domain}->{$domain}->{node}->{$name} = $oldnode;
socket (SOCK, PF_UNIX, SOCK_STREAM, 0) || die "socket: $!";
connect (SOCK, sockaddr_un ("$config->{rundir}/$serversocket")) || die "connect: $!";
nstore_fd \@tmp, \*SOCK || die "Could not nstore_fd: $!";
nstore_fd \%{$config->{domain}->{$domain}->{node}->{$name}}, \*SOCK;
close SOCK;
exit 1;
}
&fetch_node($domain,$name,$node,$socket);
close $socket;
alarm (0); # Don't want to interrupt this.
socket (SOCK, PF_UNIX, SOCK_STREAM, 0) || die "socket: $!";
connect (SOCK, sockaddr_un ("$config->{rundir}/$serversocket")) || die "connect: $!";
nstore_fd \@tmp, \*SOCK || die "Could not nstore_fd: $!";
nstore_fd \%{$config->{domain}->{$domain}->{node}->{$name}}, \*SOCK;
alarm ($timeout);
close SOCK;
}
alarm (0);
exit;
}
else # No forking...
{
if (!$socket) {
logger ("Could not connect to $name($node->{address}): $err\nAttempting to use old configuration");
# If we can't reach the client. Using old Configuration.
if (ref $oldnode) {
$config->{domain}->{$domain}->{node}->{$name} = $oldnode;
}
} else {
next unless (&config_node($domain,$name,$node,$oldnode,$socket));
&fetch_node($domain,$name,$node,$socket);
close $socket;
}
}
munin_removelock("$config->{rundir}/munin-$domain-$name.lock");
}
sub read_socket_single {
my( $socket ) = @_;
my $timed_out=0;
my $res;
return undef unless defined $socket;
eval {
local $SIG{ALRM} = sub { $timed_out=1; close $socket; exit 1;};
alarm( $timeout );
$res = <$socket>;
chomp $res if defined $res;
alarm 0;
};
if ($timed_out)
{
logger ("Socket read timed out: $@\n");
return undef;
}
return $res;
}
sub read_socket {
my ($socket) = @_;
my @array;
my $timed_out=0;
return undef unless defined $socket;
eval {
local $SIG{ALRM} = sub { $timed_out=1; close $socket; exit 1;};
alarm( $timeout );
while (<$socket>) {
chomp;
last if (/^\.$/);
push @array,$_;
}
alarm 0;
};
if ($timed_out)
{
logger ("Socket read timed out: $@\n");
return undef;
}
return (@array);
}
sub config_node {
my ($domain,$name,$node,$oldnode,$socket) = @_;
my $clientdomain = read_socket_single ($socket);
my $fetchdomain;
chomp($clientdomain) if $clientdomain;
if (!$clientdomain) {
logger("Got unknown reply from client \"$domain\" -> \"name\" skipping");
return 0;
}
$clientdomain =~ s/\#.*(?:lrrd|munin) (?:client|node) at //;
if (exists $node->{'use_node_name'} and $node->{'use_node_name'} =~ /^\s*y(?:es)\s*$/i)
{
$fetchdomain = $clientdomain;
}
elsif (exists $node->{'use_default_name'} and $node->{'use_default_name'} =~ /^\s*y(?:es)\s*$/i)
{
$fetchdomain = $clientdomain;
}
else
{
$fetchdomain = $name;
}
my $nodeconf_time = Time::HiRes::time;
logger("Configuring node: $name") if $DEBUG;
my @services;
eval {
local $SIG{ALRM} = sub { die "Could not run list on $name ($fetchdomain): $!\n"};
alarm 5; # Should be enough to check the list
print $socket "list $fetchdomain\n";
my $list = <$socket>;
chomp $list;
@services = split / /,$list;
alarm 0;
};
if ($@) {
die unless ($@ =~ m/Could not run list/);
logger ("Could not get list from $node->{address}: $!\nAttempting to use old configuration");
if (ref $oldnode) {
$config->{domain}->{$domain}->{node}->{$name} = $oldnode;
}
@services = [];
}
for my $service (@services) {
my $servname = $service;
my $fields = {};
$servname =~ s/\W/_/g;
next if (exists ($node->{client}->{$servname}->{fetch_data}) and
$node->{client}->{$servname}->{fetch_data} == 0);
next if (exists ($node->{client}->{$servname}->{update}) and
$node->{client}->{$servname}->{update} ne "yes");
next if (@limit_services and !grep (/^$servname$/, @limit_services));
my @graph_order = (exists $node->{client}->{$servname}->{graph_order} ?
split (/\s+/, $node->{client}->{$servname}->{graph_order}) : ());
my $serviceconf_time = Time::HiRes::time;
if ($servname ne $service)
{
$node->{client}->{$servname}->{realservname} = $service;
}
logger("Configuring service: $name->$servname") if $DEBUG;
print $socket "config $service\n";
my @lines = read_socket($socket);
return unless $socket;
next unless (@lines);
for (@lines) {
next unless defined $_;
if (/\# timeout/) {
logger("Client reported timeout in configuration of $servname");
if ($oldnode->{client}->{$servname}) {
logger("Attempting to use old configuration");
$config->{domain}->{$domain}->{node}->{$name}->{client}->{$servname} = $oldnode->{client}->{$servname};
} else {
logger("Skipping configuration of $servname");
delete $node->{client}->{$servname};
}
}
elsif (/^(\w+)\.(\w+)\s+(.+)/) {
my ($client,$type,$value) = ($1,$2,$3);
$client = &sanitise_fieldname ($client, $fields);
if (($type) and ($type eq "label")) {
$value =~ s/\\/_/g; # Sanitise labels
}
$node->{client}->{$servname}->{$client.".".$type} = "$value";
logger ("config: $name->$client.$type = $value") if $DEBUG;
if (($type) and ($type eq "label")) {
push (@graph_order,$client)
unless grep (/^$client$/, @graph_order);
}
} elsif (/(^[^\s\#]+)\s+(.+)/) {
my ($keyword) = $1;
my ($value) = $2;
$node->{client}->{$servname}->{$keyword} = $value;
logger ("Config: $keyword = $value") if $DEBUG;
if ($keyword eq "graph_order") {
@graph_order = split (/\s+/, $node->{client}->{$servname}->{graph_order});
}
}
}
for my $subservice (keys %{$node->{client}->{$servname}}) {
my ($client,$type) = split /\./,$subservice;
my ($value) = $node->{client}->{$servname}->{$subservice};
if (($type) and ($type eq "label")) {
my $fname = "$config->{dbdir}/$domain/$name-$servname-$client-" .
lc substr (($node->{client}->{$servname}->{"$client.type"}||"GAUGE"),0,1).
".rrd";
if (! -f "$fname") {
logger ("creating rrd-file for $servname->$subservice");
mkdir "$config->{dbdir}/$domain/",0777;
RRDs::create ("$fname",
"DS:42:".($node->{client}->{$servname}->{"$client.type"} || "GAUGE").":600:".
(defined $node->{client}->{$servname}->{"$client.min"} ?
$node->{client}->{$servname}->{"$client.min"} :
"U") . ":" . ($node->{client}->{$servname}->{"$client.max"} || "U"),
"RRA:AVERAGE:0.5:1:576", # resolution 5 minutes
"RRA:MIN:0.5:1:576",
"RRA:MAX:0.5:1:576",
"RRA:AVERAGE:0.5:6:432", # 9 days, resolution 30 minutes
"RRA:MIN:0.5:6:432",
"RRA:MAX:0.5:6:432",
"RRA:AVERAGE:0.5:24:540", # 45 days, resolution 2 hours
"RRA:MIN:0.5:24:540",
"RRA:MAX:0.5:24:540",
"RRA:AVERAGE:0.5:288:450", # 450 days, resolution 1 day
"RRA:MIN:0.5:288:450",
"RRA:MAX:0.5:288:450");
if (my $ERROR = RRDs::error) {
logger ("Unable to create \"$fname\": $ERROR");
}
}
}
$node->{client}->{$servname}->{graph_order} = join(' ',@graph_order);
}
$serviceconf_time = sprintf ("%.2f",(Time::HiRes::time - $serviceconf_time));
print STATS "CS|$domain|$name|$servname|$serviceconf_time\n";
logger ("Configured service: $name -> $servname ($serviceconf_time sec)");
}
$nodeconf_time = sprintf ("%.2f",(Time::HiRes::time - $nodeconf_time));
print STATS "CN|$domain|$name|$nodeconf_time\n";
logger("Configured node: $name ($nodeconf_time sec)");
return 1;
}
sub fetch_node {
my ($domain,$name,$node,$socket) = @_;
my $nodefetch_time = Time::HiRes::time;
logger("Fetching node: $name") if $DEBUG;
for my $service (keys %{$node->{client}}) {
my $servicefetch_time = Time::HiRes::time;
logger("Fetching service: $name->$service") if $DEBUG;
next if (exists ($node->{client}->{$service}->{fetch_data}) and
$node->{client}->{$service}->{fetch_data} == 0);
next if (exists ($node->{client}->{$service}->{update}) and
$node->{client}->{$service}->{update} ne "yes");
next if (@limit_services and !grep (/^$service$/, @limit_services));
my $realservname = $node->{client}->{$service}->{realservname} || $service;
delete $node->{client}->{$service}->{realservname}
if exists $node->{client}->{$service}->{realservname};
return 0 unless $socket;
print $socket "fetch $realservname\n";
my @lines = &read_socket($socket);
return 0 unless $socket;
my $fields = {};
for (@lines) {
next unless defined $_;
if (/\# timeout/) {
logger("Client reported timeout in fetching of $service");
}
elsif (/(\w+)\.value\s+(.+)/) {
my $key = $1;
my $value = $2;
my $comment = $3;
if ($value =~ /\d[Ee]([+-]?\d+)$/) {
# Looks like scientific format. RRDtool does not
# like it so we convert it.
my $magnitude = $1;
if ($magnitude < 0) {
# Preserve at least 4 significant digits
$magnitude=abs($magnitude)+4;
$value=sprintf("%.*f", $magnitude,$value);
} else {
$value=sprintf("%.4f",$value);
}
}
$key = &sanitise_fieldname ($key, $fields);
if (exists $node->{client}->{$service}->{$key.".label"})
{
my $fname = "$config->{dbdir}/$domain/$name-$service-$key-".
lc substr (($node->{client}->{$service}->{$key.".type"}||"GAUGE"),0,1).
".rrd";
logger("Updating $fname with $value") if $DEBUG;
RRDs::update ("$fname", "N:$value");
if (my $ERROR = RRDs::error) {
logger ("Unable to update $fname: $ERROR");
}
} else {
logger ("Unable to update $domain -> $name -> $service -> $key: No such field (no \"label\" field defined when running plugin with \"config\").");
}
}
elsif (/(\w+)\.extinfo\s+(.+)/) {
$config->{domain}->{$domain}->{node}->{$name}->{client}->{$service}->{$1.".extinfo"} = $2;
}
}
$servicefetch_time = sprintf ("%.2f",(Time::HiRes::time - $servicefetch_time));
logger ("Fetched service: $name -> $service ($servicefetch_time sec)");
print STATS "FS|$domain|$name|$service|$servicefetch_time\n";
}
$nodefetch_time = sprintf ("%.2f",(Time::HiRes::time - $nodefetch_time));
logger ("Fetched node: $name ($nodefetch_time sec)");
print STATS "FN|$domain|$name|$nodefetch_time\n";
return 1;
}
sub use_old_config
{
my $domain = shift;
my $name = shift;
my $oldnode = shift;
$config->{domain}->{$domain}->{node}->{$name} = $oldnode;
logger ("Attempting to use old configuration for $domain -> $name.");
}
sub logger_open {
my $dirname = shift;
if (!$log->opened)
{
unless (open ($log, ">>$dirname/munin-update.log"))
{
print STDERR "Warning: Could not open log file \"$dirname/munin-update.log\" for writing: $!";
}
}
}
sub logger {
my ($comment) = @_;
my $now = strftime "%b %d %H:%M:%S", localtime;
print "$now - [$$] $comment\n" if $print_stdout;
if ($log->opened)
{
print $log "$now [$$] - $comment\n";
}
else
{
if (defined $config->{logdir})
{
if (open ($log, ">>$config->{logdir}/munin-update.log"))
{
print $log "$now - $comment\n";
$log->flush;
close (STDERR);
open (STDERR, ">&", $log);
}
else
{
print STDERR "Warning: Could not open log file \"$config->{logdir}/munin-update.log\" for writing: $!";
print STDERR "$now - $comment\n";
}
}
else
{
print STDERR "$now - $comment\n";
}
}
}
sub sanitise_fieldname
{
my $lname = shift;
my $done = shift;
my $old = shift || 0;
$lname =~ s/[\W-]/_/g;
return substr ($lname,-18) if $old;
#$lname = Digest::MD5::md5_hex ($lname) if (defined $done->{$lname});
$done->{$lname} = 1;
return $lname;
}
1;
=head1 NAME
munin-update - A program to gather data from machines running munin-node
=head1 SYNOPSIS
munin-update [options]
=head1 OPTIONS
=over 5
=item B<< --[no]force-root >>
Force running as root (stupid and unnecessary). [--noforce-root]
=item B<< --service <service> >>
Limit fetched data to those of E<lt>serviceE<gt>. Multiple --service options may be supplied. [unset]
=item B<< --host <host> >>
Limit fetched data to those from E<lt>host<gt>. Multiple --host options may be supplied. [unset]
=item B<< --config <file> >>
Use E<lt>fileE<gt> as configuration file. [@@CONFDIR@@/munin.conf]
=item B<< --help >>
View help message.
=item B<< --[no]debug >>
If set, view debug messages. [--nodebug]
=item B<< --[no]fork >>
If set, will fork off one process for each host. [--fork]
=item B<< --[no]stdout >>
If set, will print log messages to stdout as well as syslog. [--nostdout]
=item B<< --timeout <seconds> >>
Set the network timeout to <seconds>. [180]
=back
=head1 DESCRIPTION
Munin-update is a part of the package Munin, which is used in
combination with Munin's node. Munin is a group of programs to gather
data from Munin's nodes, graph them, create html-pages, and optionally
warn Nagios about any off-limit values.
Munin-update does the gathering. It is usually only used from within
munin-cron.
It contacts each host's munin-node in turn, gathers data from it, and
stores them in .rrd-files. If necessary, it will create the rrd-files
and the directories to store them in.
=head1 FILES
@@CONFDIR@@/munin.conf
@@DBDIR@@/*
@@LOGDIR@@/munin-update
@@STATEDIR@@/*
=head1 VERSION
This is munin-update version @@VERSION@@
=head1 AUTHORS
Audun Ytterdal, Jimmy Olsen, and Tore Anderson.
=head1 BUGS
munin-update 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 (C) 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.conf>.
=cut
# vim:syntax=perl:ts=8