root/lib/Resmon/Status.pm

Revision 6327a1000f3cc40318a329e2b0f749c6b691de88, 15.5 kB (checked in by Mark Harrison <mark@omniti.com>, 9 years ago)

Display long configuration boxes better

git-svn-id: https://labs.omniti.com/resmon/trunk@184 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     <ul class="navbar">
154         <li><a href="/">List all checks</a></li>
155         <li><a href="/BAD">List all checks that are BAD</a></li>
156         <li><a href="/WARNING">List all checks that are WARNING</a></li>
157         <li><a href="/OK">List all checks that are OK</a></li>
158     </ul>
159     <xsl:for-each select="ResmonResult">
160         <div class="item">
161                 <xsl:attribute name="class">
162                     item <xsl:value-of select="state" />
163                 </xsl:attribute>
164             <ul class="info">
165                 <li>Time taken for last check:
166                     <xsl:value-of select="last_runtime_seconds" /></li>
167                 <li>Last updated:
168                     <xsl:value-of select="last_update" /></li>
169             </ul>
170             <h1>
171                 <a>
172                     <xsl:attribute name="href">
173                         /<xsl:value-of select="\@module" />
174                     </xsl:attribute>
175                     <xsl:value-of select="\@module" />
176                 </a>
177                 -
178                 <a>
179                     <xsl:attribute name="href">
180                         /<xsl:value-of select="\@module"
181                             />/<xsl:value-of select="\@service" />
182                     </xsl:attribute>
183                     <xsl:value-of select="\@service" />
184                 </a>
185             </h1>
186             <h2>
187                 <xsl:value-of select="state"/>:
188                 <xsl:value-of select="message" />
189             </h2>
190             <a class="config" href="#">
191                 Hover to view configuration...
192                 <table>
193                     <tr>
194                         <th>Name</th>
195                         <th>Value</th>
196                     </tr>
197                     <xsl:for-each select="configuration/*">
198                         <tr>
199                             <td><xsl:value-of select="name(.)" /></td>
200                             <td><xsl:value-of select="." /></td>
201                         </tr>
202                     </xsl:for-each>
203                 </table>
204             </a>
205         </div>
206     </xsl:for-each>
207 </body>
208 </html>
209 </xsl:template>
210 </xsl:stylesheet>
211 EOF
212   ;
213   return $response;
214 }
215 sub get_css() {
216   my $response=<<EOF
217 body {
218     font-family: Verdana, Arial, helvetica, sans-serif;
219 }
220 h1 {
221     margin: 0;
222     font-size: 120%;
223 }
224
225 h2 {
226     margin: 0;
227     font-sizE: 110%;
228 }
229
230 .item {
231     border: 1px solid black;
232     padding: 1em;
233     margin: 2em;
234     background-color: #eeeeee;
235 }
236
237 a.config {
238     color: black;
239 }
240
241 a.config:visited {
242     color: black;
243 }
244
245 a.config table {
246     display: none
247 }
248
249 a.config:hover table {
250     display: block;
251     position: fixed;
252     top: 1em;
253     right: 1em;
254     max-width: 95%;
255     overflow: hidden;
256 }
257
258 .info {
259     float: right;
260     font-size: 80%;
261     padding: 0;
262     margin: 0;
263 }
264
265 .OK {
266     background-color: #afa;
267 }
268
269 .WARNING {
270     background-color: #ffa;
271 }
272
273 .BAD {
274     background-color: #faa;
275 }
276
277 table {
278     border: 1px solid black;
279     background-color: #eeeeee;
280     border-collapse: collapse;
281     margin: 1em;
282     font-size: 80%;
283 }
284
285 th {
286     font-size: 100%;
287     font-weight: bold;
288     background-color: black;
289     color: white;
290 }
291
292 td {
293     padding-left: 1em;
294     padding-right: 1em;
295 }
296
297 a {
298     text-decoration: none;
299 }
300
301 ul.navbar {
302     list-style: none;
303     font-size: 80%;
304 }
305 ul.navbar li {
306     display: inline;
307     padding-left: 1em;
308     padding-right: 1em;
309     margin-right: -1px;
310     border-left: 1px solid black;
311     border-right: 1px solid black;
312 }
313 EOF
314   ;
315   return $response;
316 }
317 sub service {
318   my $self = shift;
319   my ($client, $req, $proto, $snip) = @_;
320   my $state = $self->get_shared_state();
321   if($req eq '/' or $req eq '/status') {
322     my $response .= $self->dump_xml();
323     $client->print(http_header(200, length($response), 'text/xml', $snip));
324     $client->print($response . "\r\n");
325     return;
326   } elsif($req eq '/status.txt') {
327     my $response = $self->dump_oldstyle();
328     $client->print(http_header(200, length($response), 'text/plain', $snip));
329     $client->print($response . "\r\n");
330     return;
331   } elsif($req eq '/resmon.xsl') {
332     my $response = $self->get_xsl();
333     $client->print(http_header(200, length($response), 'text/xml', $snip));
334     $client->print($response . "\r\n");
335     return;
336   } elsif($req eq '/resmon.css') {
337     my $response = $self->get_css();
338     $client->print(http_header(200, length($response), 'text/css', $snip));
339     $client->print($response . "\r\n");
340     return;
341   } elsif($req =~ /^\/([^\/]+)\/(.+)$/) {
342     if(exists($self->{store}->{$1}) &&
343         exists($self->{store}->{$1}->{$2})) {
344     my $info = $self->{store}->{$1}->{$2};
345     my $response = qq^<?xml version="1.0" encoding="UTF-8"?>\n^;
346     my $response .= qq^<?xml-stylesheet type="text/xsl" href="/resmon.xsl"?>^;
347     $response .= "<ResmonResults>\n".
348                     xml_info($1,$2,$info).
349                     "</ResmonResults>\n";
350     $client->print(http_header(200, length($response), 'text/xml', $snip));
351     $client->print( $response . "\r\n");
352     return;
353     }
354   } elsif($req =~ /^\/([^\/]+)$/) {
355     if ($1 eq "BAD" || $1 eq "OK" || $1 eq "WARNING") {
356       my $response = qq^<?xml version="1.0" encoding="UTF-8"?>\n^;
357       my $response .= qq^<?xml-stylesheet type="text/xsl" href="/resmon.xsl"?>^;
358       $response .= "<ResmonResults>\n".
359                       $self->dump_generic_state(\&xml_info,$1) .
360                       "</ResmonResults>\n";
361       $client->print(http_header(200, length($response), 'text/xml', $snip));
362       $client->print( $response . "\r\n");
363       return;
364     } elsif(exists($self->{store}->{$1})) {
365       my $response = qq^<?xml version="1.0" encoding="UTF-8"?>\n^;
366       my $response .= qq^<?xml-stylesheet type="text/xsl" href="/resmon.xsl"?>^;
367       $response .= "<ResmonResults>\n".
368                       $self->dump_generic_module(\&xml_info,$1) .
369                       "</ResmonResults>\n";
370       $client->print(http_header(200, length($response), 'text/xml', $snip));
371       $client->print( $response . "\r\n");
372       return;
373     }
374   }
375   die "Request not understood\n";
376 }
377 sub http_header {
378   my $code = shift;
379   my $len = shift;
380   my $type = shift || 'text/xml';
381   my $close_connection = shift || 1;
382   return qq^HTTP/1.0 $code OK
383 Server: resmon
384 ^ . (defined($len) ? "Content-length: $len\n" : "") .
385     (($close_connection || !$len) ? "Connection: close\n" : "") .
386 qq^Content-Type: $type; charset=utf-8
387
388 ^;
389 }
390 sub serve_http_on {
391   my $self = shift;
392   my $ip = shift;
393   my $port = shift;
394   $ip = INADDR_ANY if(!defined($ip) || $ip eq '' || $ip eq '*');
395   $port ||= 81;
396
397   my $handle = IO::Socket->new();
398   socket($handle, PF_INET, SOCK_STREAM, getprotobyname('tcp'))
399     || die "socket: $!";
400   setsockopt($handle, SOL_SOCKET, SO_REUSEADDR, pack("l", 1))
401     || die "setsockopt: $!";
402   bind($handle, sockaddr_in($port, $ip))
403     || die "bind: $!";
404   listen($handle,SOMAXCONN);
405
406   $self->{zindex} = 0;
407   if (-x "/usr/sbin/zoneadm") {
408     open(Z, "/usr/sbin/zoneadm list -p |");
409     my $firstline = <Z>;
410     close(Z);
411     ($self->{zindex}) = split /:/, $firstline, 2;
412   }
413   $self->{http_port} = $port;
414   $self->{http_ip} = $ip;
415   $self->{ftok_number} = $port * (1 + $self->{zindex});
416
417   $self->{child} = fork();
418   if($self->{child} == 0) {
419     eval {
420       $SIG{'HUP'} = 'IGNORE';
421       while(my $client = $handle->accept) {
422         my $req;
423         my $proto;
424         my $close_connection;
425         local $SIG{ALRM} = sub { die "timeout\n" };
426         eval {
427           alarm($KEEPALIVE_TIMEOUT);
428           while(<$client>) {
429             alarm($REQUEST_TIMEOUT);
430             eval {
431               s/\r\n/\n/g;
432               chomp;
433               if(!$req) {
434                 if(/^GET \s*(\S+)\s*?(?: HTTP\/(0\.9|1\.0|1\.1)\s*)?$/) {
435                   $req = $1;
436                   $proto = $2;
437                   # Protocol 1.1 and high are keep-alive by default
438                   $close_connection = ($proto <= 1.0)?1:0;
439                 }
440                 elsif(/./) {
441                   die "protocol deviations.\n";
442                 }
443               }
444               else {
445                 if(/^$/) {
446                   $self->service($client, $req, $proto, $close_connection);
447                   last if ($close_connection);
448                   alarm($KEEPALIVE_TIMEOUT);
449                   $req = undef;
450                   $proto = undef;
451                 }
452                 elsif(/^\S+\s*:\s*.{1,4096}$/) {
453                   # Valid request header... noop
454                   if(/^Connection: (\S+)/) {
455                     if(($proto <= 1.0 && lc($2) eq 'keep-alive') ||
456                        ($proto == 1.1 && lc($2) ne 'close')) {
457                       $close_connection = 0;
458                     }
459                   }
460                 }
461                 else {
462                   die "protocol deviations.\n";
463                 }
464               }
465             };
466             if($@) {
467               print $client http_header(500, 0, 'text/plain', 1);
468               print $client "$@\r\n";
469               last;
470             }
471           }
472           alarm(0);
473         };
474         alarm(0) if($@);
475         $client->close();
476       }
477     };
478     if($@) {
479       print STDERR "Error in listener: $@\n";
480     }
481     exit(0);
482   }
483   close($handle);
484   return;
485 }
486 sub open {
487   my $self = shift;
488   return 0 unless(ref $self);
489   return 1 if($self->{handle});  # Alread open
490   if($self->{file} eq '-' || !defined($self->{file})) {
491     $self->{handle_is_stdout} = 1;
492     $self->{handle} = IO::File->new_from_fd(fileno(STDOUT), "w");
493     return 1;
494   }
495   $self->{handle} = IO::File->new("> $self->{file}.swap");
496   die "open $self->{file}.swap failed: $!\n" unless($self->{handle});
497   $self->{swap_on_close} = 1; # move this to a non .swap version on close
498   chmod 0644, "$self->{file}.swap";
499
500   unless(defined($self->{shared_state})) {
501     $self->{shared_state} = shmget(IPC_PRIVATE, $SEGSIZE,
502                                    IPC_CREAT|S_IRWXU|S_IRWXG|S_IRWXO);
503     die "$0: $!" if($self->{shared_state} == -1);
504   }
505   return 1;
506 }
507 sub store {
508   my ($self, $type, $name, $info) = @_;
509   %{$self->{store}->{$type}->{$name}} = %$info;
510   $self->{store}->{$type}->{$name}->{last_update} = time;
511   $self->store_shared_state();
512   if($self->{handle}) {
513     $self->{handle}->print("$name($type) :: $info->{state}($info->{message})\n");
514   } else {
515     print "$name($type) :: $info->{state}($info->{message})\n";
516   }
517 }
518 sub purge {
519     # This removes status information for modules that are no longer loaded
520
521     # Generate list of current modules
522     my %loaded = ();
523     my ($self, $config) = @_;
524     while (my ($type, $mods) = each(%{$config->{Module}}) ) {
525         $loaded{$type} = ();
526         foreach (@$mods) {
527             $loaded{$type}{$_->{'object'}} = 1;
528         }
529     }
530
531     # Debugging
532     #while (my ($key, $value) = each(%loaded) ) {
533     #    print STDERR "$key: ";
534     #    while (my ($mod, $dummy) = each (%$value) ) {
535     #        print STDERR "$mod ";
536     #    }
537     #    print "\n";
538     #}
539
540     # Compare $self->{store} with list of loaded modules
541     while (my ($type, $value) = each (%{$self->{store}})) {
542         while (my ($name, $value2) = each (%$value)) {
543             if (!exists($loaded{$type}) || !exists($loaded{$type}{$name})) {
544                 #print STDERR "$type $name\n";
545                 delete $self->{store}->{$type}->{$name};
546                 if (scalar(keys %{$self->{store}->{$type}}) == 0) {
547                     #print STDERR "$type has no more objects, deleting\n";
548                     delete $self->{store}->{$type};
549                 }
550             }
551         }
552     }
553 }
554 sub close {
555   my $self = shift;
556   return if($self->{handle_is_stdout});
557   $self->{handle}->close() if($self->{handle});
558   $self->{handle} = undef;
559   if($self->{swap_on_close}) {
560     unlink("$self->{file}");
561     link("$self->{file}.swap", $self->{file});
562     unlink("$self->{file}.swap");
563     delete($self->{swap_on_close});
564   }
565 }
566 sub DESTROY {
567   my $self = shift;
568   my $child = $self->{child};
569   if($child) {
570     kill 15, $child;
571     sleep 1;
572     kill 9, $child if(kill 0, $child);
573     waitpid(-1,WNOHANG);
574   }
575   if(defined($self->{shared_state})) {
576     shmctl($self->{shared_state}, IPC_RMID, 0);
577   }
578 }
579 1;
Note: See TracBrowser for help on using the browser.