Navigation

← Previous Changeset
Next Changeset →

Changeset 1291

Timestamp:

08/26/07 19:34:37 (4 years ago)

Author:

Message:

First milestone on the big group change. munin-update now works.

Files:

people/jo/multilevel-groups/server/Munin.pm.in (modified) (16 diffs)
people/jo/multilevel-groups/server/munin-update.in (modified) (19 diffs)

Legend:

: Unmodified
: Added
: Removed
: Modified
: Copied
: Moved

people/jo/multilevel-groups/server/Munin.pm.in

r1288	r1291
24	24
25	25	use Exporter;
	26	use Data::Dumper;
	27
26	28	@ISA = ('Exporter');
27	29	@EXPORT = ('munin_trend',
…	…
50	52	'munin_get_max_label_length',
51	53	'munin_get_field_order',
52		'munin_get_rrd_filename'
	54	'munin_get_rrd_filename',
	55	'munin_find_field',
	56	'munin_get_node_name',
	57	'munin_get_node_loc',
	58	'munin_get_node',
	59	'munin_set_var_loc',
	60	'munin_copy_node_toloc',
	61	'munin_get_separated_node'
53	62	);
54	63
…	…
84	93	"version", "tls_certificate", "tls_private_key", "tls_pem",
85	94	"tls_verify_certificate", "tls_verify_depth", "graph_data_size",
86		"colour", "graph_printf", "ok", "unknown"
	95	"colour", "graph_printf", "ok", "unknown", "realservname"
87	96	);
88	97
…	…
219	228	my ($configfile,$overwrite) = @_;
220	229	for my $key (keys %$overwrite) {
	230	next if $key =~ /^#%#/;
221	231	if (ref $overwrite->{$key}) {
222	232	&munin_overwrite($overwrite->{$key},$configfile->{$key});
…	…
234	244	$conf \|\|= $configfile;
235	245	if (! -r $conf and ! $missingok) {
236		::logger ("munin_readconfig: cannot open '$conf'");
237		return undef;
	246	::logger ("munin_readconfig: cannot open '$conf'");
	247	return undef;
238	248	}
239	249	if (open (CFG, $conf))
…	…
246	256
247	257	# Some important defaults before we return...
248		$config->{'rundir'} \|\|= "~~/tmp/~~";
249		$config->{'dbdir'} \|\|= "~~/var/lib/munin/~~";
250		$config->{'logdir'} \|\|= "~~/var/log/~~";
251		$config->{'tmpldir'}\|\|= "~~/etc/munin/templates/~~";
	258	$config->{'rundir'} \|\|= "@@STATEDIR@@";
	259	$config->{'dbdir'} \|\|= "@@DBDIR@@";
	260	$config->{'logdir'} \|\|= "@@LOGDIR@@";
	261	$config->{'tmpldir'}\|\|= "@@CONFDIR@@/templates";
252	262	$config->{'htmldir'}\|\|= "@@HTMLDIR@@/";
	263	$config->{'#%#parent'}= undef;
	264	$config->{'#%#name'}= "root";
253	265	return ($config);
254	266	}
…	…
257	269	{
258	270	my $lines = shift;
259		my $hash = ~~undef~~;
	271	my $hash = {};
260	272	my $prefix = "";
261	273	my $prevline = "";
…	…
264	276	{
265	277	chomp $line;
266		#$line =~ s/(^\|[^\\])#.*/$1/g if $line =~ /#/; # Skip comments...
267		if ($line =~ /#/)
	278	if ($line =~ /#/) # Skip comments...
268	279	{
269	280	next if ($line =~ /^#/);
…	…
297	308	{
298	309	$prefix = $1;
299		if ($prefix =~ /^([^:;]+);([^:;]+)$/)
	310	if ($prefix =~ /^([^:]+);([^:;]+)$/)
300	311	{
301	312	$prefix .= ":";
302	313	}
303		elsif ($prefix =~ /^([^:;]+);$/)
	314	elsif ($prefix =~ /^([^:]+);$/)
304	315	{
305	316	$prefix .= "";
306	317	}
307		elsif ($prefix =~ /^([^:;]+);([^:;]+):(.*)$/)
	318	elsif ($prefix =~ /^([^:]+);([^:;]+):(.*)$/)
308	319	{
309	320	$prefix .= ".";
…	…
389	400	}
390	401
	402
	403	# munin_find_field: Search a hash to find nodes with $field defined
	404	# Parameters:
	405	# - $hash: A hash ref to search
	406	# - $field: The name of the field to search for
	407	# - $avoid: [optional] Stop traversing further down if this field is found
	408	# Returns:
	409	# - Success: A ref to an array of the hash nodes containing $field.
	410	# - Failure: undef
	411	sub munin_find_field
	412	{
	413	my $hash = shift;
	414	my $field = shift;
	415	my $avoid = shift;
	416	my $res = [];
	417
	418	if (ref ($hash) eq "HASH") {
	419	foreach my $key (keys %{$hash}) {
	420	next if $key =~ /^#%#/;
	421	last if defined $avoid and $key eq $avoid;
	422	if ($key eq $field) {
	423	push @$res, $hash;
	424	} elsif (ref ($hash->{$key}) eq "HASH") {
	425	push @$res, @{munin_find_field ($hash->{$key}, $field, $avoid)};
	426	}
	427	}
	428	}
	429
	430	return $res;
	431	}
	432
	433	# munin_get_separated_node: Copy a node to a separate node without "specials"
	434	# Parameters:
	435	# - $hash: The node to copy
	436	# Returns:
	437	# - Success: A ref to a new node without "#%#"-fields
	438	# - Failure: undef
	439	sub munin_get_separated_node
	440	{
	441	my $hash = shift;
	442	my $ret = {};
	443
	444	if (ref ($hash) eq "HASH") {
	445	foreach my $key (keys %$hash) {
	446	next if $key =~ /^#%#/;
	447	if (ref ($hash->{$key}) eq "HASH") {
	448	$ret->{$key} = munin_get_separated_node ($hash->{$key});
	449	} else {
	450	$ret->{$key} = $hash->{$key};
	451	}
	452	}
	453	} else {
	454	return undef;
	455	}
	456
	457	return $ret;
	458	}
	459
	460	# munin_get_node_name: Return the name of the hash node supplied
	461	# Parameters:
	462	# - $hash: A ref to the hash node
	463	# Returns:
	464	# - Success: The name of the node
	465	sub munin_get_node_name
	466	{
	467	my $hash = shift;
	468
	469	if (ref ($hash) eq "HASH" and defined $hash->{'#%#name'}) {
	470	return $hash->{'#%#name'};
	471	} else {
	472	return undef;
	473	}
	474	}
	475
	476	# munin_get_node_loc: Get location array for hash node
	477	# Parameters:
	478	# - $hash: A ref to the node
	479	# Returns:
	480	# - Success: Ref to an array with the full path of the variable
	481	# - Failure: undef
	482	sub munin_get_node_loc
	483	{
	484	my $hash = shift;
	485	my $res = [];
	486
	487	if (ref ($hash) ne "HASH") { # Not a has node
	488	return undef;
	489	}
	490	if (defined $hash->{'#%#parent'}) {
	491	$res = munin_get_node_loc ($hash->{'#%#parent'});
	492	push @$res, munin_get_node_name ($hash) if defined $res;
	493	}
	494	return $res;
	495	}
	496
	497	# munin_get_node: Gets a node by loc
	498	# Parameters:
	499	# - $hash: A ref to the hash to set the variable in
	500	# - $loc: A ref to an array with the full path of the node
	501	# Returns:
	502	# - Success: The node ref found by $loc
	503	# - Failure: undef
	504	sub munin_get_node
	505	{
	506	my $hash = shift;
	507	my $loc = shift;
	508
	509	while (my $tmpvar = shift @$loc) {
	510	if ($tmpvar !~ /\S/) {
	511	::logger ("Error: munin_get_node: Cannot work on hash node \"$tmpvar\"");
	512	return undef;
	513	}
	514	return undef if !exists $hash->{$tmpvar};
	515	return $hash->{$tmpvar} if @$loc <= 0;
	516	$hash = $hash->{$tmpvar};
	517	}
	518	}
	519
	520	# munin_set_var_loc: sets a variable in a hash
	521	# Parameters:
	522	# - $hash: A ref to the hash to set the variable in
	523	# - $loc: A ref to an array with the full path of the variable
	524	# - $val: The value to set the variable to
	525	# Returns:
	526	# - Success: The $hash we were handed
	527	# - Failure: undef
	528	sub munin_set_var_loc
	529	{
	530	my $hash = shift;
	531	my $loc = shift;
	532	my $val = shift;
	533
	534	my $tmpvar = shift @$loc;
	535	if ($tmpvar !~ /\S/) {
	536	::logger ("Error: munin_set_var_loc: Cannot work on hash node \"$tmpvar\"");
	537	return undef;
	538	}
	539	if (@$loc > 0) {
	540	if (!defined $hash->{$tmpvar}) { # Init the new node
	541	$hash->{$tmpvar}->{"#%#parent"} = $hash;
	542	$hash->{$tmpvar}->{"#%#name"} = $tmpvar;
	543	}
	544	return munin_set_var_loc ($hash->{$tmpvar}, $loc, $val);
	545	} else {
	546	::logger ("Warning: munin_set_var_loc: Setting unknown option \"$tmpvar\".")
	547	unless defined $legal_expanded{$tmpvar};
	548	$hash->{$tmpvar} = $val;
	549	return $hash;
	550	}
	551	}
	552
	553	# munin_set_var_path: sets a variable in a hash
	554	# Parameters:
	555	# - $hash: A ref to the hash to set the variable in
	556	# - $var: A string with the full path of the variable
	557	# - $val: The value to set the variable to
	558	# Returns:
	559	# - Success: The $hash we were handed
	560	# - Failure: The $hash we were handed
391	561	sub munin_set_var_path
392	562	{
…	…
395	565	my $val = shift;
396	566
397		print "DEBUG: Setting var \"$var\" = \"$val\"\n" if $DEBUG;
398		if ($var =~ /^\s([^;:]+);([^:]+):(\S+)\s$/)
399		{
400		my ($dom, $host, $rest) = ($1, $2, $3);
401		my @sp = split (/\./, $rest);
402
403		if (@sp == 3)
404		{
405		::logger ("Warning: Unknown option \"$sp[2]\" in \"$dom;$host:$sp[0].$sp[1].$sp[2]\".")
406		unless defined $legal_expanded{$sp[2]};
407		$hash->{domain}->{$dom}->{node}->{$host}->{client}->{$sp[0]}->{"$sp[1].$sp[2]"} = $val;
408		}
409		elsif (@sp == 2)
410		{
411		::logger ("Warning: Unknown option \"$sp[1]\" in \"$dom;$host:$sp[0].$sp[1]\".")
412		unless defined $legal_expanded{$sp[1]};
413		$hash->{domain}->{$dom}->{node}->{$host}->{client}->{$sp[0]}->{$sp[1]} = $val;
414		}
415		elsif (@sp == 1)
416		{
417		::logger ("Warning: Unknown option \"$sp[0]\" in \"$dom;$host:$sp[0]\".")
418		unless defined $legal_expanded{$sp[0]};
419		$hash->{domain}->{$dom}->{node}->{$host}->{$sp[0]} = $val;
420		}
421		else
422		{
423		warn "munin_set_var: Malformatted variable path \"$var\".";
424		}
425		}
426		elsif ($var =~ /^\s([^;:]+);([^;:]+)\s$/)
427		{
428		my ($dom, $rest) = ($1, $2);
429		my @sp = split (/\./, $rest);
430
431		if (@sp == 1)
432		{
433		::logger ("Warning: Unknown option \"$sp[0]\" in \"$dom;$sp[0]\".")
434		unless defined $legal_expanded{$sp[0]};
435		$hash->{domain}->{$dom}->{$sp[0]} = $val;
436		}
437		else
438		{
439		warn "munin_set_var: Malformatted variable path \"$var\".";
440		}
441		}
442		elsif ($var =~ /^\s([^;:\.]+)\s$/)
443		{
444		::logger ("Warning: Unknown option \"$1\" in \"$1\".")
445		unless defined $legal_expanded{$1};
446		$hash->{$1} = $val;
447		}
448		elsif ($var =~ /^\s*([^\.]+)\.([^\.]+)\.([^\.]+)$/)
449		{
450		::logger ("Warning: Unknown option \"$1\" in \"$var\".")
451		unless defined $legal_expanded{$1};
452		::logger ("Warning: Unknown option \"$3\" in \"$var\".")
453		unless defined $legal_expanded{$3};
454		$hash->{$1}->{$2}->{$3} = $val;
455		}
456		else
457		{
458		warn "munin_set_var: Malformatted variable path \"$var\".";
	567	my $result = undef;
	568
	569	::logger ("Debug: munin_set_var_path: Setting var \"$var\" = \"$val\"") if $DEBUG;
	570	if ($var =~ /^\s([^:]+):(\S+)\s$/) {
	571	my ($leftstring, $rightstring) = ($1, $2);
	572
	573	my @leftarr = split (/;/, $leftstring);
	574	my @rightarr = split (/\./, $rightstring);
	575	$result = munin_set_var_loc ($hash, [@leftarr, @rightarr], $val);
	576	} elsif ($var =~ /^\s([^;:\.]+)\s$/) {
	577	$result = munin_set_var_loc ($hash, [$1], $val);
	578	} elsif ($var =~ /^\s*(.+)\.([^\.:;]+)$/) {
	579	my ($leftstring, $rightstring) = ($1, $2);
	580
	581	my @leftarr = split (/;/, $leftstring);
	582	my @rightarr = split (/\./, $rightstring);
	583	$result = munin_set_var_loc ($hash, [@leftarr, @rightarr], $val);
	584	} elsif ($var =~ /^\s(\S+)\s$/) {
	585	my @leftarr = split (/;/, $1);
	586	$result = munin_set_var_loc ($hash, [@leftarr], $val);
	587	} else {
	588	::logger ("Error: munin_set_var_path: Malformatted variable path \"$var\".");
	589	}
	590
	591	if (!defined $result) {
	592	::logger ("Error: munin_set_var_path: Failed setting \"$var\" = \"$val\".");
459	593	}
460	594
…	…
462	596	}
463	597
464		sub munin_writeconfig_loop {
465		my ($data,$fh,$pre) = @_;
466		$pre \|= "";
467
468		# Write datafile
469		foreach my $a (keys %{$data})
470		{
471		if (ref ($data->{$a}) eq "HASH")
472		{
473		if ($a eq "domain" or $a eq "node" or $a eq "client")
474		{
475		&munin_writeconfig_loop ($data->{$a}, $fh, "$pre");
476		}
477		elsif ($a eq "contact" and $pre eq "")
478		{
479		&munin_writeconfig_loop ($data->{$a}, $fh, "contact.");
480		}
481		else
482		{
483		my $lpre = $pre;
484		if ($lpre eq "")
485		{
486		$lpre = $a.";";
487		}
488		elsif ($lpre =~ /;$/)
489		{
490		$lpre .= $a.":";
491		}
492		else
493		{
494		$lpre .= $a.".";
495		}
496		&munin_writeconfig_loop ($data->{$a}, $fh, "$lpre");
497		}
498		}
499		elsif (defined $data->{$a} and length $data->{$a})
500		{
501		next if "$pre$a" eq "version"; # Handled separately
502		(my $outstring = $data->{$a}) =~ s/([^\\])#/$1\\#/g;
503		print "Writing: $pre$a $outstring\n" if $DEBUG;
	598	sub munin_writeconfig_loop
	599	{
	600	my ($hash,$fh,$pre) = @_;
	601
	602	foreach my $key (keys %$hash) {
	603	next if $key =~ /#%#/;
	604	my $path = (defined $pre ? join(';', ($pre, $key)) : $key);
	605	if (ref ($hash->{$key}) eq "HASH") {
	606	munin_writeconfig_loop ($hash->{$key}, $fh, $path);
	607	} else {
	608	next if !defined $pre and $key eq "version"; # Handled separately
	609	(my $outstring = $hash->{$key}) =~ s/([^\\])#/$1\\#/g;
	610	print "Writing: $path $outstring\n" if $DEBUG;
504	611	if ($outstring =~ /\\$/)
505	612	{ # Backslash as last char has special meaning. Avoid it.
506		print $fh "$p~~re$a~~ $outstring\\\n";
	613	print $fh "$path $outstring\\\n";
507	614	} else {
508		print $fh "$pre$a $outstring\n";
509		}
510		}
511		}
512		}
	615	print $fh "$path $outstring\n";
	616	}
	617	}
	618	}
	619	}
	620
513	621	sub munin_writeconfig {
514	622	my ($datafilename,$data,$fh) = @_;
515		~~# my $datafile = new Config::General();~~
516		~~# $datafile->save_file($datafilename,$data);~~
517	623
518	624	if (!defined $fh)
…	…
528	634	print $fh "version $VERSION\n";
529	635	# Write datafile
530		&munin_writeconfig_loop ($data, $fh~~, ""~~);
	636	&munin_writeconfig_loop ($data, $fh);
531	637
532	638	if (defined $fh)
…	…
575	681	}
576	682
	683	# munin_get_filename: Get rrd filename for a field
	684	# Parameters:
	685	# - $hash: Ref to hash field
	686	# Returns:
	687	# - Success: Full path to rrd file
	688	# - Failure: undef
577	689	sub munin_get_filename {
578		my ($config,$domain,$node,$service,$field) = @_;
579
580		return ($config->{'dbdir'} . "/$domain/$node-$service-$field-" . lc substr (($config->{domain}->{$domain}->{node}->{$node}->{client}->{$service}->{$field.".type"}\|\|"GAUGE"), 0,1). ".rrd");
581
582		}
583
	690	my $hash = shift;
	691	my $loc = munin_get_node_loc ($hash);
	692	my $ret = munin_get ($hash, "dbdir");
	693
	694	if (!defined $loc or !defined $ret) {
	695	return undef;
	696	}
	697
	698	# Not really a danger (we're not doing this stuff via the shell), so more to avoid
	699	# confusion with silly filenames
	700	@$loc = map { s/\//_/g; $_ } @$loc;
	701	@$loc = map { s/^\./_/g; $_ } @$loc;
	702
	703	my $field = pop @$loc or return undef;
	704	my $plugin = pop @$loc or return undef;
	705	my $node = pop @$loc or return undef;
	706
	707	if (@$loc) { # The rest is used as directory names...
	708	$ret .= "/" . join ('/', @$loc);
	709	}
	710
	711	return ($ret . "/$node-$plugin-$field-" . lc substr (munin_get($hash, "type", "GAUGE"), 0,1). ".rrd");
	712
	713	}
	714
	715	# munin_get_bool: Get boolean variable
	716	# Parameters:
	717	# - $hash: Ref to hash node
	718	# - $field: Name of field to get
	719	# - $default: [optional] Value to return if $field isn't set
	720	# Returns:
	721	# - Success: 1 or 0 (true or false)
	722	# - Failure: $default if defined, else undef
584	723	sub munin_get_bool
585	724	{
586		my $conf = shift;
587		my $field = shift;
588		my $default = shift;
589		my $domain = shift;
590		my $node = shift;
591		my $service = shift;
592		my $plot = shift;
593
594		return undef unless defined $field;
595
596		my $ans = &munin_get ($conf, $field, $default, $domain, $node, $service, $plot);
	725	my $hash = shift;
	726	my $field = shift;
	727	my $default = shift;
	728
	729	my $ans = &munin_get ($hash, $field, $default);
597	730	return undef if not defined $ans;
598	731
…	…
602	735	$ans =~ /^enable$/i or
603	736	$ans =~ /^enabled$/i
604		)
605		{
606		return 1;
607		}
608		elsif ($ans =~ /^no$/i or
	737	) {
	738	return 1;
	739	} elsif ($ans =~ /^no$/i or
609	740	$ans =~ /^false$/i or
610	741	$ans =~ /^off$/i or
611	742	$ans =~ /^disable$/i or
612	743	$ans =~ /^disabled$/i
613		)
614		{
615		return 0;
616		}
617		elsif ($ans !~ /\D/)
618		{
619		return $ans;
620		}
621		else
622		{
623		return undef;
	744	) {
	745	return 0;
	746	} elsif ($ans !~ /\D/) {
	747	return $ans;
	748	} else {
	749	return $default;
624	750	}
625	751	}
…	…
670	796	}
671	797
	798	# munin_get: Get variable
	799	# Parameters:
	800	# - $hash: Ref to hash node
	801	# - $field: Name of field to get
	802	# - $default: [optional] Value to return if $field isn't set
	803	# Returns:
	804	# - Success: field contents
	805	# - Failure: $default if defined, else undef
672	806	sub munin_get
673	807	{
674		my $conf = shift;
675		my $field = shift;
676		my $default = shift;
677		my $domain = shift;
678		my $node = shift;
679		my $service = shift;
680		my $plot = shift;
681
682		if (defined $field)
683		{
684		return $conf->{domain}->{$domain}->{node}->{$node}->{client}->{$service}->{"$plot.$field"}
685		if (defined $domain and defined $node and defined $service and defined $plot and
686		defined $conf->{domain}->{$domain}->{node}->{$node}->{client}->{$service}->{"$plot.$field"});
687
688
689
690		return $conf->{domain}->{$domain}->{node}->{$node}->{client}->{$service}->{$field}
691		if (defined $domain and defined $node and defined $service and
692		defined $conf->{domain}->{$domain}->{node}->{$node}->{client}->{$service}->{$field});
693		return $conf->{domain}->{$domain}->{node}->{$node}->{$field}
694		if (defined $domain and defined $node and
695		defined $conf->{domain}->{$domain}->{node}->{$node}->{$field});
696		return $conf->{domain}->{$domain}->{$field}
697		if (defined $domain and defined $conf->{domain}->{$domain}->{$field});
698		return $conf->{$field}
699		if (defined $conf->{$field});
700		return $default;
701		}
702		else
703		{
704		return $conf->{domain}->{$domain}->{node}->{$node}->{client}->{$service}
705		if (defined $domain and defined $node and defined $service and
706		defined $conf->{domain}->{$domain}->{node}->{$node}->{client}->{$service});
707		return $conf->{domain}->{$domain}->{node}->{$node}
708		if (defined $domain and defined $node and
709		defined $conf->{domain}->{$domain}->{node}->{$node});
710		return $conf->{domain}->{$domain}
711		if (defined $domain and defined $conf->{domain}->{$domain});
712		return $conf
713		if (defined $conf);
714		return $default;
715		}
	808	my $hash = shift;
	809	my $field = shift;
	810	my $default = shift;
	811
	812	return $default if (ref ($hash) ne "HASH");
	813	return $hash->{$field} if defined $hash->{$field} and ref($hash->{$field}) ne "HASH";
	814	return $default if not defined $hash->{'#%#parent'};
	815	return munin_get ($hash->{'#%#parent'}, $field, $default);
	816	}
	817
	818	# munin_copy_node_toloc: Copy hash node at
	819	# - $from: Hash node to copy
	820	# - $to: Where to copy it to
	821	# - $loc: Path to node under $to
	822	# Returns:
	823	# - Success: $to
	824	# - Failure: undef
	825	sub munin_copy_node_toloc
	826	{
	827	my $from = shift;
	828	my $to = shift;
	829	my $loc = shift;
	830
	831	return undef unless defined $from and defined $to and defined $loc;
	832
	833	if (ref ($from) eq "HASH") {
	834	foreach my $key (keys %$from) {
	835	if (ref ($from->{$key}) eq "HASH") {
	836	munin_copy_node_toloc ($from->{$key}, $to, [@$loc, $key]);
	837	} else {
	838	munin_set_var_loc ($to, [@$loc, $key], $from->{$key});
	839	}
	840	}
	841	} else {
	842	$to = $from;
	843	}
	844	return $to;
	845	}
	846
	847	# munin_copy_node: Copy hash node
	848	# - $from: Hash node to copy
	849	# - $to: Where to copy it to
	850	# Returns:
	851	# - Success: $to
	852	# - Failure: undef
	853	sub munin_copy_node
	854	{
	855	my $from = shift;
	856	my $to = shift;
	857
	858	if (ref ($from) eq "HASH") {
	859	foreach my $key (keys %$from) {
	860	if (ref ($from->{$key}) eq "HASH") {
	861	# Easier to do with the other copy function
	862	munin_copy_node_toloc ($from->{$key}, $to, [$key]);
	863	} else {
	864	munin_set_var_loc ($to, [$key], $from->{$key});
	865	}
	866	}
	867	} else {
	868	$to = $from;
	869	}
	870	return $to;
716	871	}
717	872

people/jo/multilevel-groups/server/munin-update.in

r1290	r1291
33	33	use POSIX ":sys_wait_h";
34	34	use Storable qw(fd_retrieve nstore_fd);
	35	use Data::Dumper qw(Dumper);
35	36
36	37	my $TIMEOUT = 240;
…	…
158	159	my $bad_procs = 0;
159	160	my $uaddr;
160		if ($do_fork)
161		{
	161
	162	if ($do_fork) {
162	163	# Set up socket
163	164	$uaddr = sockaddr_un("$config->{rundir}/$serversocket");
…	…
171	172	logger("Starting munin-update");
172	173
173		for my $key (keys %{$config->{domain}}) {
174		my $domain_time = Time::HiRes::time;
175		logger ("Processing domain: $key");
176		process_domain($key);
177		$domain_time = sprintf ("%.2f",(Time::HiRes::time - $domain_time));
178		print STATS "UD\|$key\|$domain_time\n";
179		logger ("Processed domain: $key ($domain_time sec)");
180		}
181
182		#sub REAPER {
183		# my $child;
184		# my $waitedpid;
185		# while (($waitedpid = waitpid(-1,WNOHANG)) > 0) {
186		# logger ("reaped $waitedpid" . ($? ? " with exit $?" : ''));
187		# }
188		# $SIG{CHLD} = \&REAPER; # loathe sysV
189		#}
190		#
191		#$SIG{CHLD} = \&REAPER;
192
193		if ($do_fork)
194		{
195		my $timeout_start = time();
196		$SIG{ALRM} = sub { die "Timed out waiting for children. $!\n"};
197		alarm ($TIMEOUT);
198
199		for (;(scalar (keys %children) - $bad_procs > 0);)
200		{
201		eval {
202		$SIG{ALRM} = sub {
203		foreach my $key (keys %children)
204		{
205		if (waitpid ($key, WNOHANG) != 0)
206		{
207		my $domain = $children{$key}->[0];
208		my $name = $children{$key}->[1];
209		my $oldnode = $children{$key}->[3];
210
211		logger ("Reaping child: $domain -> $name.");
212		delete $children{$key};
213		use_old_config ($domain, $name, $oldnode);
214		}
215		}
216		die;
217		};
218
219		alarm (10);
220		accept (Client, Server);
221		};
222		alarm ($TIMEOUT - time() + $timeout_start);
223		if ($@)
224		{
225		if (@queue and defined $config->{max_processes} and
226		$config->{max_processes})
227		{
228		while (keys %children < ($config->{max_processes}-1-$bad_procs))
229		{
230		my $args = pop @queue;
231		logger ("de-queueing new connection: $args->[1]");
232		do_node($args->[0], $args->[1], $args->[2], $args->[3]);
	174	# Make array of what is probably needed to update
	175	my $work_array = [];
	176	if (@limit_hosts) { # Limit what to update if needed
	177	foreach my $nodename (@limit_hosts) {
	178	push @$work_array, map { @{munin_find_field ($_->{$nodename}, "address")} } @{munin_find_field($config, $nodename)};
	179	}
	180	} else { # ...else just search for all adresses to update
	181	push @$work_array, @{munin_find_field($config, "address")};
	182	}
	183
	184	# Go through scheduled work to weed out a few bits, and prepare some info
	185	for my $hashnode (@$work_array) {
	186	my $loc = munin_get_node_loc($hashnode);
	187	my $name = munin_get_node_name ($hashnode);
	188
	189	# Skip anything that has been disabled with the "update" setting
	190	if (!munin_get_bool ($hashnode, "update", "true")) {
	191	logger ("Skipping \"$name\" (update disabled by config)");
	192	next;
	193	}
	194
	195	# We need to connect to this node; queue it
	196	logger ("Queuing \"$name\" for update.");
	197	push (@queue, [$loc, $hashnode, munin_get_node ($oldconfig, $loc)]);
	198	}
	199
	200	my $timeout_start = time();
	201	$SIG{ALRM} = sub { die "Timed out waiting for children. $!\n"};
	202	alarm ($TIMEOUT);
	203
	204	if ($do_fork) {
	205	# Initially set off a bunch of nodes...
	206	if (defined $config->{max_processes}) {
	207	while (keys %children < ($config->{max_processes}-1-$bad_procs)) {
	208	do_node(@{pop @queue});
	209	}
	210	} else {
	211	do_node(@{pop @queue}) while @queue; # No limit on number of procs
	212	}
	213	# Loop as long as there are kids or queue...
	214	for (;(scalar (keys %children) - $bad_procs > 0) or @queue;) {
	215	logger ("Debug: Doing a pass to check children status.") if $DEBUG;
	216
	217	eval { # eval to call accept() with a timeout
	218	$SIG{ALRM} = sub { # If we timeout we need to use the old config
	219	foreach my $key (keys %children) {
	220	if (waitpid ($key, WNOHANG) != 0) {
	221	my $loc = $children{$key}->[0];
	222	my $newnode = $children{$key}->[1];
	223	my $oldnode = $children{$key}->[2];
	224	my $name = munin_get_node_name ($newnode);
	225
	226	logger ("Reaping child: $name.");
	227	delete $children{$key};
	228	munin_copy_node_toloc ($oldnode, $config, $loc);
233	229	}
234	230	}
235		next;
	231	die;
	232	}; # end sub
	233
	234	alarm (10);
	235	accept (Client, Server);
	236	}; # end eval
	237
	238	if ($@) {
	239	if (@queue and defined $config->{max_processes} and $config->{max_processes}) {
	240	logger ("Debug: Checking whether to spawn off more procs from queue.");
	241	while (keys %children < ($config->{max_processes}-1-$bad_procs)) {
	242	logger ("Debug: Popping queue item and spawning new proc.");
	243	do_node(@{pop @queue});
	244	}
236	245	}
237		close STDIN;
238		open (STDIN, "<&Client") \|\| die "can't dup client to stdin";
239
240		my $pid;
241		my $name;
242		my $domain;
243		my $tmpref;
244		eval {
245		$tmpref = fd_retrieve (\*STDIN);
246		};
247		if ($@)
248		{
249		$bad_procs++;
250		logger ("Error communicating with process: $@");
251		}
252		else
253		{
254		($pid, $domain, $name) = ($tmpref->[0], $tmpref->[1], $tmpref->[2]);
255		logger ("connection from $domain -> $name ($pid)");
256
257		eval {
258		$config->{domain}->{$domain}->{node}->{$name} = fd_retrieve (\*STDIN);
259		};
260		if ($@)
261		{
262		logger ("Error during fd_retrieve of config: $@");
263
264		my $domain = $children{$pid}->[0];
265		my $name = $children{$pid}->[1];
266		my $oldnode = $children{$pid}->[3];
267
268		use_old_config ($domain, $name, $oldnode);
269		}
270		delete $children{$pid};
271		waitpid ($pid, 0);
272		logger ("connection from $domain -> $name ($pid) closed");
273		}
274		if (@queue and defined $config->{max_processes} and
275		$config->{max_processes} and
276		scalar (keys %children) < (($config->{max_processes})-1-$bad_procs))
277		{
278		my $args = pop @queue;
279		logger ("de-queueing new connection: $args->[1]");
280		do_node($args->[0], $args->[1], $args->[2], $args->[3]);
281		close (Client);
	246	next;
	247	}
	248
	249	alarm ($TIMEOUT - time() + $timeout_start);
	250	close STDIN;
	251	open (STDIN, "<&Client") \|\| die "can't dup client to stdin";
	252
	253	my $pid;
	254	my $name;
	255	my $loc;
	256	my $tmpref;
	257	eval {
	258	$tmpref = fd_retrieve (\*STDIN);
	259	};
	260	if ($@) {
	261	$bad_procs++;
	262	logger ("Error communicating with process: $@");
	263	} else {
	264	($pid, $loc, $name) = ($tmpref->[0], $tmpref->[1], $tmpref->[2]);
	265	logger ("connection from $name ($pid)");
	266
	267	eval {
	268	my $newnode = fd_retrieve (\*STDIN);
	269	munin_copy_node_toloc ($newnode, $config, $loc);
	270	};
	271	if ($@) {
	272	logger ("Error during fd_retrieve of config: $@");
	273
	274	my $loc = $children{$pid}->[0];
	275	my $newnode = $children{$pid}->[1];
	276	my $oldnode = $children{$pid}->[2];
	277
	278	munin_copy_node_toloc ($oldnode, $config, $loc);
282	279	}
	280	delete $children{$pid};
	281	waitpid ($pid, 0);
	282	logger ("connection from $name ($pid) closed");
	283	}
	284	if (@queue and defined $config->{max_processes} and
	285	$config->{max_processes} and
	286	scalar (keys %children) < (($config->{max_processes})-1-$bad_procs)) {
	287	do_node(@{pop @queue});
	288	close (Client);
	289	}
283	290	}
284	291	alarm (0);
285		}
	292	} else { # No forking, just poll the nodes sequentially...
	293	for (;@queue;) {
	294	do_node(@{pop @queue});
	295	}
	296	}
	297
	298	alarm (0);
286	299
287	300	if ($bad_procs) # Use old configuration for killed children
…	…
289	302	foreach my $key (keys %children)
290	303	{
291		my $~~domain~~ = $children{$key}->[0];
292		my $n~~ame~~ = $children{$key}->[1];
293		my $~~node~~ = $children{$key}->[2];
294		my $~~oldnode = $children{$key}->[3]~~;
295
296		~~use_old_config ($domain, $name, $oldnode~~);
297		logger ("Attempting to use old configuration for $~~domain -> $~~name.");
	304	my $loc = $children{$key}->[0];
	305	my $newnode = $children{$key}->[1];
	306	my $oldnode = $children{$key}->[2];
	307	my $name = munin_get_node_name ($newnode);
	308
	309	munin_copy_node_toloc ($oldnode, $config, $loc);
	310	logger ("Attempting to use old configuration for $name.");
298	311	}
299	312	}
300	313
301	314	unlink ("$config->{rundir}/$serversocket");
	315
302	316
303	317	my $overwrite = &munin_readconfig($conffile);
304	318	$config = &munin_overwrite($config,$overwrite);
305	319
306		&compare_configs ($oldconfig, $config);
	320	compare_configs ($oldconfig, $config);
307	321
308	322	if (&munin_getlock("$config->{rundir}/munin-datafile.lock"))
…	…
330	344	my $just_upgraded = 0;
331	345
332		if (!defined $old->{version} or
333		$old->{version} ne $VERSION)
334		{
	346	if (!defined $old->{version} or $old->{version} ne $VERSION) {
335	347	$just_upgraded = 1;
336	348	}
337	349
338		foreach my $dom (%{$new->{domain}})
339		{
340		foreach my $host (%{$new->{domain}->{$dom}->{node}})
341		{
342		foreach my $serv (%{$new->{domain}->{$dom}->{node}->{$host}->{client}})
343		{
344		foreach my $field (%{$new->{domain}->{$dom}->{node}->{$host}->{client}->{$serv}})
345		{
346		next unless $field =~ /\.label$/;
347		$field =~ s/\.label$//;
348		if ($just_upgraded or &is_changed ($old, $new, $dom, $host, $serv, $field, "max"))
349		{
350		&change_max ($config, $dom, $host, $serv, $field,
351		(defined $new->{domain}->{$dom}->{node}->{$host}->{client}->{$serv}->{$field.".max"} ?
352		$new->{domain}->{$dom}->{node}->{$host}->{client}->{$serv}->{$field.".max"} : undef));
353		}
354		if ($just_upgraded or &is_changed ($old, $new, $dom, $host, $serv, $field, "min"))
355		{
356		&change_min ($config, $dom, $host, $serv, $field,
357		(defined $new->{domain}->{$dom}->{node}->{$host}->{client}->{$serv}->{$field.".min"} ?
358		$new->{domain}->{$dom}->{node}->{$host}->{client}->{$serv}->{$field.".min"} : undef));
359		}
360		if ($just_upgraded or &is_changed ($old, $new, $dom, $host, $serv, $field, "type"))
361		{
362		&change_type ($oldconfig, $config, $dom, $host, $serv, $field,
363		(defined $new->{domain}->{$dom}->{node}->{$host}->{client}->{$serv}->{$field.".type"} ?
364		$new->{domain}->{$dom}->{node}->{$host}->{client}->{$serv}->{$field.".type"} : undef));
365		}
366		}
367		}
368		}
369		}
370
371		}
372
373		sub is_changed
374		{
375		my $old = shift;
376		my $new = shift;
377		my $dom = shift;
378		my $host = shift;
379		my $serv = shift;
380		my $field = shift;
381		my $setting = shift;
382
383		if (defined $new->{domain}->{$dom}->{node}->{$host}->{client}->{$serv}->{$field.".".$setting})
384		{
385		if ((!defined $old->{domain}->{$dom}->{node}->{$host}->{client}->{$serv}->{$field.".".$setting}) or
386		($old->{domain}->{$dom}->{node}->{$host}->{client}->{$serv}->{$field.".".$setting} ne
387		$new->{domain}->{$dom}->{node}->{$host}->{client}->{$serv}->{$field.".".$setting}
388		))
389		{
390		return 1;
391		}
392		}
393
394		if (defined $old->{domain}->{$dom}->{node}->{$host}->{client}->{$serv}->{$field.".".$setting})
395		{
396		if (!defined $new->{domain}->{$dom}->{node}->{$host}->{client}->{$serv}->{$field.".".$setting})
397		{
398		return 1;
399		}
400		}
401
402		return 0;
	350	foreach my $node (@{munin_find_field($new, "label")}) {
	351	my $oldnode = munin_get_node ($old, munin_get_node_loc ($node));
	352	my $name = munin_get_node_name ($node);
	353	my ($oldval, $newval);
	354
	355	$oldval = munin_get ($oldnode, "max", "");
	356	$newval = munin_get ($node, "max", "");
	357	if ($just_upgraded or $oldval ne $newval) {
	358	logger ("Notice: compare_configs: $name.max changed from ".(length $oldval?$oldval:"undefined")." to $newval.");
	359	change_max (munin_get_filename ($node), $newval);
	360	}
	361
	362	$oldval = munin_get ($oldnode, "min", "");
	363	$newval = munin_get ($node, "min", "");
	364	if ($just_upgraded or $oldval ne $newval) {
	365	logger ("Notice: compare_configs: $name.min changed from ".(length $oldval?$oldval:"undefined")." to $newval.");
	366	change_min (munin_get_filename ($node), $newval);
	367	}
	368
	369	$oldval = munin_get ($oldnode, "type", "GAUGE");
	370	$newval = munin_get ($node, "type", "GAUGE");
	371	if ($just_upgraded or $oldval ne $newval) {
	372	logger ("Notice: compare_configs: $name.type changed from ".(length $oldval?$oldval:"undefined")." to $newval.");
	373	change_type (munin_get_filename ($oldnode), munin_get_filename ($node), $newval);
	374	}
	375	}
403	376	}
404	377
405	378	sub change_type
406	379	{
407		my $oconf = shift;
408		my $nconf = shift;
409		my $domain = shift;
410		my $host = shift;
411		my $serv = shift;
412		my $field = shift;
	380	my $ofile = shift;
	381	my $nfile = shift;
413	382	my $val = shift;
414		my $ofile = &munin_get_filename ($oconf, $domain, $host, $serv, $field);
415		my $nfile = &munin_get_filename ($nconf, $domain, $host, $serv, $field);
416
417		logger ("INFO: Changing type of $domain -> $host -> $serv -> $field to " . (defined $val?$val:"GAUGE") . ".\n");
	383
	384	logger ("INFO: Changing type of $ofile to " . (defined $val?$val:"GAUGE"));
418	385	RRDs::tune ($ofile, "-d", "42:".(defined $val?$val:"GAUGE"));
419		unless (rename ($ofile, $nfile))
420		{
	386
	387	logger ("INFO: Changing name of $ofile to $nfile");
	388	unless (rename ($ofile, $nfile)) {
421	389	logger ("ERROR: Could not rename file: $!\n");
422	390	}
…	…
425	393	sub change_max
426	394	{
427		my $config = shift;
428		my $domain = shift;
429		my $host = shift;
430		my $serv = shift;
431		my $field = shift;
432		my $val = shift;
433		my $file = &munin_get_filename ($config, $domain, $host, $serv, $field);
434
435		logger ("INFO: Changing max of $domain -> $host -> $serv -> $field to " . (defined $val?$val:"undef") . ".\n");
	395	my $file = shift;
	396	my $val = shift;
	397
	398	logger ("INFO: Changing max of \"$file\" to \"$val\".\n");
436	399	RRDs::tune ($file, "-a", "42:".(defined $val?$val:"U"));
437	400	}
…	…
439	402	sub change_min
440	403	{
441		my $config = shift;
442		my $domain = shift;
443		my $host = shift;
444		my $serv = shift;
445		my $field = shift;
446		my $val = shift;
447		my $file = &munin_get_filename ($config, $domain, $host, $serv, $field);
448
449		logger ("INFO: Changing min of $domain -> $host -> $serv -> $field to " . (defined $val?$val:"undef") . ".\n");
	404	my $file = shift;
	405	my $val = shift;
	406
	407	logger ("INFO: Changing min of \"$file\" to \"$val\".\n");
450	408	RRDs::tune ($file, "-i", "42:".(defined $val?$val:"U"));
451	409	}
452	410
453		sub process_domain {
454		my ($domain) = @_;
455		for my $key ( keys %{$config->{domain}->{$domain}->{node}}) {
456		if (@limit_hosts and !grep (/^$key$/, @limit_hosts))
457		{
458		logger ("Skipping host \"$key\" - not in hostlist\n") if $DEBUG;
459		next;
460		}
461		if (defined $config->{max_processes} and $config->{max_processes} and
462		($config->{max_processes}-1-$bad_procs) < keys %children)
463		{
464		push (@queue, [$domain, $key, $config->{domain}->{$domain}->{node}->{$key},$oldconfig->{domain}->{$domain}->{node}->{$key}]);
465		}
466		else
467		{
468		do_node($domain,$key ,$config->{domain}->{$domain}->{node}->{$key},$oldconfig->{domain}->{$domain}->{node}->{$key});
469		}
	411	sub do_node {
	412	my ($loc, $newconf, $oldconf) = @_;
	413	return undef unless munin_get ($newconf, "update", "true"); # Skip unless we're updating it
	414	return undef unless munin_get ($newconf, "fetch_data", "true"); # Old name for "update"
	415
	416	my $name = munin_get ($newconf, "host_name") \|\| munin_get_node_name ($newconf);
	417
	418	unless ($newconf->{"address"}) {
	419	logger("No address defined for node: $name");
	420	return undef;
470	421	}
471		}
472
473		sub do_node {
474		my ($domain, $name, $config, $oldconfig) = @_;
475		my $node_time = Time::HiRes::time;
476		logger("Processing node: $name");
477		process_node($domain,$name ,$config,$oldconfig);
478		$node_time = sprintf ("%.2f",(Time::HiRes::time - $node_time));
479		print STATS "UN\|$domain\|$name\|$node_time\n";
480		logger ("Processed node: $name ($node_time sec)");
481		}
482
483		sub process_node {
484		my ($domain,$name,$node,$oldnode) = @_;
485		return if (exists ($node->{fetch_data}) and !$node->{fetch_data});
486		return if (exists ($node->{update}) and $node->{update} ne "yes");
487		unless ($node->{address}) {
488		logger("No address defined for node: $name");
489		return;
490		}
	422	logger ("Debug: do_node: Starting on \"$name\".") if $DEBUG;
491	423
492	424	# Then we fork...
…	…
496	428	if (!defined($pid))
497	429	{ # Something went wrong
498		~~warn "cannot fork: $!"~~;
	430	logger ("Error: Unable to fork: $!");
499	431	return;
500	432	} elsif ($pid)
501	433	{ # I'm the parent
502		$children{$pid} = [$~~domain, $name, $node, $oldnode~~];
	434	$children{$pid} = [$loc, $newconf, $oldconf];
503	435	return;
504	436	} # else I'm the child -- go spawn
…	…
508	440
509	441	# First we get lock...
510		unless (&munin_getlock("$config->{rundir}/munin-$domain-$name.lock"))
511		{
512		logger ("Could not get lock for $node -> $name. Skipping node.");
513		if ($do_fork)
514		{ # Send the old config to the server before we die
	442	unless (&munin_getlock(munin_get($newconf, "rundir").$newconf->{"address"}.".lock")) {
	443	logger ("Could not get lock for \"$name\". Skipping node.");
	444	if ($do_fork) { # Send the old config to the server before we die
515	445	socket (SOCK, PF_UNIX, SOCK_STREAM, 0) \|\| die "socket: $!";
516		connect (SOCK, sockaddr_un (~~"$config->{rundir}~~/$serversocket")) \|\| die "connect: $!";
517		if (ref $oldnode) {
518		~~$config->{domain}->{$domain}->{node}->{$name} = $oldnode~~;
519		~~alarm (0); # Don't want to interrupt this.~~
520		~~my @tmp = ($$, $domain, $name~~);
	446	connect (SOCK, sockaddr_un (munin_get($newconf, "rundir")."/$serversocket")) \|\| die "connect: $!";
	447	alarm (0); # Don't want to interrupt this.
	448	my @tmp = ($$, munin_get_node_loc($newconf), $name);
	449	if (ref $oldconf) {
	450	copy_node ($oldconf, $newconf);
521	451	nstore_fd \@tmp, \*SOCK \|\| die "Could not nstore_fd: $!";
522		nstore_fd \%{~~$config->{domain}->{$domain}->{node}->{$name}~~}, \*SOCK;
	452	nstore_fd \%{munin_get_separated_node ($newconf)}, \*SOCK;
523	453	close SOCK;
	454	} else { # Well, we'll have to give _something_ to the server, or it'll time out.
	455	socket (SOCK, PF_UNIX, SOCK_STREAM, 0) \|\| die "socket: $!";
	456	connect (SOCK, sockaddr_un (munin_get($newconf, "rundir")."/$serversocket")) \|\| die "connect: $!";
	457	nstore_fd \@tmp, \*SOCK \|\| die "Could not nstore_fd: $!";
	458	nstore_fd ({}, \*SOCK);
524	459	}
525	460	exit 1;
526		}
527		else
528		{
	461	} else {
529	462	return 0;
530	463	}
…	…
533	466	my $socket;
534	467
535		if (~~&munin_get ($config, "local_address", undef, $domain, $node~~))
	468	if (munin_get ($newconf, "local_address"))
536	469	{
537		$socket = new IO::Socket::INET ('PeerAddr' => "$node->{address}:".
538		($node->{port} \|\| $config->{domain}->{$domain}->{port} \|\|
539		$config->{port} \|\| "4949"),
540		'LocalAddr' => &munin_get ($config, "local_address", undef, $domain, $node),
541		'Proto' => "tcp", "Timeout" => $timeout);
	470	$socket = new IO::Socket::INET ('PeerAddr' => "$newconf->{address}:".
	471	munin_get ($newconf, "port", "4949"),
	472	'LocalAddr' => munin_get ($newconf, "local_address", undef),
	473	'Proto' => "tcp", "Timeout" => munin_get($newconf, "timeout", 60));
542	474	}
543	475	else
544	476	{
545		$socket = new IO::Socket::INET ('PeerAddr' => "$node->{address}:".
546		($node->{port} \|\| $config->{domain}->{$domain}->{port} \|\|
547		$config->{port} \|\| "4949"),
548		'Proto' => "tcp", "Timeout" => $timeout);
	477	$socket = new IO::Socket::INET ('PeerAddr' => "$newconf->{address}:".
	478	munin_get ($newconf, "port", "4949"),
	479	'Proto' => "tcp", "Timeout" => munin_get($newconf, "timeout", 60));
549	480	}
550	481	my $err = ($socket ? "" : $!);
…	…
555	486	alarm ($timeout);
556	487
557		my @tmp = ($$, ~~$domain~~, $name);
	488	my @tmp = ($$, munin_get_node_loc ($newconf), $name);
558	489
559	490	if (!$socket) {
560		logger ("Could not connect to $name($n~~ode~~->{address}): $err - Attempting to use old configuration");
	491	logger ("Could not connect to $name($newconf->{address}): $err - Attempting to use old configuration");
561	492	# If we can't reach the client. Using old Configuration.
562		if (ref $old~~node~~) {
563		~~$config->{domain}->{$domain}->{node}->{$name} = $oldnode~~;
	493	if (ref $oldconf) {
	494	copy_node ($oldconf, $newconf);
564	495	alarm (0); # Don't want to interrupt this.
565	496	socket (SOCK, PF_UNIX, SOCK_STREAM, 0) \|\| die "socket: $!";
566		connect (SOCK, sockaddr_un (~~"$config->{rundir}~~/$serversocket")) \|\| die "connect: $!";
	497	connect (SOCK, sockaddr_un (munin_get($newconf, "rundir")."/$serversocket")) \|\| die "connect: $!";
567	498	nstore_fd \@tmp, \*SOCK \|\| die "Could not nstore_fd: $!";
568		nstore_fd \%{$config->{domain}->{$domain}->{node}->{$name}}, \*SOCK;
569		alarm ($timeout);
	499	nstore_fd \%{munin_get_separated_node ($newconf)}, \*SOCK;
570	500	close SOCK;
571		}
572		else
573		{ # Well, we'll have to give _something_ to the server, or it'll time out.
	501	} else { # Well, we'll have to give _something_ to the server, or it'll time out.
574	502	socket (SOCK, PF_UNIX, SOCK_STREAM, 0) \|\| die "socket: $!";
575		connect (SOCK, sockaddr_un (~~"$config->{rundir}~~/$serversocket")) \|\| die "connect: $!";
	503	connect (SOCK, sockaddr_un (munin_get($newconf, "rundir")."/$serversocket")) \|\| die "connect: $!";
576	504	nstore_fd \@tmp, \*SOCK \|\| die "Could not nstore_fd: $!";
577	505	nstore_fd ({}, \*SOCK);
…	…
579	507	} else {
580	508	my $ctx;
581		if (!&config_node($domain,$name,$node,$oldnode,$socket))
582		{
583		$config->{domain}->{$domain}->{node}->{$name} = $oldnode;
	509	if (!config_node($newconf,$oldconf,$socket)) {
	510	copy_node ($oldconf, $newconf);
584	511	socket (SOCK, PF_UNIX, SOCK_STREAM, 0) \|\| die "socket: $!";
585		connect (SOCK, sockaddr_un (~~"$config->{rundir}~~/$serversocket")) \|\| die "connect: $!";
	512	connect (SOCK, sockaddr_un (munin_get($newconf, "rundir")."/$serversocket")) \|\| die "connect: $!";
586	513	nstore_fd \@tmp, \*SOCK \|\| die "Could not nstore_fd: $!";
587		nstore_fd \%{~~$config->{domain}->{$domain}->{node}->{$name}~~}, \*SOCK;
	514	nstore_fd \%{munin_get_separated_node ($newconf)}, \*SOCK;
588	515	close SOCK;
589	516	exit 1;
590	517	}
591		&fetch_node($~~domain,$name,$node~~,$socket);
	518	&fetch_node($newconf,$oldconf,$socket);
592	519	# Net::SSLeay::free ($tls) if ($tls); # Shut down TLS
593	520	close $socket;
594	521	alarm (0); # Don't want to interrupt this.
595	522	socket (SOCK, PF_UNIX, SOCK_STREAM, 0) \|\| die "socket: $!";
596		connect (SOCK, sockaddr_un (~~"$config->{rundir}~~/$serversocket")) \|\| die "connect: $!";
	523	connect (SOCK, sockaddr_un (munin_get($newconf, "rundir")."/$serversocket")) \|\| die "connect: $!";
597	524	nstore_fd \@tmp, \*SOCK \|\| die "Could not nstore_fd: $!";
598		~~nstore_fd \%{$config->{domain}->{$domain}->{node}->{$name}~~}, \*SOCK;
	525	nstore_fd \%{munin_get_separated_node ($newconf)}, \*SOCK;
599	526	alarm ($timeout);
600	527	close SOCK;
…	…
606	533	{
607	534	if (!$socket) {
608		logger ("Could not connect to $name($n~~ode~~->{address}): $err\nAttempting to use old configuration");
	535	logger ("Could not connect to $name($newconf->{address}): $err\nAttempting to use old configuration");
609	536	# If we can't reach the client. Using old Configuration.
610		if (ref $old~~node~~) {
611		~~$config->{domain}->{$domain}->{node}->{$name} = $oldnode~~;
	537	if (ref $oldconf) {
	538	copy_node ($oldconf, $newconf);
612	539	}
613	540	} else {
614		next unless (~~&config_node($domain,$name,$node,$oldnode~~,$socket));
615		~~&fetch_node($domain,$name,$node~~,$socket);
	541	next unless (config_node($newconf,$oldconf,$socket));
	542	fetch_node($newconf,$oldconf,$socket);
616	543	# Net::SSLeay::free ($tls) if ($tls); # Shut down TLS
617	544	close $socket;
…	…
926	853	}
927	854
928		sub config_node {
929		my ($domain,$name,$node,$oldnode,$socket) = @_;
930		my $clientdomain = read_socket_single ($socket);
931		my $fetchdomain;
932		chomp($clientdomain) if $clientdomain;
933		if (!$clientdomain) {
934		logger("Got unknown reply from client \"$domain\" -> \"name\" skipping");
935		return 0;
936		}
937		$clientdomain =~ s/\#.*(?:lrrd\|munin) (?:client\|node) at //;
938		if (exists $node->{'use_node_name'} and $node->{'use_node_name'} =~ /^\sy(?:es)\s$/i)
939		{
940		$fetchdomain = $clientdomain;
941		}
942		elsif (exists $node->{'use_default_name'} and $node->{'use_default_name'} =~ /^\sy(?:es)\s$/i)
943		{
944		$fetchdomain = $clientdomain;
945		}
946		else
947		{
948		$fetchdomain = $name;
949		}
950		my $nodeconf_time = Time::HiRes::time;
951
952		my $tls_requirement = &munin_get ($config, "tls", "auto", $domain, $name);
953		logger ("TLS Debug: TLS set to \"$tls_requirement\".") if $DEBUG;
954		if ($tls_requirement ne "disabled")
955		{
956		my $key;
957		my $cert;
958		$key = $cert = munin_get ($config, "tls_pem", undef, $domain, $name);
959		$key = &munin_get ($config, "tls_private_key", "@@CONFDIR@@/munin.pem", $domain, $name)
960		unless defined $key;
961		$cert = &munin_get ($config, "tls_certificate", "@@CONFDIR@@/munin.pem", $domain, $name)
962		unless defined $cert;
963		if (!start_tls ($socket, $tls_requirement, $cert, $key,
964		&munin_get ($config, "tls_verify_certificate", undef, $domain, $name),
965		&munin_get ($config, "tls_verify_depth", 5, $domain, $name),
966		))
967		{
968		if ($tls_requirement eq "paranoid" or $tls_requirement eq "enabled")
969		{
970		logger ("ERROR: Could not establish TLS connection to \"$domain :: $name\". Skipping.");
971		exit 13;
972		}
973		}
974		}
975
976		logger("Configuring node: $name") if $DEBUG;
977		my @services;
978		eval {
979		local $SIG{ALRM} = sub { die "Could not run list on $name ($fetchdomain): $!\n"};
980		alarm 5; # Should be enough to check the list
981		write_socket_single ($socket, "list $fetchdomain\n");
982		my $list = read_socket_single ($socket);
983		exit 1 unless defined $list;
984		chomp $list;
985		@services = split / /,$list;
986		alarm 0;
987		};
988		if ($@) {
989		die unless ($@ =~ m/Could not run list/);
990		logger ("Could not get list from $node->{address}: $!\nAttempting to use old configuration");
991		if (ref $oldnode) {
992		$config->{domain}->{$domain}->{node}->{$name} = $oldnode;
993		}
994		@services = [];
995		}
996
997		for my $service (@services) {
998		my $servname = $service;
999		my $fields = {};
1000		$servname =~ s/\W/_/g;
1001		next if (exists ($node->{client}->{$servname}->{fetch_data}) and
1002		$node->{client}->{$servname}->{fetch_data} == 0);
1003		next if (exists ($node->{client}->{$servname}->{update}) and
1004		$node->{client}->{$servname}->{update} ne "yes");
1005		next if (@limit_services and !grep (/^$servname$/, @limit_services));
1006		my @graph_order = (exists $node->{client}->{$servname}->{graph_order} ?
1007		split (/\s+/, $node->{client}->{$servname}->{graph_order}) : ());
1008		my $serviceconf_time = Time::HiRes::time;
1009		if ($servname ne $service)
1010		{
1011		$node->{client}->{$servname}->{realservname} = $service;
1012		}
1013		logger("Configuring service: $name->$servname") if $DEBUG;
1014		write_socket_single ($socket, "config $service\n");
1015		my @lines = read_socket($socket);
1016		return unless $socket;
1017		next unless (@lines);
1018		for (@lines) {
1019		if (/\# timeout/) {
1020		logger("Client reported timeout in configuration of $servname");
1021		if ($oldnode->{client}->{$servname}) {
1022		logger("Attempting to use old configuration");
1023		$config->{domain}->{$domain}->{node}->{$name}->{client}->{$servname} = $oldnode->{client}->{$servname};
1024		} else {
1025		logger("Skipping configuration of $servname");
1026		delete $node->{client}->{$servname};
1027		}
1028		}
1029		elsif (/^(\w+)\.(\w+)\s+(.+)/) {
1030		my ($client,$type,$value) = ($1,$2,$3);
1031		$client = &sanitise_fieldname ($client, $fields);
1032		if (($type) and ($type eq "label")) {
1033		$value =~ s/\\/_/g; # Sanitise labels
1034		}
1035		$node->{client}->{$servname}->{$client.".".$type} = "$value";
1036		logger ("config: $name->$client.$type = $value") if $DEBUG;
1037		if (($type) and ($type eq "label")) {
1038		push (@graph_order,$client)
1039		unless grep (/^$client$/, @graph_order);
1040		}
1041		} elsif (/(^[^\s\#]+)\s+(.+)/) {
1042		my ($keyword) = $1;
1043		my ($value) = $2;
1044		$node->{client}->{$servname}->{$keyword} = $value;
1045		logger ("Config: $keyword = $value") if $DEBUG;
1046		if ($keyword eq "graph_order") {
1047		@graph_order = split (/\s+/, $node->{client}->{$servname}->{graph_order});
1048		}
1049		}
1050		}
1051		for my $subservice (keys %{$node->{client}->{$servname}}) {
1052		my ($client,$type) = split /\./,$subservice;
1053		my ($value) = $node->{client}->{$servname}->{$subservice};
1054		if (($type) and ($type eq "label")) {
1055		my $fname = "$config->{dbdir}/$domain/$name-$servname-$client-" .
1056		lc substr (($node->{client}->{$servname}->{"$client.type"}\|\|"GAUGE"),0,1).
1057		".rrd";
1058		if (! -f "$fname") {
1059		logger ("creating rrd-file for $servname->$subservice");
1060		mkdir "$config->{dbdir}/$domain/",0777;
1061		my @args = ("$fname",
1062		"DS:42:".($node->{client}->{$servname}->{"$client.type"} \|\| "GAUGE").":600:".
1063		(defined $node->{client}->{$servname}->{"$client.min"} ?
1064		$node->{client}->{$servname}->{"$client.min"} :
1065		"U") . ":" . ($node->{client}->{$servname}->{"$client.max"} \|\| "U"));
1066		my $resolution = &munin_get ($config, "graph_data_size", "normal", $domain, $node, $servname);
1067		if ($resolution eq "normal")
1068		{
1069		push (@args,
	855	sub config_node
	856	{
	857	my ($newconf,$oldconf,$socket) = @_;
	858	my $clientdomain = read_socket_single ($socket);
	859	my $fetchdomain;
	860	my $name = munin_get_node_name ($newconf);
	861	chomp($clientdomain) if $clientdomain;
	862	if (!$clientdomain) {
	863	logger("Got unknown reply from client \"$name\" skipping");
	864	return 0;
	865	}
	866	$clientdomain =~ s/\#.*(?:lrrd\|munin) (?:client\|node) at //;
	867
	868	# Decide what to ask for
	869	if (munin_get ($newconf, "use_node_name")) {
	870	$fetchdomain = $clientdomain;
	871	} elsif (munin_get ($newconf, "use_default_name")) {
	872	$fetchdomain = $clientdomain;
	873	} else {
	874	$fetchdomain = $name;
	875	}
	876
	877	my $tls_requirement = &munin_get ($config, "tls", "auto");
	878	logger ("TLS Debug: TLS set to \"$tls_requirement\".") if $DEBUG;
	879	if ($tls_requirement ne "disabled")
	880	{
	881	my $key;
	882	my $cert;
	883	$key = $cert = munin_get ($config, "tls_pem");
	884	$key = &munin_get ($config, "tls_private_key", "@@CONFDIR@@/munin.pem")
	885	unless defined $key;
	886	$cert = &munin_get ($config, "tls_certificate", "@@CONFDIR@@/munin.pem")
	887	unless defined $cert;
	888	if (!start_tls ($socket, $tls_requirement, $cert, $key,
	889	&munin_get ($config, "tls_verify_certificate"),
	890	&munin_get ($config, "tls_verify_depth", 5),
	891	))
	892	{
	893	if ($tls_requirement eq "paranoid" or $tls_requirement eq "enabled")
	894	{
	895	logger ("ERROR: Could not establish TLS connection to \"$name\". Skipping.");
	896	exit 13;
	897	}
	898	}
	899	}
	900
	901	logger("Configuring node: $name") if $DEBUG;
	902	my @services;
	903	eval {
	904	local $SIG{ALRM} = sub { die "Could not run list on $name ($fetchdomain): $!\n"};
	905	alarm 5; # Should be enough to check the list
	906	write_socket_single ($socket, "list $fetchdomain\n");
	907	my $list = read_socket_single ($socket);
	908	exit 1 unless defined $list;
	909	chomp $list;
	910	@services = split / /,$list;
	911	alarm 0;
	912	};
	913	if ($@) {
	914	die unless ($@ =~ m/Could not run list/);
	915	logger ("Error: Could not get list from $newconf->{address}: $!\nAttempting to use old configuration");
	916	if (ref $oldconf) {
	917	copy_node ($oldconf, $newconf);
	918	}
	919	@services = [];
	920	}
	921
	922	for my $service (@services) {
	923	my $servname = $service;
	924	my $fields = {};
	925	$servname =~ s/\W/_/g;
	926	munin_set_var_loc ($newconf, [$servname, "realservname"], $service);
	927	logger("Inspecting possible service: $servname") if $DEBUG;
	928	next unless (munin_get_bool ($newconf->{$servname}, "update", "true"));
	929	next unless (munin_get_bool ($newconf->{$servname}, "fetch_data", "true"));
	930	next if (@limit_services and !grep (/^$servname$/, @limit_services));
	931
	932	my @graph_order = split (/\s+/, munin_get ($newconf->{$service}, "graph_order", ""));
	933	logger("Configuring service: $servname") if $DEBUG;
	934	write_socket_single ($socket, "config $service\n");
	935	my @lines = read_socket($socket);
	936	return unless $socket;
	937	next unless (@lines);
	938	for (@lines) {
	939	if (/\# timeout/) {
	940	logger("Client reported timeout in configuration of $servname");
	941	if ($oldconf->{$servname}) {
	942	logger("Attempting to use old configuration");
	943	copy_node ($newconf->{$servname}, $oldconf->{$servname});
	944	} else {
	945	logger("Skipping configuration of $servname");
	946	delete $newconf->{$servname};
	947	}
	948	} elsif (/^(\w+)\.(\w+)\s+(.+)/) {
	949	my ($client,$type,$value) = ($1,$2,$3);
	950	$client = &sanitise_fieldname ($client, $fields);
	951	if (($type) and ($type eq "label")) {
	952	$value =~ s/\\/_/g; # Sanitise labels
	953	push (@graph_order,$client) unless grep (/^$client$/, @graph_order);
	954	}
	955	munin_set_var_loc ($newconf, [$servname, $client, $type], "$value");
	956	logger ("config: $servname->$client.$type = $value") if $DEBUG;
	957	} elsif (/(^[^\s\#]+)\s+(.+)/) {
	958	my ($keyword) = $1;
	959	my ($value) = $2;
	960	munin_set_var_loc ($newconf, [$servname, $keyword], "$value");
	961	logger ("Config: $servname->$keyword = $value") if $DEBUG;
	962	if ($keyword eq "graph_order") {
	963	@graph_order = split (/\s+/, $value);
	964	}
	965	}
	966	}
	967	for my $field (keys %{$newconf->{$servname}}) {
	968	# Skip anything that isn't a field
	969	next if $field =~ /^#%#/;
	970	next unless (ref ($newconf->{$servname}->{$field}) eq "HASH" and
	971	defined ($newconf->{$servname}->{$field}->{"label"}));
	972
	973	my $fhash = $newconf->{$servname}->{$field};
	974
	975	# Check if file exists
	976	my $fname = munin_get_filename ($fhash);
	977	(my $dirname = $fname) =~ s/\/[^\/]+$//;
	978
	979	if (! -f "$fname") {
	980	logger ("creating rrd-file for $servname->$field: \"$fname\"");
	981	mkdir_p ($dirname, 0777);
	982	my @args = ("$fname",
	983	"DS:42:".munin_get($fhash, "type", "GAUGE").":600:".
	984	munin_get($fhash, "min", "U") . ":" . munin_get($fhash, "max", "U"));
	985
	986	my $resolution = &munin_get ($fhash, "graph_data_size", "normal");
	987	if ($resolution eq "normal") {
	988	push (@args,
1070	989	"RRA:AVERAGE:0.5:1:576", # resolution 5 minutes
1071	990	"RRA:MIN:0.5:1:576",
…	…
1080	999	"RRA:MIN:0.5:288:450",
1081	1000	"RRA:MAX:0.5:288:450");
1082		}
1083		elsif ($resolution eq "huge")
1084		{
1085		push (@args, "RRA:AVERAGE:0.5:1:115200"); # resolution 5 minutes, for 400 days
1086		push (@args, "RRA:MIN:0.5:1:115200"); # Three times? ARGH!
1087		push (@args, "RRA:MAX:0.5:1:115200"); # Three times? ARGH!
1088		}
1089		RRDs::create @args;
1090		if (my $ERROR = RRDs::error) {
1091		logger ("Unable to create \"$fname\": $ERROR");
1092		}
1093		}
1094		}
1095		$node->{client}->{$servname}->{graph_order} = join(' ',@graph_order);
1096		}
1097		$serviceconf_time = sprintf ("%.2f",(Time::HiRes::time - $serviceconf_time));
1098		print STATS "CS\|$domain\|$name\|$servname\|$serviceconf_time\n";
1099		logger ("Configured service: $name -> $servname ($serviceconf_time sec)");
1100		}
1101		$nodeconf_time = sprintf ("%.2f",(Time::HiRes::time - $nodeconf_time));
1102		print STATS "CN\|$domain\|$name\|$nodeconf_time\n";
	1001	} elsif ($resolution eq "huge") {
	1002	push (@args, "RRA:AVERAGE:0.5:1:115200"); # resolution 5 minutes, for 400 days
	1003	push (@args, "RRA:MIN:0.5:1:115200"); # Three times? ARGH!
	1004	push (@args, "RRA:MAX:0.5:1:115200"); # Three times? ARGH!
	1005	}
	1006	RRDs::create @args;
	1007	if (my $ERROR = RRDs::error) {
	1008	logger ("Unable to create \"$fname\": $ERROR");
	1009	}
	1010	}
	1011	}
	1012	munin_set_var_loc ($newconf, ["graph_order"], join(' ',@graph_order));
	1013	}
1103	1014	return 0 unless $socket;
1104		~~logger("Configured node: $name ($nodeconf_time sec)")~~;
1105		return 1;
1106		}
1107
1108		~~sub fetch_node~~ {
1109		my ($~~domain,$name,$node~~,$socket) = @_;
1110		my $n~~odefetch_time = Time::HiRes::time~~;
	1015	return 1;
	1016	}
	1017
	1018	sub fetch_node
	1019	{
	1020	my ($newconf,$oldconf,$socket) = @_;
	1021	my $name = munin_get_node_name ($newconf);
1111	1022	logger("Fetching node: $name") if $DEBUG;
1112		for my $service (keys %{$n~~ode->{client}~~}) {
1113		~~my $servicefetch_time = Time::HiRes::time~~;
1114		~~logger("Fetching service: $name->$service") if $DEBUG~~;
1115		~~next if (exists ($node->{client}->{$service}->{fetch_data}) and~~
1116		~~$node->{client}->{$service}->{fetch_data} == 0~~);
1117		next ~~if (exists ($node->{client}->{$service}->{update}) and~~
1118		~~$node->{client}->{$service}->{update} ne "yes"~~);
	1023	for my $service (keys %{$newconf}) {
	1024	next if ref ($newconf->{$service}) ne "HASH";
	1025	next if $service =~ /^#%#/;
	1026	logger("Fetching service: $service") if $DEBUG;
	1027	next unless exists ($newconf->{$service}->{"graph_title"});
	1028	next unless (munin_get_bool ($newconf->{$service}, "update", "true"));
	1029	next unless (munin_get_bool ($newconf->{$service}, "fetch_data", "true"));
1119	1030	next if (@limit_services and !grep (/^$service$/, @limit_services));
1120		my $realservname = ( $node->{client}->{$service}->{realservname} \|\|
1121		$service );
1122		delete $node->{client}->{$service}->{realservname}
1123		if exists $node->{client}->{$service}->{realservname};
	1031
	1032	# Read (and get rid of) realservname
	1033	my $realservname = ( $newconf->{$service}->{"realservname"} \|\| $service );
	1034	delete $newconf->{$service}->{"realservname"}
	1035	if exists $newconf->{$service}->{"realservname"};
	1036
1124	1037	write_socket_single ($socket, "fetch $realservname\n");
1125	1038	my @lines = &read_socket($socket);
…	…
1149	1062
1150	1063	$key = &sanitise_fieldname ($key, $fields);
1151		if (exists $node->{client}->{$service}->{$key.".label"}) {
1152		my $fname =
1153		"$config->{dbdir}/$domain/$name-$service-$key-".
1154		lc
1155		substr(($node->{client}->{$service}->{$key.".type"}\|\|
1156		"GAUGE"),0,1).".rrd";
	1064	if (exists $newconf->{$service}->{$key}->{"label"}) {
	1065	my $fname = munin_get_filename ($newconf->{$service}->{$key});
1157	1066
1158	1067	logger("Updating $fname with $value") if $DEBUG;
…	…
1162	1071	}
1163	1072	} else {
1164		logger ("Unable to update $~~domain -> $~~name -> $service -> $key: No such field (no \"label\" field defined when running plugin with \"config\").");
	1073	logger ("Unable to update $name -> $service -> $key: No such field (no \"label\" field defined when running plugin with \"config\").");
1165	1074	}
1166	1075	} elsif (/(\w+)\.extinfo\s+(.+)/) {
1167		~~$config->{domain}->{$domain}->{node}->{$name}->{client}->{$service}->{$1.".extinfo"} = $2~~;
	1076	munin_set_var_loc ($newconf, [$service, $service, $1, "extinfo"], $2);
1168	1077	}
1169	1078	}
1170		$servicefetch_time = sprintf ("%.2f",(Time::HiRes::time - $servicefetch_time));
1171		logger ("Fetched service: $name -> $service ($servicefetch_time sec)");
1172		print STATS "FS\|$domain\|$name\|$service\|$servicefetch_time\n";
1173		}
1174		$nodefetch_time = sprintf ("%.2f",(Time::HiRes::time - $nodefetch_time));
1175		logger ("Fetched node: $name ($nodefetch_time sec)");
1176		print STATS "FN\|$domain\|$name\|$nodefetch_time\n";
1177
	1079	}
1178	1080	return 1;
1179		}
1180
1181		~~sub use_old_config~~
1182		{
1183		~~my $domain = shift;~~
1184		~~my $name = shift;~~
1185		~~my $oldnode = shift;~~
1186
1187		~~$config->{domain}->{$domain}->{node}->{$name} = $oldnode;~~
1188		~~logger ("Attempting to use old configuration for $domain -> $name.");~~
1189	1081	}
1190	1082
…	…
1252	1144	}
1253	1145
	1146	sub copy_node
	1147	{
	1148	my $from = shift;
	1149	my $to = shift;
	1150
	1151	if (ref ($from) eq "HASH") {
	1152	foreach my $key (keys %$from) {
	1153	next if $key =~ /^#%#/;
	1154	$to->{$key} = $from->{$key};
	1155	}
	1156	} else {
	1157	$to = $from;
	1158	}
	1159	return $to;
	1160	}
	1161
	1162	sub mkdir_p
	1163	{
	1164	my $dirname = shift;
	1165	my $umask = shift;
	1166
	1167	return $dirname if (-e $dirname);
	1168
	1169	(my $prev = $dirname) =~ s/\/[^\/]+$//;
	1170	if (mkdir_p ($prev, $umask)) {
	1171	if (mkdir ($dirname, $umask)) {
	1172	return $dirname;
	1173	} else {
	1174	return undef;
	1175	}
	1176	} else {
	1177	return undef;
	1178	}
	1179	}
	1180
1254	1181	1;
1255	1182
…	…
1341	1268	=head1 COPYRIGHT
1342	1269
1343		Copyright © 2002-2006 Audun Ytterdal, Jimmy Olsen, and Tore Anderson / Linpro AS.
	1270	Copyright Â© 2002-2006 Audun Ytterdal, Jimmy Olsen, and Tore Anderson / Linpro AS.
1344	1271
1345	1272	This is free software; see the source for copying conditions. There is

Navigation

Changeset 1291

Legend:

people/jo/multilevel-groups/server/Munin.pm.in

people/jo/multilevel-groups/server/munin-update.in

Download in other formats: