root/lib/Resmon/Status.pm

Revision 4160ac7115f4ba20e58f898c98074ce5d3e5dd75, 19.1 kB (checked in by Mark Harrison <mark@mivok.net>, 6 years ago)

Don't store blank data if we fail to get anything from the shared state file

Occasionally on some systems, the data returned from the shared state file is
bad/blank, despite locking. Ideally we'd find the cause of this and fix it,
but various attempts haven't identified exactly why this happens (including
running fsync after writing and before unlocking). If the data returned is
blank, we should use the latest available data rather than returning blank
data to the user/monitoring system.

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