Status.pm

Revision ab637c1792a4b0a60d352968204b4b73999f7d99, 15.6 kB (checked in by Mark Harrison <mark@omniti.com>, 3 years ago)

Add locking when reading/writing resmon state.

git-svn-id: https://labs.omniti.com/resmon/branches/resmon2@368 8c0face9-b7db-6ec6-c4b3-d5f7145c7d55

Property mode set to 100644

Line
1	package Resmon::Status;
2
3	use strict;
4	use warnings;
5	use POSIX qw/:sys_wait_h/;
6	use IO::Handle;
7	use IO::File;
8	use IO::Socket;
9	use Socket;
10	use Fcntl qw/:flock/;
11	use Data::Dumper;
12
13	my $KEEPALIVE_TIMEOUT = 5;
14	my $REQUEST_TIMEOUT = 60;
15	sub new {
16	my $class = shift;
17	my $file = shift;
18	my $fh = IO::File->new(".$file.state", "+>");
19	# Delete the just opened file - it stays open, but doesn't show on disk
20	unlink ".$file.state";
21	return bless {
22	file => $file,
23	shared_state => $fh
24	}, $class;
25	}
26
27	sub get_shared_state {
28	my $self = shift;
29	my $fh = $self->{shared_state};
30	if (defined $fh) {
31	flock($fh, LOCK_EX); # Obtain a lock on the file
32	my $VAR1;
33	$fh->seek(0, 0);
34	my $blob;
35	{
36	local $/ = undef;
37	$blob = <$fh>;
38	}
39	flock($fh, LOCK_UN); # Release the lock
40	eval $blob;
41	die $@ if ($@);
42	$self->{store} = $VAR1;
43	} else {
44	die "Unable to read shared state";
45	};
46	return $self->{store};
47	}
48
49	sub store_shared_state {
50	my $self = shift;
51	my $fh = $self->{shared_state};
52	if (defined($fh)) {
53	flock($fh, LOCK_EX); # Obtain a lock on the file
54	$fh->truncate(0);
55	$fh->seek(0,0);
56	print $fh Dumper($self->{store});
57	$fh->flush();
58	flock($fh, LOCK_UN); # Release the lock
59	} else {
60	die "Unable to store shared state";
61	};
62	}
63
64	sub xml_kv_dump {
65	my $info = shift;
66	my $indent = shift \|\| 0;
67	my $rv = '';
68	while(my ($key, $value) = each %$info) {
69	if(ref $value eq 'HASH') {
70	while (my ($k, $v) = each %$value) {
71	$rv .= " " x $indent;
72	$rv .= "<$key name=\"$k\"";
73	if (ref($v) eq 'ARRAY') {
74	# A value/type pair
75	my $type = $v->[1];
76	if ($type !~ /^[0iIlLns]$/) {
77	$type = "0";
78	}
79	$rv .= " type=\"$type\"";
80	$v = $v->[0];
81	}
82	$v = xml_escape($v);
83	$rv .= ">$v</$key>\n";
84	}
85	} else {
86	$rv .= " " x $indent;
87	$value = xml_escape($value);
88	$rv .= "<$key>$value</$key>\n";
89	}
90	}
91	return $rv;
92	}
93
94	sub xml_info {
95	my ($module, $service, $info) = @_;
96	my $rv = '';
97	$rv .= " <ResmonResult module=\"$module\" service=\"$service\">\n";
98	$rv .= xml_kv_dump($info, 4);
99	$rv .= " </ResmonResult>\n";
100	return $rv;
101	}
102
103	sub xml_escape {
104	my $v = shift;
105	$v =~ s/&/&/g;
106	$v =~ s/</</g;
107	$v =~ s/>/>/g;
108	$v =~ s/'/'/g;
109	return $v;
110	}
111
112	sub dump_generic {
113	my $self = shift;
114	my $dumper = shift;
115	my $rv = '';
116	while(my ($module, $services) = each %{$self->{store}}) {
117	while(my ($service, $info) = each %$services) {
118	$rv .= $dumper->($module,$service,$info);
119	}
120	}
121	return $rv;
122	}
123
124	sub dump_generic_module {
125	# Dumps a single module rather than all checks
126	my $self = shift;
127	my $dumper = shift;
128	my $module = shift;
129	my $rv = '';
130	my $services = $self->{store}->{$module};
131	while(my ($service, $info) = each %$services) {
132	$rv .= $dumper->($module,$service,$info);
133	}
134	return $rv;
135	}
136	sub dump_xml {
137	my $self = shift;
138	my $response = <<EOF
139	<?xml version="1.0" encoding="UTF-8"?>
140	<?xml-stylesheet type="text/xsl" href="/resmon.xsl"?>
141	<ResmonResults>
142	EOF
143	;
144	$response .= $self->dump_generic(\&xml_info);
145	$response .= "</ResmonResults>\n";
146	return $response;
147	}
148	sub get_xsl() {
149	my $response = <<EOF
150	<?xml version="1.0" encoding="ISO-8859-1"?>
151	<xsl:stylesheet version="1.0"
152	xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
153	<xsl:template match="ResmonResults">
154	<html>
155	<head>
156	<title>Resmon Results</title>
157	<link rel="stylesheet" type="text/css" href="/resmon.css" />
158	</head>
159	<body>
160	<p>
161	Total checks:
162	<xsl:value-of select="count(ResmonResult)" />
163	</p>
164	<xsl:for-each select="ResmonResult">
165	<xsl:sort select="\@module" />
166	<xsl:sort select="\@service" />
167	<div class="item">
168	<div class="info">
169	Last check: <xsl:value-of select="last_runtime_seconds" />
170	/
171	Last updated: <xsl:value-of select="last_update" />
172	</div>
173	<h1>
174	<a>
175	<xsl:attribute name="href">
176	/<xsl:value-of select="\@module" />
177	</xsl:attribute>
178	<xsl:value-of select="\@module" />
179	</a>`<a>
180	<xsl:attribute name="href">
181	/<xsl:value-of select="\@module"
182	/>/<xsl:value-of select="\@service" />
183	</xsl:attribute>
184	<xsl:value-of select="\@service" />
185	</a>
186	</h1>
187	<ul>
188	<xsl:for-each select="metric">
189	<xsl:sort select="\@name" />
190	<li><xsl:value-of select="\@name" /> =
191	<xsl:value-of select="." /></li>
192	</xsl:for-each>
193	</ul>
194	</div>
195	</xsl:for-each>
196	</body>
197	</html>
198	</xsl:template>
199	</xsl:stylesheet>
200	EOF
201	;
202	return $response;
203	}
204	sub get_css() {
205	my $response=<<EOF
206	body {
207	font-family: Verdana, Arial, helvetica, sans-serif;
208	}
209
210	h1 {
211	margin: 0;
212	font-size: 120%;
213	}
214
215	h2 {
216	margin: 0;
217	font-size: 110%;
218	}
219
220	.item {
221	border: 1px solid black;
222	border-left: 10px solid #999;
223	padding: 1em;
224	margin: 2em;
225	background-color: #eeeeee;
226	}
227
228	.info {
229	float: right;
230	font-size: 80%;
231	padding: 0;
232	margin: 0;
233	}
234
235	table {
236	border: 1px solid black;
237	background-color: #eeeeee;
238	border-collapse: collapse;
239	margin: 1em;
240	font-size: 80%;
241	}
242
243	th {
244	font-size: 100%;
245	font-weight: bold;
246	background-color: black;
247	color: white;
248	}
249
250	td {
251	padding-left: 1em;
252	padding-right: 1em;
253	}
254
255	a {
256	text-decoration: none;
257	}
258
259	a.metrics, a.metrics:visited {
260	color: black;
261	}
262
263	a.metrics table {
264	display: none;
265	}
266
267	a.metrics:hover table {
268	display: block;
269	position: relative;
270	top: 1em;
271	right: 1em;
272	max-width: 95%;
273	overflow: hidden;
274	}
275	EOF
276	;
277	return $response;
278	}
279
280	sub service {
281	my $self = shift;
282	my ($client, $req, $proto, $snip, $authuser, $authpass) = @_;
283	my $state = $self->get_shared_state();
284	if (defined($self->{authuser}) && $self->{authuser} ne "" &&
285	($authuser ne $self->{authuser} \|\| $authpass ne $self->{authpass})) {
286	my $response = "<html><head><title>Password required</title></head>" .
287	"<body><h1>Password required</h1></body></html>";
288	$client->print(http_header(401, length($response), 'text/html', $snip,
289	"WWW-Authenticate: Basic realm=\"Resmon\"\n"));
290	$client->print($response . "\r\n");
291	return;
292	} elsif($req eq '/') {
293	my $response .= $self->dump_xml();
294	$client->print(http_header(200, length($response), 'text/xml', $snip));
295	$client->print($response . "\r\n");
296	return;
297	} elsif($req eq '/resmon.xsl') {
298	my $response = $self->get_xsl();
299	$client->print(http_header(200, length($response), 'text/xml', $snip));
300	$client->print($response . "\r\n");
301	return;
302	} elsif($req eq '/resmon.css') {
303	my $response = $self->get_css();
304	$client->print(http_header(200, length($response), 'text/css', $snip));
305	$client->print($response . "\r\n");
306	return;
307	} elsif($req =~ /^\/([^\/]+)\/(.+)$/) {
308	if(exists($self->{store}->{$1}) &&
309	exists($self->{store}->{$1}->{$2})) {
310	my $info = $self->{store}->{$1}->{$2};
311	my $response = qq^<?xml version="1.0" encoding="UTF-8"?>\n^;
312	$response .= qq^<?xml-stylesheet type="text/xsl" href="/resmon.xsl"?>^;
313	$response .= "<ResmonResults>\n".
314	xml_info($1,$2,$info).
315	"</ResmonResults>\n";
316	$client->print(http_header(200, length($response), 'text/xml', $snip));
317	$client->print( $response . "\r\n");
318	return;
319	}
320	} elsif($req =~ /^\/([^\/]+)$/) {
321	if(exists($self->{store}->{$1})) {
322	my $response = qq^<?xml version="1.0" encoding="UTF-8"?>\n^;
323	$response .= qq^<?xml-stylesheet type="text/xsl" href="/resmon.xsl"?>^;
324	$response .= "<ResmonResults>\n".
325	$self->dump_generic_module(\&xml_info,$1) .
326	"</ResmonResults>\n";
327	$client->print(http_header(200, length($response), 'text/xml', $snip));
328	$client->print( $response . "\r\n");
329	return;
330	}
331	}
332	die "Request not understood\n";
333	}
334
335	sub http_header {
336	my $code = shift;
337	my $len = shift;
338	my $type = shift \|\| 'text/xml';
339	my $close_connection = shift \|\| 1;
340	my $extra_headers = shift \|\| "";
341	return "HTTP/1.0 $code OK\nServer: resmon\n" .
342	(defined($len) ? "Content-length: $len\n" : "") .
343	(($close_connection \|\| !$len) ? "Connection: close\n" : "") .
344	"Content-Type: $type; charset=utf-8\n" . $extra_headers . "\n";
345	}
346
347	sub base64_decode($) {
348	# Base64 decoding for basic auth
349	# We cheat when doing the decoding - perl can do uudecoding using unpack -
350	# so we just convert to uuencoded text and decode that.
351	my $enc = shift;
352	if (length($enc) % 4 != 0) { return "" } # Length should be multiple of 4
353	$enc =~ tr#A-Za-z0-9+/=##cd; # Ignore any invalid characters
354	$enc =~ tr#A-Za-z0-9+/=# -_#d; # Convert base64 to uuencode alphabet and
355	# strip padding
356	if (length($enc) > 63) { return "" }; # Only support up to 63 chars
357	# (one uuencoded line)
358	my $len = chr(32 + length($enc)*3/4); # uuencode has a length byte at the
359	# beginning
360	return unpack("u", $len.$enc);
361	}
362
363	sub serve_http_on {
364	my $self = shift;
365	my $ip = shift;
366	my $port = shift;
367	$self->{authuser} = shift;
368	$self->{authpass} = shift;
369	$ip = INADDR_ANY if(!defined($ip) \|\| $ip eq '' \|\| $ip eq '*');
370	$port \|\|= 81;
371
372	my $handle = IO::Socket->new();
373	socket($handle, PF_INET, SOCK_STREAM, getprotobyname('tcp'))
374	\|\| die "socket: $!";
375	setsockopt($handle, SOL_SOCKET, SO_REUSEADDR, pack("l", 1))
376	\|\| die "setsockopt: $!";
377	bind($handle, sockaddr_in($port, $ip))
378	\|\| die "bind: $!";
379	listen($handle,SOMAXCONN);
380
381	$self->{http_port} = $port;
382	$self->{http_ip} = $ip;
383
384	$self->{parent_pid} = $$;
385	$self->{child} = fork();
386	if($self->{child} == 0) {
387	eval {
388	$SIG{'HUP'} = 'IGNORE';
389	$SIG{'PIPE'} = 'IGNORE';
390	while(my $client = $handle->accept) {
391	my $req;
392	my $proto;
393	my $close_connection;
394	my $authuser;
395	my $authpass;
396	local $SIG{ALRM} = sub { die "timeout\n" };
397	eval {
398	alarm($KEEPALIVE_TIMEOUT);
399	while(<$client>) {
400	alarm($REQUEST_TIMEOUT);
401	eval {
402	s/\r\n/\n/g;
403	chomp;
404	if(!$req) {
405	if(/^GET \s(\S+)\s?(?: HTTP\/(0\.9\|1\.0\|1\.1)\s*)?$/) {
406	$req = $1;
407	$proto = $2;
408	# Protocol 1.1 and high are keep-alive by
409	# default
410	$close_connection = ($proto <= 1.0)?1:0;
411	}
412	elsif(/./) {
413	die "protocol deviations.\n";
414	}
415	}
416	else {
417	if(/^$/) {
418	$self->service($client, $req, $proto, $close_connection,
419	$authuser, $authpass);
420	last if ($close_connection);
421	alarm($KEEPALIVE_TIMEOUT);
422	$req = undef;
423	$proto = undef;
424	}
425	elsif(/^\S+\s:\s.{1,4096}$/) {
426	# Valid request header... noop
427	if(/^Connection: (\S+)/) {
428	if(($proto <= 1.0 && lc($2) eq 'keep-alive') \|\|
429	($proto == 1.1 && lc($2) ne 'close')) {
430	$close_connection = 0;
431	}
432	}
433	if(/^Authorization: Basic (\S+)/) {
434	my $dec = base64_decode($1);
435	($authuser, $authpass) = split /:/, $dec, 2
436	}
437	}
438	else {
439	die "protocol deviations.\n";
440	}
441	}
442	};
443	if($@) {
444	print $client http_header(500, 0, 'text/plain', 1);
445	print $client "$@\r\n";
446	last;
447	}
448	}
449	alarm(0);
450	};
451	alarm(0) if($@);
452	$client->close();
453	}
454	};
455	if($@) {
456	print STDERR "Error in listener: $@\n";
457	}
458	exit(0);
459	}
460	close($handle);
461	return;
462	}
463
464	sub open {
465	my $self = shift;
466	return 0 unless(ref $self);
467	return 1 if($self->{handle}); # Already open
468	if($self->{file} eq '-' \|\| !defined($self->{file})) {
469	# We'll use stdout instead - no file handle needed
470	return 1;
471	}
472	$self->{handle} = IO::File->new("> $self->{file}.swap");
473	die "open $self->{file}.swap failed: $!\n" unless($self->{handle});
474	$self->{swap_on_close} = 1; # move this to a non .swap version on close
475	chmod 0644, "$self->{file}.swap";
476
477	return 1;
478	}
479
480	sub store {
481	my ($self, $type, $name, $info) = @_;
482	%{$self->{store}->{$type}->{$name}} = %$info;
483	$self->{store}->{$type}->{$name}->{last_update} = time;
484	$self->store_shared_state();
485	}
486
487	sub clear {
488	# Clear all state after a reload
489	my $self = shift;
490	$self->{store} = {};
491	$self->store_shared_state;
492	}
493
494	sub write {
495	# Writes the metrics output for a single check to stdout and/or a file
496	my ($self, $module_name, $check_name, $metrics, $debug) = @_;
497	my $metrics_output = "$module_name`$check_name\n";
498	while (my ($k, $v) = each (%$metrics)) {
499	if (ref($v) eq "ARRAY") {
500	$v = $v->[0];
501	}
502	$metrics_output .= " $k = $v\n";
503	}
504	if($self->{handle}) {
505	$self->{handle}->print($metrics_output);
506	}
507	if (!$self->{handle} \|\| $debug) {
508	print $metrics_output;
509	}
510	}
511
512	sub close {
513	my $self = shift;
514	$self->{handle}->close() if($self->{handle});
515	$self->{handle} = undef;
516	if($self->{swap_on_close}) {
517	unlink("$self->{file}");
518	link("$self->{file}.swap", $self->{file});
519	unlink("$self->{file}.swap");
520	delete($self->{swap_on_close});
521	}
522	}
523
524	sub DESTROY {
525	my $self = shift;
526	# Make sure we're really the parent process
527	return if ($self->{parent_pid} != $$);
528	my $child = $self->{child};
529	if ($child) {
530	kill 15, $child;
531	sleep 1;
532	kill 9, $child if(kill 0, $child);
533	waitpid(-1,WNOHANG);
534	}
535	}
536	1;

Note: See TracBrowser for help on using the browser.

root/lib/Resmon/Status.pm

Download in other formats: