root/lib/Resmon/Status.pm

Revision 015f655aca1fef5ad427de12d7cad26a242c605e, 11.2 kB (checked in by Mark Harrison <mark@omniti.com>, 11 years ago)

And add the stylesheet to the single resmon checks too.

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