root/lib/Resmon/Status.pm

Revision e901fb68718fa7070a009edca156245ce82cf656, 8.3 kB (checked in by Brian Holcomb <holcomb@omniti.com>, 7 years ago)

fix shmid=0 problem

git-svn-id: https://labs.omniti.com/resmon/trunk@45 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 <ResmonResults>
103 EOF
104   ;
105   $response .= $self->dump_generic(\&xml_info);
106   $response .= "</ResmonResults>\n";
107   return $response;
108 }
109 sub service {
110   my $self = shift;
111   my ($client, $req, $proto, $snip) = @_;
112   my $state = $self->get_shared_state();
113   if($req eq '/' or $req eq '/status') {
114     my $response .= $self->dump_xml();
115     $client->print(http_header(200, length($response), 'text/xml', $snip));
116     $client->print($response . "\r\n");
117     return;
118   } elsif($req eq '/status.txt') {
119     my $response = $self->dump_oldstyle();
120     $client->print(http_header(200, length($response), 'text/plain', $snip));
121     $client->print($response . "\r\n");
122     return;
123   } else {
124     if($req =~ /^\/([^\/]+)\/(.+)$/) {
125       if(exists($self->{store}->{$1}) &&
126          exists($self->{store}->{$1}->{$2})) {
127         my $info = $self->{store}->{$1}->{$2};
128         my $response = qq^<?xml version="1.0" encoding="UTF-8"?>\n^;
129         $response .= "<ResmonResults>\n".
130                      xml_info($1,$2,$info).
131                      "</ResmonRestults>\n";
132         $client->print(http_header(200, length($response), 'text/xml', $snip));
133         $client->print( $response . "\r\n");
134         return;
135       }
136     }
137   }
138   die "Request not understood\n";
139 }
140 sub http_header {
141   my $code = shift;
142   my $len = shift;
143   my $type = shift || 'text/xml';
144   my $close_connection = shift || 1;
145   return qq^HTTP/1.0 $code OK
146 Server: resmon
147 ^ . (defined($len) ? "Content-length: $len\n" : "") .
148     (($close_connection || !$len) ? "Connection: close\n" : "") .
149 qq^Content-Type: $type; charset=utf-8
150
151 ^;
152 }
153 sub serve_http_on {
154   my $self = shift;
155   my $ip = shift;
156   my $port = shift;
157   $ip = INADDR_ANY if(!defined($ip) || $ip eq '' || $ip eq '*');
158   $port ||= 81;
159
160   my $handle = IO::Socket->new();
161   socket($handle, PF_INET, SOCK_STREAM, getprotobyname('tcp'))
162     || die "socket: $!";
163   setsockopt($handle, SOL_SOCKET, SO_REUSEADDR, pack("l", 1))
164     || die "setsockopt: $!";
165   bind($handle, sockaddr_in($port, $ip))
166     || die "bind: $!";
167   listen($handle,SOMAXCONN);
168
169   $self->{zindex} = 0;
170   if (-x "/usr/sbin/zoneadm") {
171     open(Z, "/usr/sbin/zoneadm list -p |");
172     my $firstline = <Z>;
173     close(Z);
174     ($self->{zindex}) = split /:/, $firstline, 2;
175   }
176   $self->{http_port} = $port;
177   $self->{http_ip} = $ip;
178   $self->{ftok_number} = $port * (1 + $self->{zindex});
179
180   $self->{child} = fork();
181   if($self->{child} == 0) {
182     eval {
183       while(my $client = $handle->accept) {
184         my $req;
185         my $proto;
186         my $close_connection;
187         local $SIG{ALRM} = sub { die "timeout\n" };
188         eval {
189           alarm($KEEPALIVE_TIMEOUT);
190           while(<$client>) {
191             alarm($REQUEST_TIMEOUT);
192             eval {
193               s/\r\n/\n/g;
194               chomp;
195               if(!$req) {
196                 if(/^GET \s*(\S+)\s*?(?: HTTP\/(0\.9|1\.0|1\.1)\s*)?$/) {
197                   $req = $1;
198                   $proto = $2;
199                   # Protocol 1.1 and high are keep-alive by default
200                   $close_connection = ($proto <= 1.0)?1:0;
201                 }
202                 elsif(/./) {
203                   die "protocol deviations.\n";
204                 }
205               }
206               else {
207                 if(/^$/) {
208                   $self->service($client, $req, $proto, $close_connection);
209                   last if ($close_connection);
210                   alarm($KEEPALIVE_TIMEOUT);
211                   $req = undef;
212                   $proto = undef;
213                 }
214                 elsif(/^\S+\s*:\s*.{1,4096}$/) {
215                   # Valid request header... noop
216                   if(/^Connection: (\S+)/) {
217                     if(($proto <= 1.0 && lc($2) eq 'keep-alive') ||
218                        ($proto == 1.1 && lc($2) ne 'close')) {
219                       $close_connection = 0;
220                     }
221                   }
222                 }
223                 else {
224                   die "protocol deviations.\n";
225                 }
226               }
227             };
228             if($@) {
229               print $client http_header(500, 0, 'text/plain', 1);
230               print $client "$@\r\n";
231               last;
232             }
233           }
234           alarm(0);
235         };
236         alarm(0) if($@);
237         $client->close();
238       }
239     };
240     if($@) {
241       print STDERR "Error in listener: $@\n";
242     }
243     exit(0);
244   }
245   close($handle);
246   return;
247 }
248 sub open {
249   my $self = shift;
250   return 0 unless(ref $self);
251   return 1 if($self->{handle});  # Alread open
252   if($self->{file} eq '-' || !defined($self->{file})) {
253     $self->{handle_is_stdout} = 1;
254     $self->{handle} = IO::File->new_from_fd(fileno(STDOUT), "w");
255     return 1;
256   }
257   $self->{handle} = IO::File->new("> $self->{file}.swap");
258   die "open $self->{file}.swap failed: $!\n" unless($self->{handle});
259   $self->{swap_on_close} = 1; # move this to a non .swap version on close
260   chmod 0644, "$self->{file}.swap";
261
262   unless(defined($self->{shared_state})) {
263     $self->{shared_state} = shmget(IPC_PRIVATE, $SEGSIZE,
264                                    IPC_CREAT|S_IRWXU|S_IRWXG|S_IRWXO);
265     die "$0: $!" if($self->{shared_state} == -1);
266   }
267   return 1;
268 }
269 sub store {
270   my ($self, $type, $name, $info) = @_;
271   %{$self->{store}->{$type}->{$name}} = %$info;
272   $self->{store}->{$type}->{$name}->{last_update} = time;
273   $self->store_shared_state();
274   if($self->{handle}) {
275     $self->{handle}->print("$name($type) :: $info->{state}($info->{message})\n");
276   } else {
277     print "$name($type) :: $info->{state}($info->{message})\n";
278   }
279 }
280 sub close {
281   my $self = shift;
282   return if($self->{handle_is_stdout});
283   $self->{handle}->close() if($self->{handle});
284   $self->{handle} = undef;
285   if($self->{swap_on_close}) {
286     unlink("$self->{file}");
287     link("$self->{file}.swap", $self->{file});
288     unlink("$self->{file}.swap");
289     delete($self->{swap_on_close});
290   }
291 }
292 sub DESTROY {
293   my $self = shift;
294   my $child = $self->{child};
295   if($child) {
296     kill 15, $child;
297     sleep 1;
298     kill 9, $child if(kill 0, $child);
299     waitpid(-1,WNOHANG);
300   }
301   if(defined($self->{shared_state})) {
302     shmctl($self->{shared_state}, IPC_RMID, 0);
303   }
304 }
305 1;
Note: See TracBrowser for help on using the browser.