root/lib/Resmon/Status.pm

Revision 7b227a82217114afb1353bc581d01f7af4bd1996, 14.6 kB (checked in by Mark Harrison <mark@omniti.com>, 9 years ago)

Support for viewing checks by state and module

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

  • Property mode set to 100644
Line 
1 package Resmon::Status;
2
3 use strict;
4 use POSIX qw/:sys_wait_h/;
5 use IO::Handle;
6 use IO::File;
7 use IO::Socket;
8 use Socket;
9 use Fcntl qw/:flock/;
10 use IPC::SysV qw /IPC_PRIVATE IPC_CREAT IPC_RMID ftok S_IRWXU S_IRWXG S_IRWXO/;
11 use Data::Dumper;
12
13 my $SEGSIZE = 1024*256;
14 my $KEEPALIVE_TIMEOUT = 5;
15 my $REQUEST_TIMEOUT = 60;
16 sub new {
17   my $class = shift;
18   my $file = shift;
19   return bless {
20     file => $file
21   }, $class;
22 }
23 sub get_shared_state {
24   my $self = shift;
25   my $blob;
26   my $len;
27   return unless(defined($self->{shared_state}));
28   # Lock shared segment
29   # Read in
30   shmread($self->{shared_state}, $len, 0, length(pack('i', 0)));
31   $len = unpack('i', $len);
32   shmread($self->{shared_state}, $blob, length(pack('i', 0)), $len);
33   # unlock
34   my $VAR1;
35   eval $blob;
36   die $@ if ($@);
37   $self->{store} = $VAR1;
38   return $self->{store};
39 }
40 sub store_shared_state {
41   my $self = shift;
42   return unless(defined($self->{shared_state}));
43   my $blob = Dumper($self->{store});
44
45   # Lock shared segment
46   # Write state and flush
47   shmwrite($self->{shared_state}, pack('i', length($blob)),
48            0, length(pack('i', 0))) || die "$!";
49   shmwrite($self->{shared_state}, $blob, length(pack('i', 0)),
50            length($blob)) || die "$!";
51   # unlock
52 }
53 sub xml_kv_dump {
54   my $info = shift;
55   my $indent = shift || 0;
56   my $rv = '';
57   while(my ($key, $value) = each %$info) {
58     $rv .= " " x $indent;
59     if(ref $value eq 'HASH') {
60       $rv .= "<$key>\n";
61       $rv .= xml_kv_dump($value, $indent + 2);
62       $rv .= " " x $indent;
63       $rv .= "</$key>\n";
64     }
65     else {
66       $value =~ s/&/&amp;/g;
67       $value =~ s/</&lt;/g;
68       $value =~ s/>/&gt;/g;
69       $value =~ s/'/&apos;/g;
70       $rv .= "<$key>$value</$key>\n";
71     }
72   }
73   return $rv;
74 }
75 sub xml_info {
76   my ($module, $service, $info) = @_;
77   my $rv = '';
78   $rv .= "  <ResmonResult module=\"$module\" service=\"$service\">\n";
79   $rv .= xml_kv_dump($info, 4);
80   $rv .= "  </ResmonResult>\n";
81   return $rv;
82 }
83 sub dump_generic {
84   my $self = shift;
85   my $dumper = shift;
86   my $rv = '';
87   while(my ($module, $services) = each %{$self->{store}}) {
88     while(my ($service, $info) = each %$services) {
89       $rv .= $dumper->($module,$service,$info);
90     }
91   }
92   return $rv;
93 }
94 sub dump_generic_module {
95   # Dumps a single module rather than all checks
96   my $self = shift;
97   my $dumper = shift;
98   my $module = shift;
99   my $rv = '';
100   my $services = $self->{store}->{$module};
101   while(my ($service, $info) = each %$services) {
102     $rv .= $dumper->($module,$service,$info);
103   }
104   return $rv;
105 }
106 sub dump_generic_state {
107   # Dumps only checks with a specific state
108   my $self = shift;
109   my $dumper = shift;
110   my $state = shift;
111   my $rv = '';
112   while(my ($module, $services) = each %{$self->{store}}) {
113     while(my ($service, $info) = each %$services) {
114       if ($info->{state} eq $state) {
115         $rv .= $dumper->($module,$service,$info);
116       }
117     }
118   }
119   return $rv;
120 }
121 sub dump_oldstyle {
122   my $self = shift;
123   my $response = $self->dump_generic(sub {
124     my($module,$service,$info) = @_;
125     return "$service($module) :: $info->{state}($info->{message})\n";
126   });
127   return $response;
128 }
129 sub dump_xml {
130   my $self = shift;
131   my $response = <<EOF
132 <?xml version="1.0" encoding="UTF-8"?>
133 <?xml-stylesheet type="text/xsl" href="/resmon.xsl"?>
134 <ResmonResults>
135 EOF
136   ;
137   $response .= $self->dump_generic(\&xml_info);
138   $response .= "</ResmonResults>\n";
139   return $response;
140 }
141 sub get_xsl() {
142   my $response = <<EOF
143 <?xml version="1.0" encoding="ISO-8859-1"?>
144 <xsl:stylesheet version="1.0"
145     xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
146 <xsl:template match="ResmonResults">
147 <html>
148 <head>
149     <title>Resmon Results</title>
150     <link rel="stylesheet" type="text/css" href="/resmon.css" />
151 </head>
152 <body>
153     <xsl:for-each select="ResmonResult">
154         <div class="item">
155                 <xsl:attribute name="class">
156                     item <xsl:value-of select="state" />
157                 </xsl:attribute>
158             <h1>
159                 <a>
160                     <xsl:attribute name="href">
161                         /<xsl:value-of select="\@module" />
162                     </xsl:attribute>
163                     <xsl:value-of select="\@module" />
164                 </a>
165                 -
166                 <a>
167                     <xsl:attribute name="href">
168                         /<xsl:value-of select="\@module"
169                             />/<xsl:value-of select="\@service" />
170                     </xsl:attribute>
171                     <xsl:value-of select="\@service" />
172                 </a>
173             </h1>
174             <h2>
175                 <xsl:value-of select="state"/>:
176                 <xsl:value-of select="message" />
177             </h2>
178             <ul>
179                 <li>Time taken for last check:
180                     <xsl:value-of select="last_runtime_seconds" /></li>
181                 <li>Last updated:
182                     <xsl:value-of select="last_update" /></li>
183             </ul>
184             <h2>Configuration</h2>
185             <table>
186                 <tr>
187                     <th>Name</th>
188                     <th>Value</th>
189                 </tr>
190                 <xsl:for-each select="configuration/*">
191                     <tr>
192                         <td><xsl:value-of select="name(.)" /></td>
193                         <td><xsl:value-of select="." /></td>
194                     </tr>
195                 </xsl:for-each>
196             </table>
197         </div>
198     </xsl:for-each>
199 </body>
200 </html>
201 </xsl:template>
202 </xsl:stylesheet>
203 EOF
204   ;
205   return $response;
206 }
207 sub get_css() {
208   my $response=<<EOF
209 body {
210     font-family: Verdana, Arial, helvetica, sans-serif;
211 }
212 h1 {
213     margin: 0;
214     font-size: 120%;
215 }
216
217 h2 {
218     margin: 0;
219     font-sizE: 110%;
220 }
221
222 .item {
223     border: 1px solid black;
224     padding: 1em;
225     margin: 2em;
226     background-color: #eeeeee;
227 }
228
229 .OK {
230     background-color: #afa;
231 }
232
233 .WARNING {
234     background-color: #ffa;
235 }
236
237 .BAD {
238     background-color: #faa;
239 }
240
241 table {
242     border: 1px solid black;
243     background-color: #eeeeee;
244     border-collapse: collapse;
245     margin: 1em;
246     font-size: 80%;
247 }
248
249 th {
250     font-size: 100%;
251     font-weight: bold;
252     background-color: black;
253     color: white;
254 }
255
256 td {
257     padding-left: 1em;
258     padding-right: 1em;
259 }
260
261 a {
262     text-decoration: none;
263 }
264 EOF
265   ;
266   return $response;
267 }
268 sub service {
269   my $self = shift;
270   my ($client, $req, $proto, $snip) = @_;
271   my $state = $self->get_shared_state();
272   if($req eq '/' or $req eq '/status') {
273     my $response .= $self->dump_xml();
274     $client->print(http_header(200, length($response), 'text/xml', $snip));
275     $client->print($response . "\r\n");
276     return;
277   } elsif($req eq '/status.txt') {
278     my $response = $self->dump_oldstyle();
279     $client->print(http_header(200, length($response), 'text/plain', $snip));
280     $client->print($response . "\r\n");
281     return;
282   } elsif($req eq '/resmon.xsl') {
283     my $response = $self->get_xsl();
284     $client->print(http_header(200, length($response), 'text/xml', $snip));
285     $client->print($response . "\r\n");
286     return;
287   } elsif($req eq '/resmon.css') {
288     my $response = $self->get_css();
289     $client->print(http_header(200, length($response), 'text/css', $snip));
290     $client->print($response . "\r\n");
291     return;
292   } elsif($req =~ /^\/([^\/]+)\/(.+)$/) {
293     if(exists($self->{store}->{$1}) &&
294         exists($self->{store}->{$1}->{$2})) {
295     my $info = $self->{store}->{$1}->{$2};
296     my $response = qq^<?xml version="1.0" encoding="UTF-8"?>\n^;
297     my $response .= qq^<?xml-stylesheet type="text/xsl" href="/resmon.xsl"?>^;
298     $response .= "<ResmonResults>\n".
299                     xml_info($1,$2,$info).
300                     "</ResmonResults>\n";
301     $client->print(http_header(200, length($response), 'text/xml', $snip));
302     $client->print( $response . "\r\n");
303     return;
304     }
305   } elsif($req =~ /^\/([^\/]+)$/) {
306     if ($1 eq "BAD" || $1 eq "OK" || $1 eq "WARNING") {
307       my $response = qq^<?xml version="1.0" encoding="UTF-8"?>\n^;
308       my $response .= qq^<?xml-stylesheet type="text/xsl" href="/resmon.xsl"?>^;
309       $response .= "<ResmonResults>\n".
310                       $self->dump_generic_state(\&xml_info,$1) .
311                       "</ResmonResults>\n";
312       $client->print(http_header(200, length($response), 'text/xml', $snip));
313       $client->print( $response . "\r\n");
314       return;
315     } elsif(exists($self->{store}->{$1})) {
316       my $response = qq^<?xml version="1.0" encoding="UTF-8"?>\n^;
317       my $response .= qq^<?xml-stylesheet type="text/xsl" href="/resmon.xsl"?>^;
318       $response .= "<ResmonResults>\n".
319                       $self->dump_generic_module(\&xml_info,$1) .
320                       "</ResmonResults>\n";
321       $client->print(http_header(200, length($response), 'text/xml', $snip));
322       $client->print( $response . "\r\n");
323       return;
324     }
325   }
326   die "Request not understood\n";
327 }
328 sub http_header {
329   my $code = shift;
330   my $len = shift;
331   my $type = shift || 'text/xml';
332   my $close_connection = shift || 1;
333   return qq^HTTP/1.0 $code OK
334 Server: resmon
335 ^ . (defined($len) ? "Content-length: $len\n" : "") .
336     (($close_connection || !$len) ? "Connection: close\n" : "") .
337 qq^Content-Type: $type; charset=utf-8
338
339 ^;
340 }
341 sub serve_http_on {
342   my $self = shift;
343   my $ip = shift;
344   my $port = shift;
345   $ip = INADDR_ANY if(!defined($ip) || $ip eq '' || $ip eq '*');
346   $port ||= 81;
347
348   my $handle = IO::Socket->new();
349   socket($handle, PF_INET, SOCK_STREAM, getprotobyname('tcp'))
350     || die "socket: $!";
351   setsockopt($handle, SOL_SOCKET, SO_REUSEADDR, pack("l", 1))
352     || die "setsockopt: $!";
353   bind($handle, sockaddr_in($port, $ip))
354     || die "bind: $!";
355   listen($handle,SOMAXCONN);
356
357   $self->{zindex} = 0;
358   if (-x "/usr/sbin/zoneadm") {
359     open(Z, "/usr/sbin/zoneadm list -p |");
360     my $firstline = <Z>;
361     close(Z);
362     ($self->{zindex}) = split /:/, $firstline, 2;
363   }
364   $self->{http_port} = $port;
365   $self->{http_ip} = $ip;
366   $self->{ftok_number} = $port * (1 + $self->{zindex});
367
368   $self->{child} = fork();
369   if($self->{child} == 0) {
370     eval {
371       $SIG{'HUP'} = 'IGNORE';
372       while(my $client = $handle->accept) {
373         my $req;
374         my $proto;
375         my $close_connection;
376         local $SIG{ALRM} = sub { die "timeout\n" };
377         eval {
378           alarm($KEEPALIVE_TIMEOUT);
379           while(<$client>) {
380             alarm($REQUEST_TIMEOUT);
381             eval {
382               s/\r\n/\n/g;
383               chomp;
384               if(!$req) {
385                 if(/^GET \s*(\S+)\s*?(?: HTTP\/(0\.9|1\.0|1\.1)\s*)?$/) {
386                   $req = $1;
387                   $proto = $2;
388                   # Protocol 1.1 and high are keep-alive by default
389                   $close_connection = ($proto <= 1.0)?1:0;
390                 }
391                 elsif(/./) {
392                   die "protocol deviations.\n";
393                 }
394               }
395               else {
396                 if(/^$/) {
397                   $self->service($client, $req, $proto, $close_connection);
398                   last if ($close_connection);
399                   alarm($KEEPALIVE_TIMEOUT);
400                   $req = undef;
401                   $proto = undef;
402                 }
403                 elsif(/^\S+\s*:\s*.{1,4096}$/) {
404                   # Valid request header... noop
405                   if(/^Connection: (\S+)/) {
406                     if(($proto <= 1.0 && lc($2) eq 'keep-alive') ||
407                        ($proto == 1.1 && lc($2) ne 'close')) {
408                       $close_connection = 0;
409                     }
410                   }
411                 }
412                 else {
413                   die "protocol deviations.\n";
414                 }
415               }
416             };
417             if($@) {
418               print $client http_header(500, 0, 'text/plain', 1);
419               print $client "$@\r\n";
420               last;
421             }
422           }
423           alarm(0);
424         };
425         alarm(0) if($@);
426         $client->close();
427       }
428     };
429     if($@) {
430       print STDERR "Error in listener: $@\n";
431     }
432     exit(0);
433   }
434   close($handle);
435   return;
436 }
437 sub open {
438   my $self = shift;
439   return 0 unless(ref $self);
440   return 1 if($self->{handle});  # Alread open
441   if($self->{file} eq '-' || !defined($self->{file})) {
442     $self->{handle_is_stdout} = 1;
443     $self->{handle} = IO::File->new_from_fd(fileno(STDOUT), "w");
444     return 1;
445   }
446   $self->{handle} = IO::File->new("> $self->{file}.swap");
447   die "open $self->{file}.swap failed: $!\n" unless($self->{handle});
448   $self->{swap_on_close} = 1; # move this to a non .swap version on close
449   chmod 0644, "$self->{file}.swap";
450
451   unless(defined($self->{shared_state})) {
452     $self->{shared_state} = shmget(IPC_PRIVATE, $SEGSIZE,
453                                    IPC_CREAT|S_IRWXU|S_IRWXG|S_IRWXO);
454     die "$0: $!" if($self->{shared_state} == -1);
455   }
456   return 1;
457 }
458 sub store {
459   my ($self, $type, $name, $info) = @_;
460   %{$self->{store}->{$type}->{$name}} = %$info;
461   $self->{store}->{$type}->{$name}->{last_update} = time;
462   $self->store_shared_state();
463   if($self->{handle}) {
464     $self->{handle}->print("$name($type) :: $info->{state}($info->{message})\n");
465   } else {
466     print "$name($type) :: $info->{state}($info->{message})\n";
467   }
468 }
469 sub purge {
470     # This removes status information for modules that are no longer loaded
471
472     # Generate list of current modules
473     my %loaded = ();
474     my ($self, $config) = @_;
475     while (my ($type, $mods) = each(%{$config->{Module}}) ) {
476         $loaded{$type} = ();
477         foreach (@$mods) {
478             $loaded{$type}{$_->{'object'}} = 1;
479         }
480     }
481
482     # Debugging
483     #while (my ($key, $value) = each(%loaded) ) {
484     #    print STDERR "$key: ";
485     #    while (my ($mod, $dummy) = each (%$value) ) {
486     #        print STDERR "$mod ";
487     #    }
488     #    print "\n";
489     #}
490
491     # Compare $self->{store} with list of loaded modules
492     while (my ($type, $value) = each (%{$self->{store}})) {
493         while (my ($name, $value2) = each (%$value)) {
494             if (!exists($loaded{$type}) || !exists($loaded{$type}{$name})) {
495                 #print STDERR "$type $name\n";
496                 delete $self->{store}->{$type}->{$name};
497                 if (scalar(keys %{$self->{store}->{$type}}) == 0) {
498                     #print STDERR "$type has no more objects, deleting\n";
499                     delete $self->{store}->{$type};
500                 }
501             }
502         }
503     }
504 }
505 sub close {
506   my $self = shift;
507   return if($self->{handle_is_stdout});
508   $self->{handle}->close() if($self->{handle});
509   $self->{handle} = undef;
510   if($self->{swap_on_close}) {
511     unlink("$self->{file}");
512     link("$self->{file}.swap", $self->{file});
513     unlink("$self->{file}.swap");
514     delete($self->{swap_on_close});
515   }
516 }
517 sub DESTROY {
518   my $self = shift;
519   my $child = $self->{child};
520   if($child) {
521     kill 15, $child;
522     sleep 1;
523     kill 9, $child if(kill 0, $child);
524     waitpid(-1,WNOHANG);
525   }
526   if(defined($self->{shared_state})) {
527     shmctl($self->{shared_state}, IPC_RMID, 0);
528   }
529 }
530 1;
Note: See TracBrowser for help on using the browser.