root/lib/Resmon/Status.pm

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

Change how metrics/types are done. Use a hash instead of an array, and allow
the returning of custom xml values (i.e. <metric>) from a module. Updated
resmon module to use the new method.

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