root/lib/Resmon/Status.pm

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

Make the size of the resmon blocks much smaller

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