root/lib/Resmon/Status.pm

Revision 93f065db84146fc1f40658fbfce3abcceff75b6f, 13.0 kB (checked in by Mark Harrison <mark@omniti.com>, 5 years ago)

Add module links as well as check links to the checks

git-svn-id: https://labs.omniti.com/resmon/trunk@176 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_oldstyle {
95   my $self = shift;
96   my $response = $self->dump_generic(sub {
97     my($module,$service,$info) = @_;
98     return "$service($module) :: $info->{state}($info->{message})\n";
99   });
100   return $response;
101 }
102 sub dump_xml {
103   my $self = shift;
104   my $response = <<EOF
105 <?xml version="1.0" encoding="UTF-8"?>
106 <?xml-stylesheet type="text/xsl" href="/resmon.xsl"?>
107 <ResmonResults>
108 EOF
109   ;
110   $response .= $self->dump_generic(\&xml_info);
111   $response .= "</ResmonResults>\n";
112   return $response;
113 }
114 sub get_xsl() {
115   my $response = <<EOF
116 <?xml version="1.0" encoding="ISO-8859-1"?>
117 <xsl:stylesheet version="1.0"
118     xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
119 <xsl:template match="ResmonResults">
120 <html>
121 <head>
122     <title>Resmon Results</title>
123     <link rel="stylesheet" type="text/css" href="/resmon.css" />
124 </head>
125 <body>
126     <xsl:for-each select="ResmonResult">
127         <div class="item">
128                 <xsl:attribute name="class">
129                     item <xsl:value-of select="state" />
130                 </xsl:attribute>
131             <h1>
132                 <a>
133                     <xsl:attribute name="href">
134                         /<xsl:value-of select="\@module" />
135                     </xsl:attribute>
136                     <xsl:value-of select="\@module" />
137                 </a>
138                 -
139                 <a>
140                     <xsl:attribute name="href">
141                         /<xsl:value-of select="\@module"
142                             />/<xsl:value-of select="\@service" />
143                     </xsl:attribute>
144                     <xsl:value-of select="\@service" />
145                 </a>
146             </h1>
147             <h2>
148                 <xsl:value-of select="state"/>:
149                 <xsl:value-of select="message" />
150             </h2>
151             <ul>
152                 <li>Time taken for last check:
153                     <xsl:value-of select="last_runtime_seconds" /></li>
154                 <li>Last updated:
155                     <xsl:value-of select="last_update" /></li>
156             </ul>
157             <h2>Configuration</h2>
158             <table>
159                 <tr>
160                     <th>Name</th>
161                     <th>Value</th>
162                 </tr>
163                 <xsl:for-each select="configuration/*">
164                     <tr>
165                         <td><xsl:value-of select="name(.)" /></td>
166                         <td><xsl:value-of select="." /></td>
167                     </tr>
168                 </xsl:for-each>
169             </table>
170         </div>
171     </xsl:for-each>
172 </body>
173 </html>
174 </xsl:template>
175 </xsl:stylesheet>
176 EOF
177   ;
178   return $response;
179 }
180 sub get_css() {
181   my $response=<<EOF
182 body {
183     font-family: Verdana, Arial, helvetica, sans-serif;
184 }
185 h1 {
186     margin: 0;
187     font-size: 120%;
188 }
189
190 h2 {
191     margin: 0;
192     font-sizE: 110%;
193 }
194
195 .item {
196     border: 1px solid black;
197     padding: 1em;
198     margin: 2em;
199     background-color: #eeeeee;
200 }
201
202 .OK {
203     background-color: #afa;
204 }
205
206 .WARNING {
207     background-color: #ffa;
208 }
209
210 .BAD {
211     background-color: #faa;
212 }
213
214 table {
215     border: 1px solid black;
216     background-color: #eeeeee;
217     border-collapse: collapse;
218     margin: 1em;
219     font-size: 80%;
220 }
221
222 th {
223     font-size: 100%;
224     font-weight: bold;
225     background-color: black;
226     color: white;
227 }
228
229 td {
230     padding-left: 1em;
231     padding-right: 1em;
232 }
233
234 a {
235     text-decoration: none;
236 }
237 EOF
238   ;
239   return $response;
240 }
241 sub service {
242   my $self = shift;
243   my ($client, $req, $proto, $snip) = @_;
244   my $state = $self->get_shared_state();
245   if($req eq '/' or $req eq '/status') {
246     my $response .= $self->dump_xml();
247     $client->print(http_header(200, length($response), 'text/xml', $snip));
248     $client->print($response . "\r\n");
249     return;
250   } elsif($req eq '/status.txt') {
251     my $response = $self->dump_oldstyle();
252     $client->print(http_header(200, length($response), 'text/plain', $snip));
253     $client->print($response . "\r\n");
254     return;
255   } elsif($req eq '/resmon.xsl') {
256     my $response = $self->get_xsl();
257     $client->print(http_header(200, length($response), 'text/xml', $snip));
258     $client->print($response . "\r\n");
259     return;
260   } elsif($req eq '/resmon.css') {
261     my $response = $self->get_css();
262     $client->print(http_header(200, length($response), 'text/css', $snip));
263     $client->print($response . "\r\n");
264     return;
265   } else {
266     if($req =~ /^\/([^\/]+)\/(.+)$/) {
267       if(exists($self->{store}->{$1}) &&
268          exists($self->{store}->{$1}->{$2})) {
269         my $info = $self->{store}->{$1}->{$2};
270         my $response = qq^<?xml version="1.0" encoding="UTF-8"?>\n^;
271         my $response .= qq^<?xml-stylesheet type="text/xsl" href="/resmon.xsl"?>^;
272         $response .= "<ResmonResults>\n".
273                      xml_info($1,$2,$info).
274                      "</ResmonResults>\n";
275         $client->print(http_header(200, length($response), 'text/xml', $snip));
276         $client->print( $response . "\r\n");
277         return;
278       }
279     }
280   }
281   die "Request not understood\n";
282 }
283 sub http_header {
284   my $code = shift;
285   my $len = shift;
286   my $type = shift || 'text/xml';
287   my $close_connection = shift || 1;
288   return qq^HTTP/1.0 $code OK
289 Server: resmon
290 ^ . (defined($len) ? "Content-length: $len\n" : "") .
291     (($close_connection || !$len) ? "Connection: close\n" : "") .
292 qq^Content-Type: $type; charset=utf-8
293
294 ^;
295 }
296 sub serve_http_on {
297   my $self = shift;
298   my $ip = shift;
299   my $port = shift;
300   $ip = INADDR_ANY if(!defined($ip) || $ip eq '' || $ip eq '*');
301   $port ||= 81;
302
303   my $handle = IO::Socket->new();
304   socket($handle, PF_INET, SOCK_STREAM, getprotobyname('tcp'))
305     || die "socket: $!";
306   setsockopt($handle, SOL_SOCKET, SO_REUSEADDR, pack("l", 1))
307     || die "setsockopt: $!";
308   bind($handle, sockaddr_in($port, $ip))
309     || die "bind: $!";
310   listen($handle,SOMAXCONN);
311
312   $self->{zindex} = 0;
313   if (-x "/usr/sbin/zoneadm") {
314     open(Z, "/usr/sbin/zoneadm list -p |");
315     my $firstline = <Z>;
316     close(Z);
317     ($self->{zindex}) = split /:/, $firstline, 2;
318   }
319   $self->{http_port} = $port;
320   $self->{http_ip} = $ip;
321   $self->{ftok_number} = $port * (1 + $self->{zindex});
322
323   $self->{child} = fork();
324   if($self->{child} == 0) {
325     eval {
326       $SIG{'HUP'} = 'IGNORE';
327       while(my $client = $handle->accept) {
328         my $req;
329         my $proto;
330         my $close_connection;
331         local $SIG{ALRM} = sub { die "timeout\n" };
332         eval {
333           alarm($KEEPALIVE_TIMEOUT);
334           while(<$client>) {
335             alarm($REQUEST_TIMEOUT);
336             eval {
337               s/\r\n/\n/g;
338               chomp;
339               if(!$req) {
340                 if(/^GET \s*(\S+)\s*?(?: HTTP\/(0\.9|1\.0|1\.1)\s*)?$/) {
341                   $req = $1;
342                   $proto = $2;
343                   # Protocol 1.1 and high are keep-alive by default
344                   $close_connection = ($proto <= 1.0)?1:0;
345                 }
346                 elsif(/./) {
347                   die "protocol deviations.\n";
348                 }
349               }
350               else {
351                 if(/^$/) {
352                   $self->service($client, $req, $proto, $close_connection);
353                   last if ($close_connection);
354                   alarm($KEEPALIVE_TIMEOUT);
355                   $req = undef;
356                   $proto = undef;
357                 }
358                 elsif(/^\S+\s*:\s*.{1,4096}$/) {
359                   # Valid request header... noop
360                   if(/^Connection: (\S+)/) {
361                     if(($proto <= 1.0 && lc($2) eq 'keep-alive') ||
362                        ($proto == 1.1 && lc($2) ne 'close')) {
363                       $close_connection = 0;
364                     }
365                   }
366                 }
367                 else {
368                   die "protocol deviations.\n";
369                 }
370               }
371             };
372             if($@) {
373               print $client http_header(500, 0, 'text/plain', 1);
374               print $client "$@\r\n";
375               last;
376             }
377           }
378           alarm(0);
379         };
380         alarm(0) if($@);
381         $client->close();
382       }
383     };
384     if($@) {
385       print STDERR "Error in listener: $@\n";
386     }
387     exit(0);
388   }
389   close($handle);
390   return;
391 }
392 sub open {
393   my $self = shift;
394   return 0 unless(ref $self);
395   return 1 if($self->{handle});  # Alread open
396   if($self->{file} eq '-' || !defined($self->{file})) {
397     $self->{handle_is_stdout} = 1;
398     $self->{handle} = IO::File->new_from_fd(fileno(STDOUT), "w");
399     return 1;
400   }
401   $self->{handle} = IO::File->new("> $self->{file}.swap");
402   die "open $self->{file}.swap failed: $!\n" unless($self->{handle});
403   $self->{swap_on_close} = 1; # move this to a non .swap version on close
404   chmod 0644, "$self->{file}.swap";
405
406   unless(defined($self->{shared_state})) {
407     $self->{shared_state} = shmget(IPC_PRIVATE, $SEGSIZE,
408                                    IPC_CREAT|S_IRWXU|S_IRWXG|S_IRWXO);
409     die "$0: $!" if($self->{shared_state} == -1);
410   }
411   return 1;
412 }
413 sub store {
414   my ($self, $type, $name, $info) = @_;
415   %{$self->{store}->{$type}->{$name}} = %$info;
416   $self->{store}->{$type}->{$name}->{last_update} = time;
417   $self->store_shared_state();
418   if($self->{handle}) {
419     $self->{handle}->print("$name($type) :: $info->{state}($info->{message})\n");
420   } else {
421     print "$name($type) :: $info->{state}($info->{message})\n";
422   }
423 }
424 sub purge {
425     # This removes status information for modules that are no longer loaded
426
427     # Generate list of current modules
428     my %loaded = ();
429     my ($self, $config) = @_;
430     while (my ($type, $mods) = each(%{$config->{Module}}) ) {
431         $loaded{$type} = ();
432         foreach (@$mods) {
433             $loaded{$type}{$_->{'object'}} = 1;
434         }
435     }
436
437     # Debugging
438     #while (my ($key, $value) = each(%loaded) ) {
439     #    print STDERR "$key: ";
440     #    while (my ($mod, $dummy) = each (%$value) ) {
441     #        print STDERR "$mod ";
442     #    }
443     #    print "\n";
444     #}
445
446     # Compare $self->{store} with list of loaded modules
447     while (my ($type, $value) = each (%{$self->{store}})) {
448         while (my ($name, $value2) = each (%$value)) {
449             if (!exists($loaded{$type}) || !exists($loaded{$type}{$name})) {
450                 #print STDERR "$type $name\n";
451                 delete $self->{store}->{$type}->{$name};
452                 if (scalar(keys %{$self->{store}->{$type}}) == 0) {
453                     #print STDERR "$type has no more objects, deleting\n";
454                     delete $self->{store}->{$type};
455                 }
456             }
457         }
458     }
459 }
460 sub close {
461   my $self = shift;
462   return if($self->{handle_is_stdout});
463   $self->{handle}->close() if($self->{handle});
464   $self->{handle} = undef;
465   if($self->{swap_on_close}) {
466     unlink("$self->{file}");
467     link("$self->{file}.swap", $self->{file});
468     unlink("$self->{file}.swap");
469     delete($self->{swap_on_close});
470   }
471 }
472 sub DESTROY {
473   my $self = shift;
474   my $child = $self->{child};
475   if($child) {
476     kill 15, $child;
477     sleep 1;
478     kill 9, $child if(kill 0, $child);
479     waitpid(-1,WNOHANG);
480   }
481   if(defined($self->{shared_state})) {
482     shmctl($self->{shared_state}, IPC_RMID, 0);
483   }
484 }
485 1;
Note: See TracBrowser for help on using the browser.