Navigation

← Previous Changeset
Next Changeset →

Changeset 1257

Timestamp:

18/11/06 23:47:02 (5 years ago)

Author:

janl

Message:

Run tidyperl on munin-node and munin-run, some very basic cleanup and module use.

Files:

people/janl/src/libperl/Munin.pm (modified) (1 diff)
people/janl/src/libperl/Munin/Node.pm (modified) (2 diffs)
people/janl/src/node/munin-node (modified) (13 diffs)
people/janl/src/node/munin-run (modified) (9 diffs)

Legend:

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

people/janl/src/libperl/Munin.pm

r1256	r1257
345	345	} ## end sub munin_get
346	346
	347
	348	sub copyright {
	349	# Return a string containing copyright and licensing information.
	350	return <<"EOM"
	351	Written by Audun Ytterdal, Jimmy Olsen, Tore Anderson, Nicolai Langfeldt
	352
	353	Copyright (C) 2002-2006 by the authors.
	354
	355	The work has in part been financed by Linpro AS. http://linpro.no/
	356
	357	This is free software released under the GNU General Public License. There
	358	is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR
	359	PURPOSE. For details, please refer to the file COPYING that is included
	360	with this software or refer to
	361	http://www.fsf.org/licensing/licenses/gpl.txt
	362	EOM
	363	}
	364
347	365	# Return true to mark successful inclusion of module.
348	366	1;

people/janl/src/libperl/Munin/Node.pm

r1248	r1257
1		package Muninnode;
2		# Copyright (C) 200~~4-2006 Audun Ytterdal, Jimmy Olsen,~~ Nicolai Langfeldt
	1	package Munin::Node;
	2	# Copyright (C) 2006 Nicolai Langfeldt
3	3	#
4	4	# This program is free software; you can redistribute it and/or
…	…
19	19
20	20	use Exporter;
21		@ISA = ~~('Exporter'~~);
22		@EXPORT=();
	21	@ISA = qw(main Exporter);
	22	@EXPORT=qw(clean_envir);
23	23
24	24	use strict;
25	25
26		my $VERSION = '@@VERSION@@';
27		my $CONFDIR = '@@CONFDIR@@';
28		my $PLUGINUSER = '@@PLUGINUSER@@';
29		my $GROUP = '@@GROUP@@';
30		my $STATEDIR = '@@STATEDIR@@';
31		my $PLUGSTATE = '@@PLUGSTATE@@';
	26	sub clean_envir {
	27	# "Clean" environment to disable taint-checking on the environment. We
	28	# _know_ that the environment is insecure, but we want to let admins
	29	# shoot themselves in the foot with it, if they want to.
	30
	31	foreach my $key ( keys %ENV ) {
	32	# Remove all locale settings so that we get "." as decimal point
	33	# and so on.
	34	if (substr( $key, 0, 3 ) eq 'LC_' or
	35	substr( $key, 0, 4 ) eq 'LANG' ) {
	36	delete( $ENV{$key} );
	37	next;
	38	}
	39
	40	$ENV{$key} =~ /^(.*)$/;
	41	$ENV{$key} = $1;
	42	}
	43	}

people/janl/src/node/munin-node

r1249	r1257
1		#!@@PERL@@ -wT
2		# -- cperl --
	1	#!/usr/bin/perl -wT
3	2	#
4	3	# Copyright (C) 2002-2006 Audun Ytterdal, Jimmy Olsen, Tore Anderson,
…	…
28	27	use Getopt::Long;
29	28	use Munin;
30		use Net::Server::Fork; # any personality will do
	29	use Munin::Node;
	30	use Net::Server::Fork;
31	31
32	32	my $tls;
33		my %tls_verified = ( "level" => 0, "cert" => "", "verified" => 0, "required_depth" => 5 );
34
35		chdir ("/");
36
37		# "Clean" environment to disable taint-checking on the environment. We _know_
38		# that the environment is insecure, but we want to let admins shoot themselves
39		# in the foot with it, if they want to.
40		foreach my $key (keys %ENV)
41		{
42		$ENV{$key} =~ /^(.*)$/;
43		$ENV{$key} = $1;
44		}
45
46		$0 =~ /^(.*)$/; # for some strange reason won't "$0 = $0;" work.
	33	my %tls_verified = (
	34	"level" => 0,
	35	"cert" => "",
	36	"verified" => 0,
	37	"required_depth" => 5
	38	);
	39
	40	chdir("/");
	41
	42	clean_envir;
	43
	44	$0 =~ /^(.*)$/; # for some strange reason won't "$0 = $0;" work.
47	45	$0 = $1;
48	46
…	…
51	49	my %services;
52	50	my %nodes;
53		my $servicedir~~="@@CONFDIR@@~~/plugins";
54		my $sconfdir~~="@@CONFDIR@@~~/plugin-conf.d";
55		my $conffile~~="@@CONFDIR@@~~/munin-node.conf";
56		my $FQDN="";
57		my $do_usage = 0;
58		my $DEBUG = 0;
	51	my $servicedir = "$CONFDIR/plugins";
	52	my $sconfdir = "$CONFDIR/plugin-conf.d";
	53	my $conffile = "$CONFDIR/munin-node.conf";
	54	my $FQDN = "";
	55	my $do_usage = 0;
	56	my $DEBUG = 0;
59	57	my $do_version = 0;
60		my $VERSION=$Muninnode::VERSION;
61		my $defuser = getpwnam ("@@PLUGINUSER@@");
62		my $defgroup= getgrnam ("@@GROUP@@");
63		my $paranoia= 0;
64		my @ignores = ();
65		my %sconf = ('timeout' => 10);
66		my $caddr = "";
67
68		$do_usage=1 unless
69		GetOptions ( "config=s" => \$conffile,
70		"debug!" => \$DEBUG,
71		"version!" => \$do_version,
72		"paranoia!" => \$paranoia,
73		"help" => \$do_usage );
74
75		if ($do_usage)
76		{
	58	my $VERSION = '@@VERSION@@';
	59	my $defuser = getpwnam($PLUGINUSER);
	60	my $defgroup = getgrnam($GROUP);
	61	my $paranoia = 0;
	62	my @ignores = ();
	63	my %sconf = ( 'timeout' => 10 );
	64	my $caddr = "";
	65
	66	$do_usage = 1
	67	unless GetOptions(
	68	"config=s" => \$conffile,
	69	"debug!" => \$DEBUG,
	70	"version!" => \$do_version,
	71	"paranoia!" => \$paranoia,
	72	"help" => \$do_usage
	73	);
	74
	75	if ($do_usage) {
77	76	print "Usage: $0 [options]
78	77
…	…
90	89	}
91	90
92		if ($do_version)
93		{
94		print "munin-node (munin-node) version $VERSION.
95		Written by Audun Ytterdal, Jimmy Olsen, Tore Anderson / Linpro AS
96
97		Copyright (C) 2002-2005
98
99		This is free software released under the GNU General Public License. There
100		is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR
101		PURPOSE. For details, please refer to the file COPYING that is included
102		with this software or refer to
103		http://www.fsf.org/licensing/licenses/gpl.txt
104		";
105		exit 0;
	91	if ($do_version) {
	92	print "munin-node (munin-node) version $VERSION.".
	93	Munin::copyright;
	94	exit 0;
106	95	}
107	96
…	…
111	100	# Check permissions of configuration
112	101
113		if (!&check_perms ($servicedir) or !&check_perms ($conffile))
114		{
115		die "Fatal error. Bailing out.";
116		}
117
118		if (! -f $conffile) {
119		print "ERROR: Cannot open $conffile\n";
120		exit 1;
	102	if ( !&check_perms($servicedir) or !&check_perms($conffile) ) {
	103	die "Fatal error. Bailing out.";
	104	}
	105
	106	if ( !-f $conffile ) {
	107	print "ERROR: Cannot open $conffile\n";
	108	exit 1;
121	109	}
122	110
123	111	# A hack to overide the hostname if everyhing thing else fails
124		open FILE,$conffile or die "Cannot open $conffile\n";
	112	open FILE, $conffile or die "Cannot open $conffile\n";
125	113	while (<FILE>) {
126		chomp;
127		s/#.*//; # no comments
128		s/^\s+//; # no leading white
129		s/\s+$//; # no trailing white
130		next unless length; # anything left?
131		/(^\w)\s+(.)/;
132		if (($1 eq "host_name" or $1 eq "hostname") and $2)
133		{
134		$FQDN=$2;
135		}
136		elsif (($1 eq "default_plugin_user" or $1 eq "default_client_user") and $2)
137		{
138		my $tmpid = $2;
139		$defuser = &get_uid ($tmpid);
140		if (! defined ($defuser))
141		{
142		die "Default user defined in \"$conffile\" does not exist ($tmpid)";
143		}
144		}
145		elsif (($1 eq "default_plugin_group" or $1 eq "default_client_group") and $2)
146		{
147		my $tmpid = $2;
148		$defgroup = &get_gid ($tmpid);
149		if (! defined ($defgroup))
150		{
151		die "Default group defined in \"$conffile\" does not exist ($tmpid)";
152		}
153		}
154		elsif (($1 eq "paranoia") and defined $2)
155		{
156		if ("$2" eq "no" or "$2" eq "false" or "$2" eq "off" or "$2" eq "0")
157		{
158		$paranoia = 0;
159		}
160		else
161		{
162		$paranoia = 1;
163		}
164		}
165		elsif (($1 eq "ignore_file") and defined $2)
166		{
167		push @ignores, $2;
168		}
169		elsif (($1 eq "timeout") and defined $2)
170		{
171		$sconf{'timeout'} = $2;
172		}
173		elsif (defined $1 and defined $2 and not defined $sconf{$1})
174		{
175		$sconf{$1} = $2;
176		}
177		}
	114	chomp;
	115	s/#.*//; # no comments
	116	s/^\s+//; # no leading white
	117	s/\s+$//; # no trailing white
	118	next unless length; # anything left?
	119	/(^\w)\s+(.)/;
	120	if ( ( $1 eq "host_name" or $1 eq "hostname" ) and $2 ) {
	121	$FQDN = $2;
	122	} elsif ( ( $1 eq "default_plugin_user" or $1 eq "default_client_user" )
	123	and $2 )
	124	{
	125	my $tmpid = $2;
	126	$defuser = &get_uid($tmpid);
	127	if ( !defined($defuser) ) {
	128	die
	129	"Default user defined in '$conffile' does not exist ($tmpid)";
	130	}
	131	} elsif ( ( $1 eq "default_plugin_group" or $1 eq "default_client_group" )
	132	and $2 ) {
	133	my $tmpid = $2;
	134	$defgroup = &get_gid($tmpid);
	135	if ( !defined($defgroup) ) {
	136	die "Default group defined in '$conffile' does not exist ($tmpid)";
	137	}
	138	} elsif ( ( $1 eq "paranoia" ) and defined $2 ) {
	139	if ( "$2" eq "no" or "$2" eq "false" or "$2" eq "off" or "$2" eq "0" )
	140	{
	141	$paranoia = 0;
	142	} else {
	143	$paranoia = 1;
	144	}
	145	} elsif ( ( $1 eq "ignore_file" ) and defined $2 ) {
	146	push @ignores, $2;
	147	} elsif ( ( $1 eq "timeout" ) and defined $2 ) {
	148	$sconf{'timeout'} = $2;
	149	} elsif ( defined $1 and defined $2 and not defined $sconf{$1} ) {
	150	$sconf{$1} = $2;
	151	}
	152	} ## end while (<FILE>)
178	153
179	154	$FQDN \|\|= &get_fq_hostname;
180	155
181		$ENV{FQDN}=$FQDN;
182
183		# Some locales uses "," as decimal separator. This can mess up a lot
184		# of plugins.
185		$ENV{'LC_ALL'}='C';
186
187		MyPackage->run(conf_file => $conffile,
188		pid_file => "@@STATEDIR@@/munin-node.pid");
189		exit;
190
191
192
	156	$ENV{FQDN} = $FQDN;
	157
	158	MyPackage->run(
	159	conf_file => $conffile,
	160	pid_file => "@@STATEDIR@@/munin-node.pid"
	161	);
	162	exit;
193	163
194	164	### over-ridden subs below
…	…
196	166	sub pre_loop_hook {
197	167	my $self = shift;
198		print STDERR "In pre_loop_hook.\n" if $DEBUG;
	168	print STDERR "In pre_loop_hook.\n" if $DEBUG;
199	169	&load_services;
200	170	$self->SUPER::pre_loop_hook;
…	…
202	172
203	173	sub show_version {
204		print "munins node on $FQDN version: $VERSION\n"
	174	print "munins node on $FQDN version: $VERSION\n";
	175	print "Munin.pm version $Munin::VERSION\n";
	176	print "Munin::Node.pm version $Munin::Node::VERSION\n";
205	177	}
206	178
207	179	sub show_nodes {
208		~~for my $node (keys %nodes~~) {
209		~~net_write~~ ("$node\n");
210		}
211		~~net_write~~ (".\n");
	180	for my $node ( keys %nodes ) {
	181	net_write("$node\n");
	182	}
	183	net_write(".\n");
212	184	}
213	185
…	…
216	188	eval {
217	189	require Sys::Hostname;
218		$hostname = (~~gethostbyname(Sys::Hostname::hostname())~~)[0];
	190	$hostname = ( gethostbyname( Sys::Hostname::hostname() ) )[0];
219	191	};
220	192	return $hostname if $hostname;
221	193
222		$hostname = `hostname`; # Fall$
	194	$hostname = `hostname`; # Fall$
223	195	chomp($hostname);
224	196	$hostname =~ s/\s//g;
…	…
227	199
228	200	sub load_services {
229		if (opendir (DIR,$sconfdir))
230		{
231		FILES:
232		for my $file (grep { -f "$sconfdir/$_" } readdir (DIR))
233		{
234		next if $file =~ m/^\./; # Hidden files
235		next if $file !~ m/^([-\w.]+)$/; # Skip if any weird chars
236		$file = $1; # Not tainted anymore.
237		foreach my $regex (@ignores)
238		{
239		next FILES if $file =~ /$regex/;
240		}
241		if (!&load_auth_file ($sconfdir, $file, \%sconf))
242		{
243		warn "Something wicked happened while reading \"$servicedir/$file\". Check the previous log lines for spesifics.";
244		}
245		}
246		closedir (DIR);
247		}
248
249		opendir (DIR,$servicedir) \|\| die "Cannot open plugindir: $servicedir $!";
250		FILES:
251		for my $file (grep { -f "$servicedir/$_" } readdir(DIR)) {
252		next if $file =~ m/^\./; # Hidden files
253		next if $file =~ m/.conf$/; # Config files
254		next if $file !~ m/^([-\w.]+)$/; # Skip if any weird chars
255		$file = $1; # Not tainted anymore.
256		foreach my $regex (@ignores)
257		{
258		next FILES if $file =~ /$regex/;
259		}
260		next if (! -x "$servicedir/$file"); # File not executeable
261		print "file: '$file'\n" if $DEBUG;
262		$services{$file}=1;
263		my @rows = &run_service($file,"config", 1);
264		my $node = &get_var (\%sconf, $file, 'host_name');
265
266		for my $row (@rows) {
267		print "row: $row\n" if $DEBUG;
268		if ($row =~ m/^host_name (.+)$/) {
269		print "Found host_name, using it\n" if $DEBUG;
270		$node = $1;
271		}
272		}
273		$node \|\|= $FQDN;
274		$nodes{$node}{$file}=1;
275		}
	201	if ( opendir( DIR, $sconfdir ) ) {
	202	FILES:
	203	for my $file ( grep { -f "$sconfdir/$_" } readdir(DIR) ) {
	204	next if $file =~ m/^\./; # Hidden files
	205	next if $file !~ m/^([-\w.]+)$/; # Skip if any weird chars
	206	$file = $1; # Not tainted anymore.
	207	foreach my $regex (@ignores) {
	208	next FILES if $file =~ /$regex/;
	209	}
	210	if ( !&load_auth_file( $sconfdir, $file, \%sconf ) ) {
	211	warn "Something wicked happened while reading ".
	212	"'$servicedir/$file'. Check the previous log ".
	213	"lines for spesifics.";
	214	}
	215	}
	216	closedir(DIR);
	217	} ## end if ( opendir( DIR, $sconfdir...
	218
	219	opendir( DIR, $servicedir )
	220	\|\| die "Cannot open plugindir: $servicedir $!";
	221	FILES:
	222	for my $file ( grep { -f "$servicedir/$_" } readdir(DIR) ) {
	223	next if $file =~ m/^\./; # Hidden files
	224	next if $file =~ m/.conf$/; # Config files
	225	next if $file !~ m/^([-\w.]+)$/; # Skip if any weird chars
	226	$file = $1; # Not tainted anymore.
	227	foreach my $regex (@ignores) {
	228	next FILES if $file =~ /$regex/;
	229	}
	230	next if ( !-x "$servicedir/$file" ); # File not executeable
	231	print "file: '$file'\n" if $DEBUG;
	232	$services{$file} = 1;
	233	my @rows = &run_service( $file, "config", 1 );
	234	my $node = &get_var( \%sconf, $file, 'host_name' );
	235
	236	for my $row (@rows) {
	237	print "row: $row\n" if $DEBUG;
	238	if ( $row =~ m/^host_name (.+)$/ ) {
	239	print "Found host_name, using it\n" if $DEBUG;
	240	$node = $1;
	241	}
	242	}
	243	$node \|\|= $FQDN;
	244	$nodes{$node}{$file} = 1;
	245	} ## end for my $file ( grep { -f...
276	246	closedir DIR;
277		}
	247	} ## end sub load_services
278	248
279	249	sub print_service {
280		my (@lines) = @_;
281		for my $line (@lines) {
282		~~net_write~~ ("$line\n");
283		}
284		~~net_write~~ (".\n");
	250	my (@lines) = @_;
	251	for my $line (@lines) {
	252	net_write("$line\n");
	253	}
	254	net_write(".\n");
285	255	}
286	256
287	257	sub list_services {
288	258	my $node = $_[0] \|\| $FQDN;
289		net_write( join( " ",
290		grep( { &has_access ($_); } keys %{$nodes{$node}} )
291		) )
	259	net_write(
	260	join( " ", grep( { &has_access($_); } keys %{ $nodes{$node} } ) ) )
292	261	if exists $nodes{$node};
293		#print join " ", keys %{$nodes{$node}};
294		net_write ("\n");
	262
	263	#print join " ", keys %{$nodes{$node}};
	264	net_write("\n");
295	265	}
296	266
297	267	sub has_access {
298		my $serv = shift;
299		my $host = $caddr;
300		my $rights = &get_var_arr (\%sconf, $serv, 'allow_deny');
301
302		unless (@{$rights})
303		{
304		return 1;
305		}
306		print STDERR "DEBUG: Checking access: $host;$serv;\n" if $DEBUG;
307		foreach my $ruleset (@{$rights})
308		{
309		foreach my $rule (@{$ruleset})
310		{
311		logger ("DEBUG: Checking access: $host;$serv;". $rule->[0].";".$rule->[1]) if $DEBUG;
312		if ($rule->[1] eq "tls" and $tls_verified{"verified"})
313		{ # tls
314		if ($rule->[0] eq "allow")
315		{
316		return 1;
317		}
318		else
319		{
320		return 0;
321		}
322		}
	268	my $serv = shift;
	269	my $host = $caddr;
	270	my $rights = &get_var_arr( \%sconf, $serv, 'allow_deny' );
	271
	272	unless ( @{$rights} ) {
	273	return 1;
	274	}
	275	print STDERR "DEBUG: Checking access: $host;$serv;\n" if $DEBUG;
	276	foreach my $ruleset ( @{$rights} ) {
	277	foreach my $rule ( @{$ruleset} ) {
	278	logger( "DEBUG: Checking access: $host;$serv;"
	279	. $rule->[0] . ";"
	280	. $rule->[1] )
	281	if $DEBUG;
	282	if ( $rule->[1] eq "tls" and $tls_verified{"verified"} ) { # tls
	283	if ( $rule->[0] eq "allow" ) {
	284	return 1;
	285	} else {
	286	return 0;
	287	}
	288	}
	289
323	290	# elsif ($rule->[1] =~ /\//)
324	291	# { # CIDR
…	…
326	293	# return 1;
327	294	# }
328		else
329		{ # regex
330		if ($host =~ m($rule->[1]))
331		{
332		if ($rule->[0] eq "allow")
333		{
334		return 1;
335		}
336		else
337		{
338		return 0;
339		}
340		}
341		}
342		}
343		}
344		return 1;
345		}
	295	else { # regex
	296	if ( $host =~ m($rule->[1]) ) {
	297	if ( $rule->[0] eq "allow" ) {
	298	return 1;
	299	} else {
	300	return 0;
	301	}
	302	}
	303	}
	304	} ## end foreach my $rule ( @{$ruleset...
	305	} ## end foreach my $ruleset ( @{$rights...
	306	return 1;
	307	} ## end sub has_access
346	308
347	309	sub logger {
	310	my $text = shift;
	311	my @date = localtime(time);
	312
	313	chomp($text);
	314	$text =~ s/\n/\\n/g;
	315
	316	printf STDERR (
	317	"%d/%02d/%02d-%02d:%02d:%02d [$$] %s\n",
	318	$date[5] + 1900,
	319	$date[4] + 1,
	320	$date[3], $date[2], $date[1], $date[0], $text
	321	);
	322	}
	323
	324	sub reap_children {
	325	my $child = shift;
348	326	my $text = shift;
349		my @date = localtime (time);
350
351		chomp ($text);
352		$text =~ s/\n/\\n/g;
353
354		printf STDERR ("%d/%02d/%02d-%02d:%02d:%02d [$$] %s\n", $date[5]+1900, $date[4]+1,
355		$date[3], $date[2], $date[1], $date[0], $text);
356		}
357
358		sub reap_children {
359		my $child = shift;
360		my $text = shift;
361		return unless $child;
362		if (kill (0, $child))
363		{
364		net_write ("# timeout pid $child - killing...");
365		logger ("Plugin timeout: $text (pid $child)");
366		kill (-1, $child); sleep 2;
367		kill (-9, $child);
368		net_write ("done\n");
369		}
	327	return unless $child;
	328	if ( kill( 0, $child ) ) {
	329	net_write("# timeout pid $child - killing...");
	330	logger("Plugin timeout: $text (pid $child)");
	331	kill( -1, $child );
	332	sleep 2;
	333	kill( -9, $child );
	334	net_write("done\n");
	335	}
370	336	}
371	337
372	338	sub run_service {
373		my ($service,$command,$autoreap) = @_;
374		$command \|\|="";
375		my @lines = ();;
376		my $timed_out = 0;
377		if ($services{$service} and ($caddr eq "" or &has_access ($service))) {
378		my $child = 0;
379		my $timeout = get_var (\%sconf, $service, 'timeout');
380		$timeout = $sconf{'timeout'}
381		unless defined $timeout and $timeout =~ /^\d+$/;
382
383		if ($child = open (CHILD, "-\|")) {
384		eval {
385		local $SIG{ALRM} = sub { $timed_out=1; die "$!\n"};
386		alarm($timeout);
387		while(<CHILD>) {
388		push @lines,$_;
389		}
390		};
391		if( $timed_out ) {
392		reap_children($child, "$service $command: $@");
393		close (CHILD);
394		return ();
395		}
396		unless (close CHILD)
397		{
398		if ($!)
399		{
400		# If Net::Server::Fork is currently taking care of reaping,
401		# we get false errors. Filter them out.
402		unless (defined $autoreap and $autoreap)
403		{
404		logger ("Error while executing plugin \"$service\": $!");
405		}
406		}
407		else
408		{
409		logger ("Plugin \"$service\" exited with status $?. --@lines--");
410		}
411		}
412		}
413		else {
414		if ($child == 0) {
415		# New process group...
416		POSIX::setsid();
417		# Setting environment
418		$sconf{$service}{user} = &get_var (\%sconf, $service, 'user');
419		$sconf{$service}{group} = &get_var (\%sconf, $service, 'group');
420		$sconf{$service}{command} = &get_var (\%sconf, $service, 'command');
421		&get_var (\%sconf, $service, 'env', \%{$sconf{$service}{env}});
422
423		if ($< == 0) # If root...
424		{
425		# Giving up gid egid uid euid
426		my $u = (defined $sconf{$service}{'user'}?
427		$sconf{$service}{'user'}:
428		$defuser);
429		my $g = $defgroup;
430		my $gs = "$g $g" .
431		($sconf{$service}{'group'}?" $sconf{$service}{group}":"");
	339	my ( $service, $command, $autoreap ) = @_;
	340	$command \|\|= "";
	341	my @lines = ();
	342	my $timed_out = 0;
	343	if ( $services{$service} and ( $caddr eq "" or &has_access($service) ) ) {
	344	my $child = 0;
	345	my $timeout = get_var( \%sconf, $service, 'timeout' );
	346	$timeout = $sconf{'timeout'}
	347	unless defined $timeout and $timeout =~ /^\d+$/;
	348
	349	if ( $child = open( CHILD, "-\|" ) ) {
	350	eval {
	351	local $SIG{ALRM} = sub { $timed_out = 1; die "$!\n" };
	352	alarm($timeout);
	353	while (<CHILD>) {
	354	push @lines, $_;
	355	}
	356	};
	357	if ($timed_out) {
	358	reap_children( $child, "$service $command: $@" );
	359	close(CHILD);
	360	return ();
	361	}
	362	unless ( close CHILD ) {
	363	if ($!) {
	364
	365	# If Net::Server::Fork is currently taking care of reaping,
	366	# we get false errors. Filter them out.
	367	unless ( defined $autoreap and $autoreap ) {
	368	logger(
	369	"Error while executing plugin \"$service\": $!");
	370	}
	371	} else {
	372	logger(
	373	"Plugin \"$service\" exited with status $?. --@lines--"
	374	);
	375	}
	376	}
	377	} ## end if ( $child = open( CHILD...
	378	else {
	379	if ( $child == 0 ) {
	380
	381	# New process group...
	382	POSIX::setsid();
	383
	384	# Setting environment
	385	$sconf{$service}{user} =
	386	&get_var( \%sconf, $service, 'user' );
	387	$sconf{$service}{group} =
	388	&get_var( \%sconf, $service, 'group' );
	389	$sconf{$service}{command} =
	390	&get_var( \%sconf, $service, 'command' );
	391	&get_var( \%sconf, $service, 'env',
	392	\%{ $sconf{$service}{env} } );
	393
	394	if ( $< == 0 ) # If root...
	395	{
	396
	397	# Giving up gid egid uid euid
	398	my $u = (
	399	defined $sconf{$service}{'user'}
	400	? $sconf{$service}{'user'}
	401	: $defuser
	402	);
	403	my $g = $defgroup;
	404	my $gs = "$g $g"
	405	. (
	406	$sconf{$service}{'group'}
	407	? " $sconf{$service}{group}"
	408	: ""
	409	);
432	410
433	411	# net_write ("# Want to run as euid/egid $u/$g\n") if $DEBUG;
434	412
435		~~$( = $g~~ unless $g == 0;
436		~~$) = $gs~~ unless $g == 0;
437		~~$< = $u~~ unless $u == 0;
438		~~$> = $u~~ unless $u == 0;
439
440		if ($> != $u or $g != (split (' ', $)))[0])
441		{
	413	$( = $g unless $g == 0;
	414	$) = $gs unless $g == 0;
	415	$< = $u unless $u == 0;
	416	$> = $u unless $u == 0;
	417
	418	if ( $> != $u or $g != ( split( ' ', $) ) )[0] ) {
	419
442	420	# net_write ("# Can't drop privileges. Bailing out. (wanted uid=",
443	421	# ($sconf{$service}{'user'} \|\| $defuser), " gid=\"",
444		# $gs, "\"($g), got uid=$> gid=\"$)\"(",
	422	# $gs, "\"($g), got uid=$> gid=\"$)\"(",
445	423	# (split (' ', $)))[0], ").\n");
446		logger ("Plugin \"$service\" Can't drop privileges. ".
447		"Bailing out. (wanted uid=".
448		($sconf{$service}{'user'} \|\| $defuser). " gid=\"".
449		$gs. "\"($g), got uid=$> gid=\"$)\"(".
450		(split (' ', $)))[0]. ").\n");
451		exit 1;
452		}
453		}
454		# net_write ("# Running as uid/gid/euid/egid $</$(/$>/$)\n") if $DEBUG;
455		if (!&check_perms ("$servicedir/$service"))
456		{
	424	logger( "Plugin \"$service\" Can't drop privileges. "
	425	. "Bailing out. (wanted uid="
	426	. ( $sconf{$service}{'user'} \|\| $defuser )
	427	. " gid=\""
	428	. $gs
	429	. "\"($g), got uid=$> gid=\"$)\"("
	430	. ( split( ' ', $) ) )[0]
	431	. ").\n" );
	432	exit 1;
	433	}
	434	} ## end if ( $< == 0 )
	435	# net_write ("# Running as uid/gid/euid/egid $</$(/$>/$)\n") if $DEBUG;
	436	if ( !&check_perms("$servicedir/$service") ) {
	437
457	438	# net_write ("# Error: unsafe permissions. Bailing out.");
458		~~logger~~ ("Error: unsafe permissions. Bailing out.");
459		exit 2;
460		}
461
462		# Setting environment...
463		if (exists $sconf{$service}{'env'} and
464		~~defined $sconf{$service}{'env'}~~)
465		{
466		foreach my $key (keys %{$sconf{$service}{'env'}})
467		{
	439	logger("Error: unsafe permissions. Bailing out.");
	440	exit 2;
	441	}
	442
	443	# Setting environment...
	444	if ( exists $sconf{$service}{'env'}
	445	and defined $sconf{$service}{'env'} )
	446	{
	447	foreach my $key ( keys %{ $sconf{$service}{'env'} } ) {
	448
468	449	# net_write ("# Setting environment $key=$sconf{$service}{env}{$key}\n") if $DEBUG;
469		$ENV{"$key"} = $sconf{$service}{'env'}{$key};
470		}
471		}
472		if (exists $sconf{$service}{'command'} and
473		defined $sconf{$service}{'command'})
474		{
475		my @run = ();
476		foreach my $t (@{$sconf{$service}{'command'}})
477		{
478		if ($t =~ /^%c$/)
479		{
480		push (@run, "$servicedir/$service", $command);
481		}
482		else
483		{
484		push (@run, $t);
485		}
486		}
487		print STDERR "# About to run \"", join (' ', @run), "\"\n" if $DEBUG;
	450	$ENV{"$key"} = $sconf{$service}{'env'}{$key};
	451	}
	452	}
	453	if ( exists $sconf{$service}{'command'}
	454	and defined $sconf{$service}{'command'} )
	455	{
	456	my @run = ();
	457	foreach my $t ( @{ $sconf{$service}{'command'} } ) {
	458	if ( $t =~ /^%c$/ ) {
	459	push( @run, "$servicedir/$service", $command );
	460	} else {
	461	push( @run, $t );
	462	}
	463	}
	464	print STDERR "# About to run \"", join( ' ', @run ),
	465	"\"\n"
	466	if $DEBUG;
	467
488	468	# net_write ("# About to run \"", join (' ', @run), "\"\n") if $DEBUG;
489		~~exec~~ (@run) if @run;
490		}
491		else
492		{
	469	exec(@run) if @run;
	470	} ## end if ( exists $sconf{$service...
	471	else {
	472
493	473	# net_write ("# Execing...\n") if $DEBUG;
494		exec ("$servicedir/$service", $command);
495		}
496		}
497		else {
	474	exec( "$servicedir/$service", $command );
	475	}
	476	} ## end if ( $child == 0 )
	477	else {
	478
498	479	# net_write ("# Unable to fork.\n");
499		~~logger~~ ("Unable to fork.");
500		}
501		}
502		wait;
503		alarm(0);
504		}
505		else {
506		~~net_write~~ ("# Unknown service\n");
507		}
508		chomp @lines;
509		return (@lines);
510		}
	480	logger("Unable to fork.");
	481	}
	482	} ## end else [ if ( $child = open( CHILD...
	483	wait;
	484	alarm(0);
	485	} ## end if ( $services{$service...
	486	else {
	487	net_write("# Unknown service\n");
	488	}
	489	chomp @lines;
	490	return (@lines);
	491	} ## end sub run_service
511	492
512	493	sub process_request {
513		my $self = shift;
514		$caddr = $self->{server}->{peeraddr};
515		$0 .= " [$caddr]";
516		net_write ("# munin node at $FQDN\n");
517		local $SIG{ALRM} = sub { logger ("Connection timed out."); die "timeout" };
518		alarm($sconf{'timeout'});
519		while (defined ($_ = net_read())) {
520		alarm($sconf{'timeout'});
521		chomp;
522		logger ("DEBUG: Running command \"$_\".") if $DEBUG;
523		if (/^list\s*([0-9a-zA-Z\.\-]+)?/i) {
524		&list_services($1);
525		}
526		elsif (/^quit/i \|\| /^\./) {
527		exit 1;
528		}
529		elsif (/^version/i) {
530		&show_version;
531		}
532		elsif (/^nodes/i) {
533		&show_nodes;
534		}
535		elsif (/^fetch\s?(\S*)/i) {
536		print_service (&run_service($1))
537		}
538		elsif (/^config\s?(\S*)/i) {
539		print_service (&run_service($1,"config"));
540		}
541		elsif (/^starttls\s*$/i) {
542		my $mode;
543		my $key;
544		my $cert;
545		my $depth;
546		$key = $cert = &get_var (\%sconf, "tls_pem");
547		$key = &get_var (\%sconf, "tls_private_key")
548		unless defined $key;
549		$key = "@@CONFDIR@@/munin-node.pem" unless defined $key;
550		$cert = &get_var (\%sconf, "tls_certificate")
551		unless defined $cert;
552		$cert = "@@CONFDIR@@/munin-node.pem" unless defined $cert;
553		$mode = &get_var (\%sconf, 'tls');
554		$mode = "auto" unless defined $mode and length $mode;
555		$depth = &get_var (\%sconf, 'tls_verify_depth');
556		$depth = 5 unless defined $depth;
557		start_tls ($mode, $cert, $key,
558		&get_var (\%sconf, 'tls_verify_certificate'),
559		$depth
560		);
561		logger ("DEBUG: Returned from starttls.") if $DEBUG;
562		}
563		else {
564		net_write ("# Unknown command. Try list, nodes, config, fetch, version or quit\n");
565		}
566		}
567		}
568
569		sub net_read
570		{
571		if (defined $tls)
572		{
573		eval { $_ = Net::SSLeay::read($tls); };
574		my $err = &Net::SSLeay::print_errs();
575		if (defined $err and length $err)
576		{
577		logger ("TLS Warning in net_read: $err");
578		}
579		}
580		else
581		{
582		$_ = <STDIN>;
583		}
584		logger ("DEBUG: < $_") if $DEBUG;
	494	my $self = shift;
	495	$caddr = $self->{server}->{peeraddr};
	496	$0 .= " [$caddr]";
	497	net_write("# munin node at $FQDN\n");
	498	local $SIG{ALRM} = sub { logger("Connection timed out."); die "timeout" };
	499	alarm( $sconf{'timeout'} );
	500	while ( defined( $_ = net_read() ) ) {
	501	alarm( $sconf{'timeout'} );
	502	chomp;
	503	logger("DEBUG: Running command \"$_\".") if $DEBUG;
	504	if (/^list\s*([0-9a-zA-Z\.\-]+)?/i) {
	505	&list_services($1);
	506	} elsif ( /^quit/i \|\| /^\./ ) {
	507	exit 1;
	508	} elsif (/^version/i) {
	509	&show_version;
	510	} elsif (/^nodes/i) {
	511	&show_nodes;
	512	} elsif (/^fetch\s?(\S*)/i) {
	513	print_service( &run_service($1) );
	514	} elsif (/^config\s?(\S*)/i) {
	515	print_service( &run_service( $1, "config" ) );
	516	} elsif (/^starttls\s*$/i) {
	517	my $mode;
	518	my $key;
	519	my $cert;
	520	my $depth;
	521	$key = $cert = &get_var( \%sconf, "tls_pem" );
	522	$key = &get_var( \%sconf, "tls_private_key" )
	523	unless defined $key;
	524	$key = "@@CONFDIR@@/munin-node.pem" unless defined $key;
	525	$cert = &get_var( \%sconf, "tls_certificate" )
	526
	527	unless defined $cert;
	528	$cert = "@@CONFDIR@@/munin-node.pem" unless defined $cert;
	529	$mode = &get_var( \%sconf, 'tls' );
	530	$mode = "auto" unless defined $mode and length $mode;
	531	$depth = &get_var( \%sconf, 'tls_verify_depth' );
	532	$depth = 5 unless defined $depth;
	533	start_tls( $mode, $cert, $key,
	534	&get_var( \%sconf, 'tls_verify_certificate' ), $depth );
	535	logger("DEBUG: Returned from starttls.") if $DEBUG;
	536	} ## end elsif (/^starttls\s*$/i)
	537	else {
	538	net_write(
	539	"# Unknown command. Try list, nodes, config, fetch, version or quit\n"
	540	);
	541	}
	542	} ## end while ( defined( $_ = net_read...
	543	} ## end sub process_request
	544
	545	sub net_read {
	546	if ( defined $tls ) {
	547	eval { $_ = Net::SSLeay::read($tls); };
	548	my $err = &Net::SSLeay::print_errs();
	549	if ( defined $err and length $err ) {
	550	logger("TLS Warning in net_read: $err");
	551	}
	552	} else {
	553	$_ = <STDIN>;
	554	}
	555	logger("DEBUG: < $_") if $DEBUG;
585	556	return $_;
586	557	}
587	558
588		sub net_write
589		{
	559	sub net_write {
590	560	my $text = shift;
591		logger ("DEBUG: > $text") if $DEBUG;
592		if (defined $tls)
593		{
594		eval { Net::SSLeay::write ($tls, $text); };
595		my $err = &Net::SSLeay::print_errs();
596		if (defined $err and length $err)
597		{
598		logger ("TLS Warning in net_write: $err");
599		}
600		}
601		else
602		{
603		print STDOUT $text;
604		}
605		}
606
607		sub tls_verify_callback
608		{
609		my ($ok, $subj_cert, $issuer_cert, $depth,
610		$errorcode, $arg, $chain) = @_;
	561	logger("DEBUG: > $text") if $DEBUG;
	562	if ( defined $tls ) {
	563	eval { Net::SSLeay::write( $tls, $text ); };
	564	my $err = &Net::SSLeay::print_errs();
	565	if ( defined $err and length $err ) {
	566	logger("TLS Warning in net_write: $err");
	567	}
	568	} else {
	569	print STDOUT $text;
	570	}
	571	}
	572
	573	sub tls_verify_callback {
	574	my ( $ok, $subj_cert, $issuer_cert, $depth, $errorcode, $arg, $chain ) =
	575	@_;
611	576
612	577	$tls_verified{"level"}++;
613	578
614		if ($ok and $tls_verified{"level"} <= $tls_verified{"required_depth"})
615		{
616		$tls_verified{"verified"} = 1;
617		logger ("TLS Notice: Verified certificate.") if $DEBUG;
618		return 1; # accept
619		}
620
621		return 1; # accept anyway
622		}
623
624		sub start_tls
625		{
	579	if ( $ok and $tls_verified{"level"} <= $tls_verified{"required_depth"} ) {
	580	$tls_verified{"verified"} = 1;
	581	logger("TLS Notice: Verified certificate.") if $DEBUG;
	582	return 1; # accept
	583	}
	584
	585	return 1; # accept anyway
	586	}
	587
	588	sub start_tls {
626	589	my $tls_paranoia = shift;
627	590	my $tls_cert = shift;
…	…
634	597	my $local_key = 0;
635	598
636		%tls_verified = ( "level" => 0, "cert" => "", "verified" => 0, "required_depth" => $tls_vdepth );
637
638		if ($tls_paranoia eq "disabled")
639		{
640		logger ("TLS Notice: Refusing TLS request from peer.");
641		net_write ("TLS NOT AVAILABLE\n");
642		return 0
	599	%tls_verified = (
	600	"level" => 0,
	601	"cert" => "",
	602	"verified" => 0,
	603	"required_depth" => $tls_vdepth
	604	);
	605
	606	if ( $tls_paranoia eq "disabled" ) {
	607	logger("TLS Notice: Refusing TLS request from peer.");
	608	net_write("TLS NOT AVAILABLE\n");
	609	return 0;
643	610	}
644	611
645	612	logger("Enabling TLS.") if $DEBUG;
646		if (! eval "require Net::SSLeay;")
647		{
648		if ($tls_paranoia eq "auto")
649		{
650		logger ("Notice: TLS requested by peer, but Net::SSLeay unavailable.");
651		return 0;
652		}
653		else # tls really required
654		{
655		logger ("Fatal: TLS enabled but Net::SSLeay unavailable.");
656		exit 0;
657		}
658		}
659
660		# Init SSLeay
	613	if ( !eval "require Net::SSLeay;" ) {
	614	if ( $tls_paranoia eq "auto" ) {
	615	logger(
	616	"Notice: TLS requested by peer, but Net::SSLeay unavailable."
	617	);
	618	return 0;
	619	} else # tls really required
	620	{
	621	logger("Fatal: TLS enabled but Net::SSLeay unavailable.");
	622	exit 0;
	623	}
	624	}
	625
	626	# Init SSLeay
661	627	Net::SSLeay::load_error_strings();
662	628	Net::SSLeay::SSLeay_add_ssl_algorithms();
663	629	Net::SSLeay::randomize();
664	630	$ctx = Net::SSLeay::CTX_new();
665		if (!$ctx)
666		{
667		logger ("TLS Error: Could not create SSL_CTX: " . &Net::SSLeay::print_errs());
668		return 0;
669		}
670
671		# Tune a few things...
672		if (Net::SSLeay::CTX_set_options($ctx, &Net::SSLeay::OP_ALL))
673		{
674		logger ("TLS Error: Could not set SSL_CTX options: " . &Net::SSLeay::print_errs());
675		return 0;
676		}
677
678		# Should we use a private key?
679		if (-e $tls_priv or $tls_paranoia eq "paranoid")
680		{
681		if (defined $tls_priv and length $tls_priv)
682		{
683		if (!Net::SSLeay::CTX_use_PrivateKey_file($ctx, $tls_priv,
684		&Net::SSLeay::FILETYPE_PEM))
685		{
686		logger ("TLS Notice: Problem occured when trying to read file with private key \"$tls_priv\": ".&Net::SSLeay::print_errs().". Continuing without private key.");
687		}
688		else
689		{
690		$local_key = 1;
691		}
692		}
693		}
694		else
695		{
696		logger ("TLS Notice: No key file \"$tls_priv\". Continuing without private key.");
697		}
698
699		# How about a certificate?
700		if (-e $tls_cert)
701		{
702		if (defined $tls_cert and length $tls_cert)
703		{
704		if (!Net::SSLeay::CTX_use_certificate_file($ctx, $tls_cert,
705		&Net::SSLeay::FILETYPE_PEM))
706		{
707		logger ("TLS Notice: Problem occured when trying to read file with certificate \"$tls_cert\": ".&Net::SSLeay::print_errs().". Continuing without certificate.");
708		}
709		}
710		}
711		else
712		{
713		logger ("TLS Notice: No certificate file \"$tls_cert\". Continuing without certificate.");
714		}
715
716		# Tell the other side that we're able to talk TLS
717		if ($local_key)
718		{
	631	if ( !$ctx ) {
	632	logger( "TLS Error: Could not create SSL_CTX: "
	633	. &Net::SSLeay::print_errs() );
	634	return 0;
	635	}
	636
	637	# Tune a few things...
	638	if ( Net::SSLeay::CTX_set_options( $ctx, &Net::SSLeay::OP_ALL ) ) {
	639	logger( "TLS Error: Could not set SSL_CTX options: "
	640	. &Net::SSLeay::print_errs() );
	641	return 0;
	642	}
	643
	644	# Should we use a private key?
	645	if ( -e $tls_priv or $tls_paranoia eq "paranoid" ) {
	646	if ( defined $tls_priv and length $tls_priv ) {
	647	if (
	648	!Net::SSLeay::CTX_use_PrivateKey_file(
	649	$ctx, $tls_priv, &Net::SSLeay::FILETYPE_PEM
	650	) )
	651	{
	652	logger(
	653	"TLS Notice: Problem occured when trying to read file with private key \"$tls_priv\": "
	654	. &Net::SSLeay::print_errs()
	655	. ". Continuing without private key." );
	656	} else {
	657	$local_key = 1;
	658	}
	659	}
	660	} ## end if ( -e $tls_priv or $tls_paranoia...
	661	else {
	662	logger(
	663	"TLS Notice: No key file \"$tls_priv\". Continuing without private key."
	664	);
	665	}
	666
	667	# How about a certificate?
	668	if ( -e $tls_cert ) {
	669	if ( defined $tls_cert and length $tls_cert ) {
	670	if (
	671	!Net::SSLeay::CTX_use_certificate_file(
	672	$ctx, $tls_cert, &Net::SSLeay::FILETYPE_PEM
	673	) )
	674	{
	675	logger(
	676	"TLS Notice: Problem occured when trying to read file with certificate \"$tls_cert\": "
	677	. &Net::SSLeay::print_errs()
	678	. ". Continuing without certificate." );
	679	}
	680	}
	681	} else {
	682	logger(
	683	"TLS Notice: No certificate file \"$tls_cert\". Continuing without certificate."
	684	);
	685	}
	686
	687	# Tell the other side that we're able to talk TLS
	688	if ($local_key) {
719	689	print "TLS OK\n";
720		}
721		else
722		{
	690	} else {
723	691	print "TLS MAYBE\n";
724	692	}
725	693
726		# Now let's define our requirements of the node
	694	# Now let's define our requirements of the node
727	695	$tls_vdepth = 5 unless defined $tls_vdepth;
728		Net::SSLeay::CTX_set_verify_depth ~~($ctx, $tls_vdepth~~);
	696	Net::SSLeay::CTX_set_verify_depth( $ctx, $tls_vdepth );
729	697	$err = &Net::SSLeay::print_errs();
730		if (~~defined $err and length $err)~~
731		{
732		logger ("TLS Warning in set_verify_depth: $err");
733		}
734		~~Net::SSLeay::CTX_set_verify ($ctx, &Net::SSLeay::VERIFY_PEER, \&tls_verify_callback~~);
	698	if ( defined $err and length $err ) {
	699	logger("TLS Warning in set_verify_depth: $err");
	700	}
	701	Net::SSLeay::CTX_set_verify( $ctx, &Net::SSLeay::VERIFY_PEER,
	702	\&tls_verify_callback );
735	703	$err = &Net::SSLeay::print_errs();
736		if (defined $err and length $err)
737		{
738		logger ("TLS Warning in set_verify: $err");
739		}
740
741		# Create the local tls object
742		if (! ($tls = Net::SSLeay::new($ctx)))
743		{
744		logger ("TLS Error: Could not create TLS: " . &Net::SSLeay::print_errs());
745		return 0;
746		}
747		if ($DEBUG)
748		{
749		my $i = 0;
750		my $p = '';
751		my $cipher_list = 'Cipher list: ';
752		$p=Net::SSLeay::get_cipher_list($tls,$i);
753		$cipher_list .= $p if $p;
754		do {
755		$i++;
756		$cipher_list .= ', ' . $p if $p;
757		$p=Net::SSLeay::get_cipher_list($tls,$i);
758		} while $p;
	704	if ( defined $err and length $err ) {
	705	logger("TLS Warning in set_verify: $err");
	706	}
	707
	708	# Create the local tls object
	709	if ( !( $tls = Net::SSLeay::new($ctx) ) ) {
	710	logger( "TLS Error: Could not create TLS: "
	711	. &Net::SSLeay::print_errs() );
	712	return 0;
	713	}
	714	if ($DEBUG) {
	715	my $i = 0;
	716	my $p = '';
	717	my $cipher_list = 'Cipher list: ';
	718	$p = Net::SSLeay::get_cipher_list( $tls, $i );
	719	$cipher_list .= $p if $p;
	720	do {
	721	$i++;
	722	$cipher_list .= ', ' . $p if $p;
	723	$p = Net::SSLeay::get_cipher_list( $tls, $i );
	724	} while $p;
759	725	$cipher_list .= '\n';
760		~~logger~~ ("TLS Notice: Available cipher list: $cipher_list.");
761		}
762
763		# Redirect stdout/stdin to the TLS
764		Net::SSLeay::set_rfd(~~$tls, fileno(STDIN)~~);
	726	logger("TLS Notice: Available cipher list: $cipher_list.");
	727	}
	728
	729	# Redirect stdout/stdin to the TLS
	730	Net::SSLeay::set_rfd( $tls, fileno(STDIN) );
765	731	$err = &Net::SSLeay::print_errs();
766		if (defined $err and length $err)
767		{
768		logger ("TLS Warning in set_rfd: $err");
769		}
770		Net::SSLeay::set_wfd($tls, fileno(STDOUT));
	732	if ( defined $err and length $err ) {
	733	logger("TLS Warning in set_rfd: $err");
	734	}
	735	Net::SSLeay::set_wfd( $tls, fileno(STDOUT) );
771	736	$err = &Net::SSLeay::print_errs();
772		if (defined $err and length $err)
773		{
774		logger ("TLS Warning in set_wfd: $err");
775		}
776
777		# Try to negotiate the tls connection
	737	if ( defined $err and length $err ) {
	738	logger("TLS Warning in set_wfd: $err");
	739	}
	740
	741	# Try to negotiate the tls connection
778	742	my $res;
779		if ($local_key)
780		{
	743	if ($local_key) {
781	744	$res = Net::SSLeay::accept($tls);
782		}
783		else
784		{
	745	} else {
785	746	$res = Net::SSLeay::connect($tls);
786	747	}
787	748	$err = &Net::SSLeay::print_errs();
788		if (defined $err and length $err)
789		{
790		logger ("TLS Error: Could not enable TLS: " . $err);
791		Net::SSLeay::free ($tls);
792		Net::SSLeay::CTX_free ($ctx);
793		$tls = undef;
794		}
795		elsif (!$tls_verified{"verified"} and $tls_paranoia eq "paranoid")
796		{
797		logger ("TLS Error: Could not verify CA: " . Net::SSLeay::dump_peer_certificate($tls));
798		Net::SSLeay::free ($tls);
799		Net::SSLeay::CTX_free ($ctx);
800		$tls = undef;
801		}
802		else
803		{
804		logger ("TLS Notice: TLS enabled.");
805		logger ("TLS Notice: Cipher `" . Net::SSLeay::get_cipher($tls) . "'.");
806		$tls_verified{"cert"} = Net::SSLeay::dump_peer_certificate($tls);
807		logger ("TLS Notice: client cert: " .$tls_verified{"cert"});
	749	if ( defined $err and length $err ) {
	750	logger( "TLS Error: Could not enable TLS: " . $err );
	751	Net::SSLeay::free($tls);
	752	Net::SSLeay::CTX_free($ctx);
	753	$tls = undef;
	754	} elsif ( !$tls_verified{"verified"} and $tls_paranoia eq "paranoid" ) {
	755	logger( "TLS Error: Could not verify CA: "
	756	. Net::SSLeay::dump_peer_certificate($tls) );
	757	Net::SSLeay::free($tls);
	758	Net::SSLeay::CTX_free($ctx);
	759	$tls = undef;
	760	} else {
	761	logger("TLS Notice: TLS enabled.");
	762	logger(
	763	"TLS Notice: Cipher `" . Net::SSLeay::get_cipher($tls) . "'." );
	764	$tls_verified{"cert"} = Net::SSLeay::dump_peer_certificate($tls);
	765	logger( "TLS Notice: client cert: " . $tls_verified{"cert"} );
808	766	}
809	767
810	768	return $tls;
811		}
812
813		sub get_uid
814		{
	769	} ## end sub start_tls
	770
	771	sub get_uid {
815	772	my $user = shift;
816		return undef if (!defined $user);
817
818		if ($user !~ /\d/)
819		{
820		$user = getpwnam ($user);
	773	return undef if ( !defined $user );
	774
	775	if ( $user !~ /\d/ ) {
	776	$user = getpwnam($user);
821	777	}
822	778	return $user;
823	779	}
824	780
825		sub get_gid
826		{
	781	sub get_gid {
827	782	my $group = shift;
828		return undef if (!defined $group);
829
830		if ($group !~ /\d/)
831		{
832		$group = getgrnam ($group);
	783	return undef if ( !defined $group );
	784
	785	if ( $group !~ /\d/ ) {
	786	$group = getgrnam($group);
833	787	}
834	788	return $group;
835	789	}
836	790
837		sub load_auth_file
838		{
839		my ($dir, $file, $sconf) = @_;
	791	sub load_auth_file {
	792	my ( $dir, $file, $sconf ) = @_;
840	793	my $service = $file;
841	794
842		if (!defined $dir or !defined $file or !defined $sconf)
843		{
844		return undef;
845		}
846
847		return undef if (!&check_perms ($dir));
848		return undef if (!&check_perms ("$dir/$file"));
849
850		if (!open (IN, "$dir/$file"))
851		{
852		warn "Could not open file \"$dir/$file\" for reading ($!), skipping plugin\n";
853		return undef;
854		}
855		while (<IN>)
856		{
857		chomp;
858		s/#.*$//;
859		next unless /\S/;
860		s/\s+$//g;
861		net_write ("DEBUG: Config: $service: $_\n") if $DEBUG;
862		if (/^\s\[([^\]]+)\]\s$/)
863		{
864		$service = $1;
865		}
866		elsif (/^\suser\s+(\S+)\s$/)
867		{
868		my $tmpid = $1;
869		$sconf->{$service}{'user'} = &get_uid ($tmpid);
870		net_write ("DEBUG: Config: $service->uid = ", $sconf->{$service}{'user'}, "\n") if $DEBUG;
871		if (!defined $sconf->{$service}{'user'})
872		{
873		warn "User \"$tmpid\" in configuration file \"$dir/$file\" nonexistant. Skipping plugin.";
874		return undef;
875		}
876		}
877		elsif (/^\sgroup\s+(.+)\s$/)
878		{
879		my $tmpid = $1;
880		foreach my $group (split /\s,\s/, $tmpid)
881		{
882		my $optional = 0;
883
884		if ($group =~ /^$([^)]+)$$/)
885		{
886		$optional = 1;
887		$group = $1;
888		}
889
890		my $g = &get_gid ($group);
891		net_write ("DEBUG: Config: $service->gid = ". $sconf->{$service}{'group'}. "\n")
892		if $DEBUG and defined $sconf->{$service}{'group'};
893		if (!defined $g and !$optional)
894		{
895		warn "Group \"$group\" in configuration file \"$dir/$file\" nonexistant. Skipping plugin.";
896		return undef;
897		}
898		elsif (!defined $g and $optional)
899		{
900		net_write ("DEBUG: Skipping \"$group\" (optional).\n") if $DEBUG;
901		next;
902		}
903		if (!defined $sconf->{$service}{'group'})
904		{
905		$sconf->{$service}{'group'} = $g;
906		}
907		else
908		{
909		$sconf->{$service}{'group'} .= " $g";
910		}
911		}
912		}
913		elsif (/^\scommand\s+(.+)\s$/)
914		{
915		@{$sconf->{$service}{'command'}} = split (/\s+/, $1);
916		}
917		elsif (/^\shost_name\s+(.+)\s$/)
918		{
919		$sconf->{$service}{'host_name'} = $1;
920		}
921		elsif (/^\stimeout\s+(\d+)\s$/)
922		{
923		$sconf->{$service}{'timeout'} = $1;
924		net_write ("DEBUG: $service: setting timeout to $1\n")
925		if $DEBUG;
926		}
927		elsif (/^\s(allow)\s+(.+)\s$/ or /^\s(deny)\s+(.+)\s$/)
928		{
929		push (@{$sconf->{$service}{'allow_deny'}}, [$1, $2]);
930		print STDERR "DEBUG: Pushing allow_deny: $1, $2\n" if $DEBUG;
931		}
932		elsif (/^\senv\s+([^=\s]+)\s=\s*(.+)$/)
933		{
934		# $sconf->{$service}{'env'}{$1} = $2;
935		# net_write ("Saving $service->env->$1 = $2...\n") if $DEBUG;
936		warn "Warning: Deprecated format in \"$dir/$file\" under \"[$service]\" (\"env $1=$2\" should be rewritten to \"env.$1 $2. Ignored.\").";
937		}
938		elsif (/^\s*env\.(\S+)\s+(.+)$/)
939		{
940		$sconf->{$service}{'env'}{$1} = $2;
941		net_write ("Saving $service->env->$1 = $2...\n") if $DEBUG;
942		}
943		elsif (/^\s*(\w+)\s+(.+)$/)
944		{
945		# $sconf->{$service}{'env'}{"lrrd_$1"} = $2;
946		# net_write ("Saving $service->env->lrrd_$1 = $2...\n") if $DEBUG;
947		warn "Warning: Deprecated format in \"$dir/$file\" under \"[$service]\" (\"$1 $2\" should be rewritten to \"env.$1 $2. Ignored.\").";
948		}
949		elsif (/\S/)
950		{
951		warn "Warning: Unknown config option in \"$dir/$file\" under \"[$service]\": $_";
952		}
953
954		}
955		close (IN);
	795	if ( !defined $dir or !defined $file or !defined $sconf ) {
	796	return undef;
	797	}
	798
	799	return undef if ( !&check_perms($dir) );
	800	return undef if ( !&check_perms("$dir/$file") );
	801
	802	if ( !open( IN, "$dir/$file" ) ) {
	803	warn
	804	"Could not open file \"$dir/$file\" for reading ($!), skipping plugin\n";
	805	return undef;
	806	}
	807	while (<IN>) {
	808	chomp;
	809	s/#.*$//;
	810	next unless /\S/;
	811	s/\s+$//g;
	812	net_write("DEBUG: Config: $service: $_\n") if $DEBUG;
	813	if (/^\s\[([^\]]+)\]\s$/) {
	814	$service = $1;
	815	} elsif (/^\suser\s+(\S+)\s$/) {
	816	my $tmpid = $1;
	817	$sconf->{$service}{'user'} = &get_uid($tmpid);
	818	net_write( "DEBUG: Config: $service->uid = ",
	819	$sconf->{$service}{'user'}, "\n" )
	820	if $DEBUG;
	821	if ( !defined $sconf->{$service}{'user'} ) {
	822	warn
	823	"User \"$tmpid\" in configuration file \"$dir/$file\" nonexistant. Skipping plugin.";
	824	return undef;
	825	}
	826	} elsif (/^\sgroup\s+(.+)\s$/) {
	827	my $tmpid = $1;
	828	foreach my $group ( split /\s,\s/, $tmpid ) {
	829	my $optional = 0;
	830
	831	if ( $group =~ /^$([^)]+)$$/ ) {
	832	$optional = 1;
	833	$group = $1;
	834	}
	835
	836	my $g = &get_gid($group);
	837	net_write( "DEBUG: Config: $service->gid = "
	838	. $sconf->{$service}{'group'}
	839	. "\n" )
	840	if $DEBUG and defined $sconf->{$service}{'group'};
	841	if ( !defined $g and !$optional ) {
	842	warn
	843	"Group \"$group\" in configuration file \"$dir/$file\" nonexistant. Skipping plugin.";
	844	return undef;
	845	} elsif ( !defined $g and $optional ) {
	846	net_write("DEBUG: Skipping \"$group\" (optional).\n")
	847	if $DEBUG;
	848	next;
	849	}
	850	if ( !defined $sconf->{$service}{'group'} ) {
	851	$sconf->{$service}{'group'} = $g;
	852	} else {
	853	$sconf->{$service}{'group'} .= " $g";
	854	}
	855	} ## end foreach my $group ( split /\s,\s/...
	856	} ## end elsif (/^\sgroup\s+(.+)\s$/...
	857	elsif (/^\scommand\s+(.+)\s$/) {
	858	@{ $sconf->{$service}{'command'} } = split( /\s+/, $1 );
	859	} elsif (/^\shost_name\s+(.+)\s$/) {
	860	$sconf->{$service}{'host_name'} = $1;
	861	} elsif (/^\stimeout\s+(\d+)\s$/) {
	862	$sconf->{$service}{'timeout'} = $1;
	863	net_write("DEBUG: $service: setting timeout to $1\n")
	864	if $DEBUG;
	865	} elsif ( /^\s(allow)\s+(.+)\s$/ or /^\s(deny)\s+(.+)\s$/ ) {
	866	push( @{ $sconf->{$service}{'allow_deny'} }, [ $1, $2 ] );
	867	print STDERR "DEBUG: Pushing allow_deny: $1, $2\n" if $DEBUG;
	868	} elsif (/^\senv\s+([^=\s]+)\s=\s*(.+)$/) {
	869
	870	# $sconf->{$service}{'env'}{$1} = $2;
	871	# net_write ("Saving $service->env->$1 = $2...\n") if $DEBUG;
	872	warn
	873	"Warning: Deprecated format in \"$dir/$file\" under \"[$service]\" (\"env $1=$2\" should be rewritten to \"env.$1 $2. Ignored.\").";
	874	} elsif (/^\s*env\.(\S+)\s+(.+)$/) {
	875	$sconf->{$service}{'env'}{$1} = $2;
	876	net_write("Saving $service->env->$1 = $2...\n") if $DEBUG;
	877	} elsif (/^\s*(\w+)\s+(.+)$/) {
	878
	879	# $sconf->{$service}{'env'}{"lrrd_$1"} = $2;
	880	# net_write ("Saving $service->env->lrrd_$1 = $2...\n") if $DEBUG;
	881	warn
	882	"Warning: Deprecated format in \"$dir/$file\" under \"[$service]\" (\"$1 $2\" should be rewritten to \"env.$1 $2. Ignored.\").";
	883	} elsif (/\S/) {
	884	warn
	885	"Warning: Unknown config option in \"$dir/$file\" under \"[$service]\": $_";
	886	}
	887
	888	} ## end while (<IN>)
	889	close(IN);
956	890
957	891	return 1;
958		}
959
960		sub check_perms
961		{
	892	} ## end sub load_auth_file
	893
	894	sub check_perms {
962	895	my $target = shift;
963	896	my @stat;
964		return undef if (!defined $target);
965		return 1 if (!$paranoia);
966
967		if (! -e "$target")
	897	return undef if ( !defined $target );
	898	return 1 if ( !$paranoia );
	899
	900	if ( !-e "$target" ) {
	901	warn "Failed to check permissions on nonexistant target: \"$target\"";
	902	return undef;
	903	}
	904
	905	@stat = stat($target);
	906	if ( !$stat[4] == 0
	907	or ( $stat[5] != 0 and $stat[2] & 00020 )
	908	or ( $stat[2] & 00002 ) )
968	909	{
969		warn "Failed to check permissions on nonexistant target: \"$target\"";
970		return undef;
971		}
972
973		@stat = stat ($target);
974		if (!$stat[4] == 0 or
975		($stat[5] != 0 and $stat[2] & 00020) or
976		($stat[2] & 00002))
	910	warn "Warning: \"$target\" has dangerous permissions (",
	911	sprintf( "%04o", $stat[2] & 07777 ), ").";
	912	return 0;
	913	}
	914
	915	if ( -f "$target" ) # Check dir as well
977	916	{
978		warn "Warning: \"$target\" has dangerous permissions (", sprintf ("%04o", $stat[2] & 07777), ").";
979		return 0;
980		}
981
982		if (-f "$target") # Check dir as well
983		{
984		(my $dirname = $target) =~ s/[^\/]+$//;
985		return &check_perms ($dirname);
	917	( my $dirname = $target ) =~ s/[^\/]+$//;
	918	return &check_perms($dirname);
986	919	}
987	920
988	921	return 1;
989		}
990
991		sub get_var_arr
992		{
993		my $sconf = shift;
994		my $name = shift;
995		my $var = shift;
996		my $result = [];
997
998		if (exists $sconf->{$name}{$var})
999		{
1000		push (@{$result}, $sconf->{$name}{$var});
1001		}
1002
1003		foreach my $wildservice (grep (/\*$/, reverse sort keys %{$sconf}))
1004		{
1005		(my $tmpservice = $wildservice) =~ s/\*$//;
1006		next unless ($name =~ /^$tmpservice/);
1007		print STDERR "# Checking $wildservice...\n" if $DEBUG;
1008
1009		if (defined $sconf->{$wildservice}{$var})
1010		{
1011		push (@{$result}, $sconf->{$wildservice}{$var});
1012		print STDERR ("DEBUG: Pushing: \|", join (';', @{$sconf->{$wildservice}{$var}}), "\|\n")
1013		if $DEBUG;
1014		}
	922	} ## end sub check_perms
	923
	924	sub get_var_arr {
	925	my $sconf = shift;
	926	my $name = shift;
	927	my $var = shift;
	928	my $result = [];
	929
	930	if ( exists $sconf->{$name}{$var} ) {
	931	push( @{$result}, $sconf->{$name}{$var} );
	932	}
	933
	934	foreach my $wildservice ( grep ( /\*$/, reverse sort keys %{$sconf} ) ) {
	935	( my $tmpservice = $wildservice ) =~ s/\*$//;
	936	next unless ( $name =~ /^$tmpservice/ );
	937	print STDERR "# Checking $wildservice...\n" if $DEBUG;
	938
	939	if ( defined $sconf->{$wildservice}{$var} ) {
	940	push( @{$result}, $sconf->{$wildservice}{$var} );
	941	print STDERR (
	942	"DEBUG: Pushing: \|",
	943	join( ';', @{ $sconf->{$wildservice}{$var} } ), "\|\n"
	944	) if $DEBUG;
	945	}
1015	946	}
1016	947	return $result;
1017		}
1018
1019		sub get_var
1020		{
1021		my $sconf = shift;
1022		my $name = shift;
1023		my $var = shift;
1024		my $env = shift;
1025
1026		if (!defined $var and defined $name)
1027		{
1028		return $sconf{$name};
1029		}
1030		if ($var eq 'env' and !defined $env)
1031		{
1032		%{$env} = ();
1033		}
1034
1035		if ($var ne 'env' and exists $sconf->{$name}{$var})
1036		{
1037		return $sconf->{$name}{$var};
1038		}
1039		# Deciding environment
1040		foreach my $wildservice (grep (/\*$/, reverse sort keys %{$sconf}))
1041		{
1042		(my $tmpservice = $wildservice) =~ s/\*$//;
1043		next unless ($name =~ /^$tmpservice/);
	948	} ## end sub get_var_arr
	949
	950	sub get_var {
	951	my $sconf = shift;
	952	my $name = shift;
	953	my $var = shift;
	954	my $env = shift;
	955
	956	if ( !defined $var and defined $name ) {
	957	return $sconf{$name};
	958	}
	959	if ( $var eq 'env' and !defined $env ) {
	960	%{$env} = ();
	961	}
	962
	963	if ( $var ne 'env' and exists $sconf->{$name}{$var} ) {
	964	return $sconf->{$name}{$var};
	965	}
	966
	967	# Deciding environment
	968	foreach my $wildservice ( grep ( /\*$/, reverse sort keys %{$sconf} ) ) {
	969	( my $tmpservice = $wildservice ) =~ s/\*$//;
	970	next unless ( $name =~ /^$tmpservice/ );
	971
1044	972	# net_write ("# Checking $wildservice...\n") if $DEBUG;
1045	973
1046		if ($var eq 'env')
1047		{
1048		if (exists $sconf->{$wildservice}{'env'})
1049		{
1050		foreach my $key (keys %{$sconf->{$wildservice}{'env'}})
1051		{
1052		if (! exists $sconf->{$name}{'env'}{$key})
1053		{
1054		$sconf->{$name}{'env'}{$key} = $sconf->{$wildservice}{'env'}{$key};
1055		net_write ("Saving $wildservice->$key\n") if $DEBUG;
1056		}
1057		}
1058		}
1059		}
1060		else
1061		{
1062		if (! exists $sconf->{$name}{$var} and
1063		exists $sconf->{$wildservice}{$var})
1064		{
1065		return ($sconf->{$wildservice}{$var});
1066		}
1067		}
1068		}
	974	if ( $var eq 'env' ) {
	975	if ( exists $sconf->{$wildservice}{'env'} ) {
	976	foreach my $key ( keys %{ $sconf->{$wildservice}{'env'} } ) {
	977	if ( !exists $sconf->{$name}{'env'}{$key} ) {
	978	$sconf->{$name}{'env'}{$key} =
	979	$sconf->{$wildservice}{'env'}{$key};
	980	net_write("Saving $wildservice->$key\n") if $DEBUG;
	981	}
	982	}
	983	}
	984	} else {
	985	if ( !exists $sconf->{$name}{$var}
	986	and exists $sconf->{$wildservice}{$var} )
	987	{
	988	return ( $sconf->{$wildservice}{$var} );
	989	}
	990	}
	991	} ## end foreach my $wildservice ( grep...
1069	992	return $env;
1070		}
	993	} ## end sub get_var
1071	994
1072	995	1;
…	…
1152	1075	=head1 COPYRIGHT
1153	1076
1154		Copyright © 2002-2006 Audun Ytterdal, Jimmy Olsen, and Tore Anderson / Linpro AS.
	1077	Copyright ï¿œ 2002-2006 Audun Ytterdal, Jimmy Olsen, and Tore Anderson / Linpro AS.
1155	1078
1156	1079	This is free software; see the source for copying conditions. There is
…	…
1162	1085	=cut
1163	1086
	1087
1164	1088	# vim:syntax=perl ts=8

people/janl/src/node/munin-run

r1249	r1257
1		#!@@PERL@@ -wT
2		# -- perl --
	1	#!/usr/bin/perl -wT
3	2
4	3	# Copyright (C) 2004-2006
…	…
22	21
23	22	use strict;
	23	use Munin;
	24	use Munin::Node;
24	25	use vars qw(@ISA);
25	26	use Getopt::Long;
26	27
27		# "Clean" environment to disable taint-checking on the environment. We _know_
28		# that the environment is insecure, but we want to let admins shoot themselves
29		# in the foot with it, if they want to.
30		foreach my $key (keys %ENV)
31		{
32		if ($ENV{$key} =~ /^(.*)$/) {
33		$ENV{$key} = $1;
34		} else {
35		delete $ENV{$key};
36		}
37		}
38
39		$0 =~ /^(.*)$/; # for some strange reason won't "$0 = $0;" work.
	28	clean_envir;
	29
	30	$0 =~ /^(.*)$/; # for some strange reason won't "$0 = $0;" work.
40	31	$0 = $1;
41
42		~~# Make configuration settings available at runtime.~~
43		~~$ENV{'MUNIN_PREFIX'} = '@@PREFIX@@';~~
44		~~$ENV{'MUNIN_CONFDIR'} = '@@CONFDIR@@'; # /etc/munin,/etc/opt/munin or such~~
45		~~$ENV{'MUNIN_BINDIR'} = '@@BINDIR@@';~~
46		~~$ENV{'MUNIN_SBINDIR'} = '@@SBINDIR@@';~~
47		~~$ENV{'MUNIN_DOCDIR'} = '@@DOCDIR@@';~~
48		~~$ENV{'MUNIN_LIBDIR'} = '@@LIBDIR@@'; # LIBDIR/plugins contains plugin.sh~~
49		~~$ENV{'MUNIN_HTMLDIR'} = '@@HTMLDIR@@';~~
50		~~$ENV{'MUNIN_CGIDIR'} = '@@CGIDIR@@';~~
51		~~$ENV{'MUNIN_DBDIR'} = '@@DBDIR@@';~~
52		~~$ENV{'MUNIN_PLUGSTATE'} = '@@PLUGSTATE@@'; # Put plugin state files here!~~
53		~~$ENV{'MUNIN_MANDIR'} = '@@MANDIR@@';~~
54		~~$ENV{'MUNIN_LOGDIR'} = '@@LOGDIR@@';~~
55		~~$ENV{'MUNIN_STATEDIR'} = '@@STATEDIR@@'; # This is for .pid files~~
56		~~$ENV{'MUNIN_USER'} = '@@USER@@'; # User munin runs as (mostly)~~
57		~~$ENV{'MUNIN_GROUP'} = '@@GROUP@@'; # Group ditto~~
58		~~$ENV{'MUNIN_PLUGINUSER'} = '@@PLUGINUSER@@';# Default user for plugin running~~
59		~~$ENV{'MUNIN_VERSION'} = '@@VERSION@@';~~
60		~~$ENV{'MUNIN_PERL'} = '@@PERL@@';~~
61		~~$ENV{'MUNIN_PERLLIB'} = '@@PERLLIB@@';~~
62		~~$ENV{'MUNIN_GOODSH'} = '@@GOODSH@@';~~
63		~~$ENV{'MUNIN_BASH'} = '@@BASH@@';~~
64		~~$ENV{'MUNIN_PYTHON'} = '@@PYTHON@@';~~
65		~~$ENV{'MUNIN_OSTYPE'} = '@@OSTYPE@@';~~
66		~~$ENV{'MUNIN_HOSTNAME'} = '@@HOSTNAME@@';~~
67		~~$ENV{'MUNIN_MKTEMP'} = '@@MKTEMP@@';~~
68	32
69	33	my %services;
70	34	my %nodes;
71		my $servicedir~~="@@CONFDIR@@~~/plugins";
72		my $sconfdir~~="@@CONFDIR@@~~/plugin-conf.d";
73		my $conffile~~="@@CONFDIR@@~~/munin-node.conf";
74		my $sconffile=undef;
75		my $FQDN="";
76		my $do_usage = 0;
77		my $DEBUG = 0;
	35	my $servicedir = "$CONFDIR/plugins";
	36	my $sconfdir = "$CONFDIR/plugin-conf.d";
	37	my $conffile = "$CONFDIR/munin-node.conf";
	38	my $sconffile = undef;
	39	my $FQDN = "";
	40	my $do_usage = 0;
	41	my $DEBUG = 0;
78	42	my $do_version = 0;
79		my $VERSION='@@VERSION@@';
80		my $defuser = getpwnam ("@@PLUGINUSER@@");
81		my $defgroup= getgrnam ("@@GROUP@@");
82		my $paranoia = 0;
83		my @ignores = ();
84
85		my %sconf = ();
86
87		$do_usage=1 unless
88		GetOptions ( "config=s" => \$conffile,
89		"debug!" => \$DEBUG,
90		"version!" => \$do_version,
91		"servicedir=s" => \$servicedir,
92		"sconfdir=s" => \$sconfdir,
93		"sconffile=s" => \$sconffile,
94		"paranoia!" => \$paranoia,
95		"help" => \$do_usage );
96
97		if ($do_usage)
98		{
	43	my $VERSION = '@@VERSION@@';
	44	my $defuser = getpwnam($PLUGINUSER);
	45	my $defgroup = getgrnam($GROUP);
	46	my $paranoia = 0;
	47	my @ignores = ();
	48
	49	my %sconf = ();
	50
	51	$do_usage = 1
	52	unless GetOptions(
	53	"config=s" => \$conffile,
	54	"debug!" => \$DEBUG,
	55	"version!" => \$do_version,
	56	"servicedir=s" => \$servicedir,
	57	"sconfdir=s" => \$sconfdir,
	58	"sconffile=s" => \$sconffile,
	59	"paranoia!" => \$paranoia,
	60	"help" => \$do_usage
	61	);
	62
	63	if ($do_usage) {
99	64	print "Usage: $0 [options]
100	65
…	…
102	67	--help View this message.
103	68	--config <file> Use <file> as configuration file.
104		[~~@@CONFDIR@@~~/munin-node.conf]
	69	[$CONFDIR/munin-node.conf]
105	70	--servicedir <dir> Dir where plugins are found.
106		[~~@@CONFDIR@@~~/plugins]
	71	[$CONFDIR/plugins]
107	72	--sconfdir <dir> Dir where plugin configurations are found.
108		[~~@@CONFDIR@@~~/plugin-conf.d]
	73	[$CONFDIR/plugin-conf.d]
109	74	--sconffile <dir> Dir where plugins are found. Overrides sconfdir.
110	75	[undefined]
…	…
116	81	";
117	82	exit 0;
118		}
119
120		if ($conffile =~ /^([-\/\@_\w\.]+)$/)
121		{
122		$conffile = $1; # $data now untainted
123		}
124		else
125		{
126		die "Bad data in $conffile"; # log this somewhere
127		}
128		if ($sconfdir =~ /^([-\/\@_\w\.]+)$/)
129		{
130		$sconfdir = $1; # $data now untainted
131		}
132		else
133		{
134		die "Bad data in $sconfdir"; # log this somewhere
135		}
136		if (defined $sconffile and $sconffile =~ /^([-\/\@_\w\.]+)$/)
137		{
138		$sconffile = $1; # $data now untainted
139		}
140		elsif (defined $sconffile)
141		{
142		die "Bad data in $sconffile"; # log this somewhere
143		}
144		if ($servicedir =~ /^([-\/\@_\w\.]+)$/)
145		{
146		$servicedir = $1; # $data now untainted
147		}
148		else
149		{
150		die "Bad data in $servicedir"; # log this somewhere
151		}
152
153
154
155		if ($do_version)
156		{
157		print <<"EOT";
158		munin-run (munin-node) version $VERSION.
159		Written by Jimmy Olsen / Linpro AS
160
161		Copyright (C) 2002-2005
162
163		This is free software released under the GNU General Public License. There
164		is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR
165		PURPOSE. For details, please refer to the file COPYING that is included
166		with this software or refer to
167		http://www.fsf.org/licensing/licenses/gpl.txt
168		EOT
169		exit 0;
	83	} ## end if ($do_usage)
	84
	85	if ( $conffile =~ /^([-\/\@_\w\.]+)$/ ) {
	86	$conffile = $1; # $data now untainted
	87	} else {
	88	die "Bad data in $conffile"; # log this somewhere
	89	}
	90
	91	if ( $sconfdir =~ /^([-\/\@_\w\.]+)$/ ) {
	92	$sconfdir = $1; # $data now untainted
	93	} else {
	94	die "Bad data in $sconfdir"; # log this somewhere
	95	}
	96
	97	if ( defined $sconffile and $sconffile =~ /^([-\/\@_\w\.]+)$/ ) {
	98	$sconffile = $1; # $data now untainted
	99	} elsif ( defined $sconffile ) {
	100	die "Bad data in $sconffile"; # log this somewhere
	101	}
	102
	103	if ( $servicedir =~ /^([-\/\@_\w\.]+)$/ ) {
	104	$servicedir = $1; # $data now untainted
	105	} else {
	106	die "Bad data in $servicedir"; # log this somewhere
	107	}
	108
	109	if ($do_version) {
	110	print "munin-run (munin-node) version $VERSION.".
	111	Munin::copyright;
	112	exit 0;
170	113	}
171	114
172	115	# Check permissions of configuration
173	116
174		if (!&check_perms ($servicedir) or !&check_perms ($conffile))
175		{
176		die "Fatal error. Bailing out.";
177		}
178
179		if (! -f $conffile) {
180		print "ERROR: Cannot open $conffile\n";
181		exit 1;
182		}
183
184		open FILE,$conffile or die "Cannot open $conffile\n";
	117	if ( !&check_perms($servicedir) or !&check_perms($conffile) ) {
	118	die "Fatal error. Bailing out.";
	119	}
	120
	121	if ( !-f $conffile ) {
	122	print "ERROR: Cannot open $conffile\n";
	123	exit 1;
	124	}
	125
	126	open FILE, $conffile or die "Cannot open $conffile\n";
185	127	while (<FILE>) {
186		chomp;
187		s/#.*//; # no comments
188		s/^\s+//; # no leading white
189		s/\s+$//; # no trailing white
190		next unless length; # anything left?
191		/(^\w)\s+(.)/;
192		if (($1 eq "host_name" or $1 eq "hostname") and $2)
193		{
194		$FQDN=$2;
195		}
196		elsif (($1 eq "default_plugin_user" or $1 eq "default_client_user") and $2)
197		{
198		my $tmpid = $2;
199		my $defuser = &get_uid ($tmpid);
200		if (! defined ($defuser))
201		{
202		die "Default user defined in \"$conffile\" does not exist ($tmpid)";
203		}
204		}
205		elsif (($1 eq "default_plugin_group" or $1 eq "default_client_group") and $2)
206		{
207		my $tmpid = $2;
208		$defgroup = &get_gid ($tmpid);
209		if (! defined ($defgroup))
210		{
211		die "Default group defined in \"$conffile\" does not exist ($tmpid)";
212		}
213		}
214		elsif (($1 eq "paranoia") and defined $2)
215		{
216		if ("$2" eq "no" or "$2" eq "false" or "$2" eq "off" or "$2" eq "0")
217		{
218		$paranoia = 0;
219		}
220		else
221		{
222		$paranoia = 1;
223		}
224		}
225		elsif (($1 eq "ignore_file") and defined $2)
226		{
227		push @ignores, $2;
228		}
229		}
	128	chomp;
	129	s/#.*//; # no comments
	130	s/^\s+//; # no leading white
	131	s/\s+$//; # no trailing white
	132	next unless length; # anything left?
	133	/(^\w)\s+(.)/;
	134	if ( ( $1 eq "host_name" or $1 eq "hostname" ) and $2 ) {
	135	$FQDN = $2;
	136	} elsif ( ( $1 eq "default_plugin_user" or $1 eq "default_client_user" )
	137	and $2 )
	138	{
	139	my $tmpid = $2;
	140	my $defuser = &get_uid($tmpid);
	141	if ( !defined($defuser) ) {
	142	die
	143	"Default user defined in \"$conffile\" does not exist ($tmpid)";
	144	}
	145	} elsif ( ( $1 eq "default_plugin_group" or $1 eq "default_client_group" )
	146	and $2 ) {
	147	my $tmpid = $2;
	148	$defgroup = &get_gid($tmpid);
	149	if ( !defined($defgroup) ) {
	150	die "Default group defined in '$conffile' does not exist ($tmpid)";
	151	}
	152	} elsif ( ( $1 eq "paranoia" ) and defined $2 ) {
	153	if ( "$2" eq "no" or "$2" eq "false" or "$2" eq "off" or "$2" eq "0" )
	154	{
	155	$paranoia = 0;
	156	} else {
	157	$paranoia = 1;
	158	}
	159	} elsif ( ( $1 eq "ignore_file" ) and defined $2 ) {
	160	push @ignores, $2;
	161	}
	162	} ## end while (<FILE>)
230	163
231	164	$FQDN \|\|= &get_fq_hostname;
232	165
233		$ENV{'FQDN'}=$FQDN;
234
235		# Some locales uses "," as decimal separator. This can mess up a lot
236		# of plugins.
237		$ENV{'LC_ALL'}='C';
	166	$ENV{'FQDN'} = $FQDN;
238	167
239	168	&load_services;
…	…
244	173
245	174	sub load_services {
246		if ($sconffile)
247		{
248		if (!&load_auth_file ("", $sconffile, \%sconf))
249		{
250		warn "Something wicked happened while reading \"$sconffile\". Check the previous log lines for spesifics.";
251		}
252		}
253		else
254		{
255		if (opendir (DIR,$sconfdir))
256		{
257		FILES:
258		for my $file (grep { -f "$sconfdir/$_" } readdir (DIR))
259		{
260		next if $file =~ m/^\./; # Hidden files
261		next if $file !~ m/^([-\w.]+)$/; # Skip if any weird chars
262		$file = $1; # Not tainted anymore.
263		foreach my $regex (@ignores)
264		{
265		next FILES if $file =~ /$regex/;
266		}
267		if (!&load_auth_file ($sconfdir, $file, \%sconf))
268		{
269		warn "Something wicked happened while reading \"$servicedir/$file\". Check the previous log lines for spesifics.";
270		}
271		}
272		closedir (DIR);
273		}
274		}
275
276		opendir (DIR,$servicedir) \|\| die "Cannot open plugindir: $servicedir $!";
277		FILES:
278		for my $file (grep { -f "$servicedir/$_" } readdir(DIR)) {
279		next if $file =~ m/^\./; # Hidden files
280		next if $file =~ m/.conf$/; # Config files
281		next if $file !~ m/^([-\w.]+)$/; # Skip if any weird chars
282		$file = $1; # Not tainted anymore.
283		foreach my $regex (@ignores)
284		{
285		next FILES if $file =~ /$regex/;
286		}
287		next if (! -x "$servicedir/$file"); # File not executeable
288		next unless ($file =~ /^$ARGV[0]$/);
289		print "# file: '$file'\n" if $DEBUG;
290		my $arg = undef;
291		if (defined $ARGV[1])
292		{
293		if ($ARGV[1] =~ /^c/i)
294		{
295		$arg = "config";
296		}
297		elsif ($ARGV[1] =~ /^a/i)
298		{
299		$arg = "autoconf";
300		}
301		elsif ($ARGV[1] =~ /^snmp/i)
302		{
303		$arg = "snmpconf";
304		}
305		elsif ($ARGV[1] =~ /^s/i)
306		{
307		$arg = "suggest";
308		}
309		}
310		$services{$file}=1;
311		my @rows = run_service($file, $arg);
312		my $node = $FQDN;
313		for my $row (@rows) {
314		print "# row: $row\n" if $DEBUG;
315		if ($row =~ m/^host_name (.+)$/) {
316		print "# Found host_name, using it\n" if $DEBUG;
317		$node = $1;
318		}
319		}
320		$nodes{$node}{$file}=1;
321		}
	175	if ($sconffile) {
	176	if ( !&load_auth_file( "", $sconffile, \%sconf ) ) {
	177	warn
	178	"Something wicked happened while reading \"$sconffile\". Check the previous log lines for spesifics.";
	179	}
	180	} else {
	181	if ( opendir( DIR, $sconfdir ) ) {
	182	FILES:
	183	for my $file ( grep { -f "$sconfdir/$_" } readdir(DIR) ) {
	184	next if $file =~ m/^\./; # Hidden files
	185	next if $file !~ m/^([-\w.]+)$/; # Skip if any weird chars
	186	$file = $1; # Not tainted anymore.
	187	foreach my $regex (@ignores) {
	188	next FILES if $file =~ /$regex/;
	189	}
	190	if ( !&load_auth_file( $sconfdir, $file, \%sconf ) ) {
	191	warn
	192	"Something wicked happened while reading \"$servicedir/$file\". Check the previous log lines for spesifics.";
	193	}
	194	}
	195	closedir(DIR);
	196	} ## end if ( opendir( DIR, $sconfdir...
	197	} ## end else[ if ($sconffile)
	198
	199	opendir( DIR, $servicedir )
	200	\|\| die "Cannot open plugindir: $servicedir $!";
	201	FILES:
	202	for my $file ( grep { -f "$servicedir/$_" } readdir(DIR) ) {
	203	next if $file =~ m/^\./; # Hidden files
	204	next if $file =~ m/.conf$/; # Config files
	205	next if $file !~ m/^([-\w.]+)$/; # Skip if any weird chars
	206	$file = $1; # Not tainted anymore.
	207	foreach my $regex (@ignores) {
	208	next FILES if $file =~ /$regex/;
	209	}
	210	next if ( !-x "$servicedir/$file" ); # File not executeable
	211	next unless ( $file =~ /^$ARGV[0]$/ );
	212	print "# file: '$file'\n" if $DEBUG;
	213	my $arg = undef;
	214	if ( defined $ARGV[1] ) {
	215	if ( $ARGV[1] =~ /^c/i ) {
	216	$arg = "config";
	217	} elsif ( $ARGV[1] =~ /^a/i ) {
	218	$arg = "autoconf";
	219	} elsif ( $ARGV[1] =~ /^snmp/i ) {
	220	$arg = "snmpconf";
	221	} elsif ( $ARGV[1] =~ /^s/i ) {
	222	$arg = "suggest";
	223	}
	224	}
	225	$services{$file} = 1;
	226	my @rows = run_service( $file, $arg );
	227	my $node = $FQDN;
	228	for my $row (@rows) {
	229	print "# row: $row\n" if $DEBUG;
	230	if ( $row =~ m/^host_name (.+)$/ ) {
	231	print "# Found host_name, using it\n" if $DEBUG;
	232	$node = $1;
	233	}
	234	}
	235	$nodes{$node}{$file} = 1;
	236	} ## end for my $file ( grep { -f...
322	237	closedir DIR;
323	238	print "ERROR: Could not execute plugin (plugin doesn't exist?).\n";
324	239	exit 1;
325		}
	240	} ## end sub load_services
326	241
327	242	sub run_service {
328		my ($service,$command) = @_;
329		$command \|\|="";
330		my @lines = ();;
331		my $timed_out = 0;
332		if ($services{$service}) {
333		my $child = 0;
334		local $SIG{ALRM} = sub {
335		$timed_out = 1;
336		};
337
338		# Setting environment
339		$sconf{$service}{user} = &get_var (\%sconf, $service, 'user');
340		$sconf{$service}{group} = &get_var (\%sconf, $service, 'group');
341		$sconf{$service}{command} = &get_var (\%sconf, $service, 'command');
342		&get_var (\%sconf, $service, 'env', \%{$sconf{$service}{env}});
343
344		if ($< == 0) # If root
345		{
346		# Giving up gid egid uid euid
347		my $u = (defined $sconf{$service}{'user'}?
348		$sconf{$service}{'user'}:
349		$defuser);
350		my $g = $defgroup;
351		my $gs = "$g $g" .
352		(defined($sconf{$service}{'group'}) ?
353		" $sconf{$service}{group}" : "");
354
355		print "# Want to run as euid/egid $u/$g\n" if $DEBUG;
356
357		$( = $g unless $g == 0;
358		$) = $gs unless $g == 0;
359		$< = $u unless $u == 0;
360		$> = $u unless $u == 0;
361
362		if ($> != $u or $g != (split (' ', $)))[0])
363		{
364		print "# Can't drop privileges. Bailing out. (wanted uid=",
365		($sconf{$service}{'user'} \|\| $defuser), " gid=\"",
366		$gs, "\"($g), got uid=$> gid=\"$)\"(", (split (' ', $)))[0], ").\n";
367		exit 1;
368		}
369		print "# Running as uid/gid/euid/egid $</$(/$>/$)\n" if $DEBUG;
370		if (!&check_perms ("$servicedir/$service"))
371		{
372		print "# Error: unsafe permissions. Bailing out.";
373		exit 1;
374		}
375		}
376
377		# Setting environment...
378		if (exists $sconf{$service}{'env'} and
379		defined $sconf{$service}{'env'})
380		{
381		foreach my $key (keys %{$sconf{$service}{'env'}})
382		{
383		print "# Setting environment $key=$sconf{$service}{env}{$key}\n"
384		if $DEBUG;
385		$ENV{$key} = $sconf{$service}{env}{$key};
386		}
387		}
388		if (exists $sconf{$service}{'command'} and
389		defined $sconf{$service}{'command'})
390		{
391		my @run = ();
392		foreach my $t (@{$sconf{$service}{'command'}})
393		{
394		if ($t =~ /^%c$/)
395		{
396		push (@run, "$servicedir/$service", $command);
397		}
398		else
399		{
400		push (@run, $t);
401		}
402		}
403		print "# About to run \"", join (' ', @run), "\"\n" if $DEBUG;
404		exec (@run) if @run;
405		}
406		else
407		{
408		print "# DEBUG: About to exec \"$servicedir/$service\"\n"
409		if $DEBUG;
410
411		if (!exec ("$servicedir/$service", $command))
412		{
413		print "no (could not execute plugin)\n"; exit 1;
414		}
415		}
416		} else {
417		print "# Unknown service\n";
418		}
419		chomp @lines;
420		return (@lines);
421		}
	243	my ( $service, $command ) = @_;
	244	$command \|\|= "";
	245	my @lines = ();
	246	my $timed_out = 0;
	247	if ( $services{$service} ) {
	248	my $child = 0;
	249	local $SIG{ALRM} = sub {
	250	$timed_out = 1;
	251	};
	252
	253	# Setting environment
	254	$sconf{$service}{user} = &get_var( \%sconf, $service, 'user' );
	255	$sconf{$service}{group} = &get_var( \%sconf, $service, 'group' );
	256	$sconf{$service}{command} = &get_var( \%sconf, $service, 'command' );
	257	&get_var( \%sconf, $service, 'env', \%{ $sconf{$service}{env} } );
	258
	259	if ( $< == 0 ) # If root
	260	{
	261
	262	# Giving up gid egid uid euid
	263	my $u = (
	264	defined $sconf{$service}{'user'}
	265	? $sconf{$service}{'user'}
	266	: $defuser
	267	);
	268	my $g = $defgroup;
	269	my $gs = "$g $g"
	270	. (
	271	defined( $sconf{$service}{'group'} )
	272	? " $sconf{$service}{group}"
	273	: ""
	274	);
	275
	276	print "# Want to run as euid/egid $u/$g\n" if $DEBUG;
	277
	278	$( = $g unless $g == 0;
	279	$) = $gs unless $g == 0;
	280	$< = $u unless $u == 0;
	281	$> = $u unless $u == 0;
	282
	283	if ( $> != $u or $g != ( split( ' ', $) ) )[0] ) {
	284	print "# Can't drop privileges. Bailing out. (wanted uid=",
	285	( $sconf{$service}{'user'} \|\| $defuser ), " gid=\"", $gs,
	286	"\"($g), got uid=$> gid=\"$)\"(", ( split( ' ', $) ) )[0],
	287	").\n";
	288	exit 1;
	289	}
	290	print "# Running as uid/gid/euid/egid $</$(/$>/$)\n" if $DEBUG;
	291	if ( !&check_perms("$servicedir/$service") ) {
	292	print "# Error: unsafe permissions. Bailing out.";
	293	exit 1;
	294	}
	295	} ## end if ( $< == 0 )
	296
	297	# Setting environment...
	298	if ( exists $sconf{$service}{'env'}
	299	and defined $sconf{$service}{'env'} )
	300	{
	301	foreach my $key ( keys %{ $sconf{$service}{'env'} } ) {
	302	print
	303	"# Setting environment $key=$sconf{$service}{env}{$key}\n"
	304	if $DEBUG;
	305	$ENV{$key} = $sconf{$service}{env}{$key};
	306	}
	307	}
	308	if ( exists $sconf{$service}{'command'}
	309	and defined $sconf{$service}{'command'} )
	310	{
	311	my @run = ();
	312	foreach my $t ( @{ $sconf{$service}{'command'} } ) {
	313	if ( $t =~ /^%c$/ ) {
	314	push( @run, "$servicedir/$service", $command );
	315	} else {
	316	push( @run, $t );
	317	}
	318	}
	319	print "# About to run \"", join( ' ', @run ), "\"\n" if $DEBUG;
	320	exec(@run) if @run;
	321	} else {
	322	print "# DEBUG: About to exec \"$servicedir/$service\"\n"
	323	if $DEBUG;
	324
	325	if ( !exec( "$servicedir/$service", $command ) ) {
	326	print "no (could not execute plugin)\n";
	327	exit 1;
	328	}
	329	}
	330	} else {
	331	print "# Unknown service\n";
	332	}
	333	chomp @lines;
	334	return (@lines);
	335	} ## end sub run_service
422	336
423	337	sub get_fq_hostname {
…	…
425	339	eval {
426	340	require Sys::Hostname;
427		$hostname = (~~gethostbyname(Sys::Hostname::hostname())~~)[0];
	341	$hostname = ( gethostbyname( Sys::Hostname::hostname() ) )[0];
428	342	};
429	343	return $hostname if $hostname;
430	344
431		$hostname = `hostname`; # Fall$
	345	$hostname = `hostname`; # Fall$
432	346	chomp($hostname);
433	347	$hostname =~ s/\s//g;
…	…
435	349	}
436	350
437
438		sub get_uid
439		{
	351	sub get_uid {
440	352	my $user = shift;
441		return undef if (!defined $user);
442
443		if ($user !~ /\d/)
444		{
445		$user = getpwnam ($user);
	353	return undef if ( !defined $user );
	354
	355	if ( $user !~ /\d/ ) {
	356	$user = getpwnam($user);
446	357	}
447	358	return $user;
448	359	}
449	360
450		sub get_gid
451		{
	361	sub get_gid {
452	362	my $group = shift;
453		return undef if (!defined $group);
454
455		if ($group !~ /\d/)
456		{
457		$group = getgrnam ($group);
	363	return undef if ( !defined $group );
	364
	365	if ( $group !~ /\d/ ) {
	366	$group = getgrnam($group);
458	367	}
459	368	return $group;
460	369	}
461	370
462		sub load_auth_file
463		{
464		my ($dir, $file, $sconf) = @_;
	371	sub load_auth_file {
	372	my ( $dir, $file, $sconf ) = @_;
465	373	my $service = $file;
466	374
467		if (!defined $dir or !defined $file or !defined $sconf)
468		{
469		return undef;
470		}
471
472		return undef if (length $dir and !&check_perms ($dir));
473		return undef if (!&check_perms ("$dir/$file"));
474
475		if (!open (IN, "$dir/$file"))
476		{
477		warn "Could not open file \"$dir/$file\" for reading ($!), skipping plugin\n";
478		return undef;
479		}
480		while (<IN>)
481		{
482		chomp;
483		s/#.*$//;
484		next unless /\S/;
485		if (/^\s\[([^\]]+)\]\s$/)
486		{
487		$service = $1;
488		}
489		elsif (/^\suser\s+(\S+)\s$/)
490		{
491		my $tmpid = $1;
492		$sconf->{$service}{'user'} = &get_uid ($tmpid);
493		if (!defined $sconf->{$service}{'user'})
494		{
495		warn "User \"$tmpid\" in configuration file \"$dir/$file\" nonexistant. Skipping plugin.";
496		return undef;
497		}
498		}
499		elsif (/^\sgroup\s+(.+)\s$/)
500		{
501		my $tmpid = $1;
502		foreach my $group (split /\s,\s/, $tmpid)
503		{
504		my $optional = 0;
505
506		if ($group =~ /^$([^)]+)$$/)
507		{
508		$optional = 1;
509		$group = $1;
510		}
511
512		my $g = &get_gid ($group);
513		if (!defined $g and !$optional)
514		{
515		warn "Group \"$group\" in configuration file \"$dir/$file\" nonexistant. Skipping plugin.";
516		return undef;
517		}
518		elsif (!defined $g and $optional)
519		{
520		print "# DEBUG: Skipping \"$group\" (optional).\n"
521		if $DEBUG;
522		next;
523		}
524
525		if (!defined $sconf->{$service}{'group'})
526		{
527		$sconf->{$service}{'group'} = $g;
528		}
529		else
530		{
531		$sconf->{$service}{'group'} .= " $g";
532		}
533		}
534		}
535		elsif (/^\scommand\s+(.+)\s$/)
536		{
537		@{$sconf->{$service}{'command'}} = split (/\s+/, $1);
538		}
539		elsif (/^\shost_name\s+(.+)\s$/)
540		{
	375	if ( !defined $dir or !defined $file or !defined $sconf ) {
	376	return undef;
	377	}
	378
	379	return undef if ( length $dir and !&check_perms($dir) );
	380	return undef if ( !&check_perms("$dir/$file") );
	381
	382	if ( !open( IN, "$dir/$file" ) ) {
	383	warn
	384	"Could not open file \"$dir/$file\" for reading ($!), skipping plugin\n";
	385	return undef;
	386	}
	387	while (<IN>) {
	388	chomp;
	389	s/#.*$//;
	390	next unless /\S/;
	391	if (/^\s\[([^\]]+)\]\s$/) {
	392	$service = $1;
	393	} elsif (/^\suser\s+(\S+)\s$/) {
	394	my $tmpid = $1;
	395	$sconf->{$service}{'user'} = &get_uid($tmpid);
	396	if ( !defined $sconf->{$service}{'user'} ) {
	397	warn
	398	"User \"$tmpid\" in configuration file \"$dir/$file\" nonexistant. Skipping plugin.";
	399	return undef;
	400	}
	401	} elsif (/^\sgroup\s+(.+)\s$/) {
	402	my $tmpid = $1;
	403	foreach my $group ( split /\s,\s/, $tmpid ) {
	404	my $optional = 0;
	405
	406	if ( $group =~ /^$([^)]+)$$/ ) {
	407	$optional = 1;
	408	$group = $1;
	409	}
	410
	411	my $g = &get_gid($group);
	412	if ( !defined $g and !$optional ) {
	413	warn
	414	"Group \"$group\" in configuration file \"$dir/$file\" nonexistant. Skipping plugin.";
	415	return undef;
	416	} elsif ( !defined $g and $optional ) {
	417	print "# DEBUG: Skipping \"$group\" (optional).\n"
	418	if $DEBUG;
	419	next;
	420	}
	421
	422	if ( !defined $sconf->{$service}{'group'} ) {
	423	$sconf->{$service}{'group'} = $g;
	424	} else {
	425	$sconf->{$service}{'group'} .= " $g";
	426	}
	427	} ## end foreach my $group ( split /\s,\s/...
	428	} ## end elsif (/^\sgroup\s+(.+)\s$/...
	429	elsif (/^\scommand\s+(.+)\s$/) {
	430	@{ $sconf->{$service}{'command'} } = split( /\s+/, $1 );
	431	} elsif (/^\shost_name\s+(.+)\s$/) {
541	432	$sconf->{$service}{'host_name'} = $1;
542		}
543		elsif (/^\stimeout\s+(\d+)\s$/)
544		{
	433	} elsif (/^\stimeout\s+(\d+)\s$/) {
545	434	$sconf->{$service}{'timeout'} = $1;
546	435	print "# DEBUG: $service: setting timeout to $1\n"
547		if $DEBUG;
548		}
549		elsif (/^\s(allow)\s+(.+)\s$/ or /^\s(deny)\s+(.+)\s$/)
550		{
551		push (@{$sconf->{$service}{'allow_deny'}}, [$1, $2]);
552		print "# DEBUG: Pushing allow_deny: $1, $2\n" if $DEBUG;
553		}
554		elsif (/^\senv\s+([^=\s]+)\s=\s*(.+)$/)
555		{
	436	if $DEBUG;
	437	} elsif ( /^\s(allow)\s+(.+)\s$/ or /^\s(deny)\s+(.+)\s$/ ) {
	438	push( @{ $sconf->{$service}{'allow_deny'} }, [ $1, $2 ] );
	439	print "# DEBUG: Pushing allow_deny: $1, $2\n" if $DEBUG;
	440	} elsif (/^\senv\s+([^=\s]+)\s=\s*(.+)$/) {
556	441	$sconf->{$service}{'env'}{$1} = $2;
557	442	print "# Saving $service->env->$1 = $2...\n" if $DEBUG;
558		warn "Warning: Deprecated format in \"$dir/$file\" under \"[$service]\" (\"env $1=$2\" should be rewritten to \"env.$1 $2\").";
559		}
560		elsif (/^\s*env\.(\S+)\s+(.+)$/)
561		{
	443	warn
	444	"Warning: Deprecated format in \"$dir/$file\" under \"[$service]\" (\"env $1=$2\" should be rewritten to \"env.$1 $2\").";
	445	} elsif (/^\s*env\.(\S+)\s+(.+)$/) {
562	446	$sconf->{$service}{'env'}{$1} = $2;
563	447	print "# Saving $service->env->$1 = $2...\n" if $DEBUG;
564		}
565		elsif (/^\s*(\w+)\s+(.+)$/)
566		{
	448	} elsif (/^\s*(\w+)\s+(.+)$/) {
567	449	$sconf->{$service}{'env'}{"lrrd_$1"} = $2;
568	450	print "# Saving $service->env->lrrd_$1 = $2...\n" if $DEBUG;
569		warn "Warning: Deprecated format in \"$dir/$file\" under \"[$service]\" (\"$1 $2\" should be rewritten to \"env.$1 $2\").";
570		}
571		~~elsif (/\S/)~~
572		{
573		~~warn~~ "Warning: Unknown config option in \"$dir/$file\" under \"[$service]\": $_";
574		}
575		}
576		close (IN);
	451	warn
	452	"Warning: Deprecated format in \"$dir/$file\" under \"[$service]\" (\"$1 $2\" should be rewritten to \"env.$1 $2\").";
	453	} elsif (/\S/) {
	454	warn
	455	"Warning: Unknown config option in \"$dir/$file\" under \"[$service]\": $_";
	456	}
	457	} ## end while (<IN>)
	458	close(IN);
577	459
578	460	return 1;
579		}
580
581		sub check_perms
582		{
	461	} ## end sub load_auth_file
	462
	463	sub check_perms {
583	464	my $target = shift;
584	465	my @stat;
585		return undef if (!defined $target);
586		return 1 if (!$paranoia);
587
588		if (! -e "$target")
	466	return undef if ( !defined $target );
	467	return 1 if ( !$paranoia );
	468
	469	if ( !-e "$target" ) {
	470	warn "Failed to check permissions on nonexistant target: \"$target\"";
	471	return undef;
	472	}
	473
	474	@stat = stat($target);
	475	if ( !$stat[4] == 0
	476	or ( $stat[5] != 0 and $stat[2] & 00020 )
	477	or ( $stat[2] & 00002 ) )
589	478	{
590		warn "Failed to check permissions on nonexistant target: \"$target\"";
591		return undef;
592		}
593
594		@stat = stat ($target);
595		if (!$stat[4] == 0 or
596		($stat[5] != 0 and $stat[2] & 00020) or
597		($stat[2] & 00002))
	479	warn "Warning: \"$target\" has dangerous permissions (",
	480	sprintf( "%04o", $stat[2] & 07777 ), ").";
	481	return 0;
	482	}
	483
	484	if ( -f "$target" ) # Check dir as well
598	485	{
599		warn "Warning: \"$target\" has dangerous permissions (", sprintf ("%04o", $stat[2] & 07777), ").";
600		return 0;
601		}
602
603		if (-f "$target") # Check dir as well
604		{
605		(my $dirname = $target) =~ s/[^\/]+$//;
606		return &check_perms ($dirname);
	486	( my $dirname = $target ) =~ s/[^\/]+$//;
	487	return &check_perms($dirname);
607	488	}
608	489
609	490	return 1;
610		}
611
612		sub get_var
613		{
614		my $sconf = shift;
615		my $name = shift;
616		my $var = shift;
617		my $env = shift;
618
619		if ($var eq 'env' and !defined $env)
620		{
	491	} ## end sub check_perms
	492
	493	sub get_var {
	494	my $sconf = shift;
	495	my $name = shift;
	496	my $var = shift;
	497	my $env = shift;
	498
	499	if ( $var eq 'env' and !defined $env ) {
621	500	%{$env} = ();
622	501	}
623
624		if ($var ne 'env' and exists $sconf->{$name}{$var})
625		{
	502
	503	if ( $var ne 'env' and exists $sconf->{$name}{$var} ) {
626	504	return $sconf->{$name}{$var};
627	505	}
628		# Deciding environment
629		foreach my $wildservice (grep (/\*$/, reverse sort keys %{$sconf}))
630		{
631		(~~my $tmpservice = $wildservice~~) =~ s/\*$//;
632		next unless (~~$name =~ /^$tmpservice/~~);
	506
	507	# Deciding environment
	508	foreach my $wildservice ( grep ( /\*$/, reverse sort keys %{$sconf} ) ) {
	509	( my $tmpservice = $wildservice ) =~ s/\*$//;
	510	next unless ( $name =~ /^$tmpservice/ );
633	511	print "# Checking $wildservice...\n" if $DEBUG;
634	512
635		if ($var eq 'env')
636		{
637		if (exists $sconf->{$wildservice}{'env'})
638		{
639		foreach my $key (keys %{$sconf->{$wildservice}{'env'}})
640		{
641		if (! exists $sconf->{$name}{'env'}{$key})
642		{
643		$sconf->{$name}{'env'}{$key} = $sconf->{$wildservice}{'env'}{$key};
	513	if ( $var eq 'env' ) {
	514	if ( exists $sconf->{$wildservice}{'env'} ) {
	515	foreach my $key ( keys %{ $sconf->{$wildservice}{'env'} } ) {
	516	if ( !exists $sconf->{$name}{'env'}{$key} ) {
	517	$sconf->{$name}{'env'}{$key} =
	518	$sconf->{$wildservice}{'env'}{$key};
644	519	print "# Saving $wildservice->$key\n" if $DEBUG;
645	520	}
646	521	}
647	522	}
648		}
649		else
650		{
651		if (! exists $sconf->{$name}{$var} and
652		exists $sconf->{$wildservice}{$var})
	523	} else {
	524	if ( !exists $sconf->{$name}{$var}
	525	and exists $sconf->{$wildservice}{$var} )
653	526	{
654		return (~~$sconf->{$wildservice}{$var}~~);
655		}
656		}
657		}
	527	return ( $sconf->{$wildservice}{$var} );
	528	}
	529	}
	530	} ## end foreach my $wildservice ( grep...
658	531	return $env;
659		}
660
661
	532	} ## end sub get_var
662	533
663	534	1;
…	…
746	617
747	618	Copyright (C) 2002-2006 Audun Ytterdal, Jimmy Olsen, Tore Anderson,
748		Nicolai Langfeldt / Linpro AS.
	619	Nicolai Langfeldt.
	620
	621	The work has in part been financed by Linpro AS. http://linpro.no/
749	622
750	623	This is free software; see the source for copying conditions. There is
…	…
756	629	=cut
757	630
	631
758	632	# vim:syntax=perl

Navigation

Changeset 1257

Legend:

people/janl/src/libperl/Munin.pm

people/janl/src/libperl/Munin/Node.pm

people/janl/src/node/munin-node

people/janl/src/node/munin-run

Download in other formats: