root/lib/Resmon/Status.pm

Revision 627a96772d62dfc3c4d65c35f81a7f266d5a4719, 6.7 kB (checked in by Theo Schlossnagle <jesus@omniti.com>, 11 years ago)

make this more extensible and make Resmon auto 'use lib' based off \-tcsh

git-svn-id: https://labs.omniti.com/resmon/trunk@29 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_CREAT IPC_RMID ftok S_IRWXU S_IRWXG S_IRWXO/;
11 use Data::Dumper;
12
13 my $SEGSIZE = 1024*256;
14 my $statusfile;
15 sub new {
16   my $class = shift;
17   my $file = shift;
18   return $statusfile if($statusfile);
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($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($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_info {
54   my ($module, $service, $info) = @_;
55   my $rv = '';
56   $rv .= "  <ResmonResult module=\"$module\" service=\"$service\">\n";
57   while(my ($key, $value) = each %$info) {
58     $rv .= "    <$key>$value</$key>\n";
59   }
60   $rv .= "  </ResmonResult>\n";
61   return $rv;
62 }
63 sub dump_generic {
64   my $self = shift;
65   my $dumper = shift;
66   my $rv = '';
67   while(my ($module, $services) = each %{$self->{store}}) {
68     while(my ($service, $info) = each %$services) {
69       $rv .= $dumper->($module,$service,$info);
70     }
71   }
72   return $rv;
73 }
74 sub dump_oldstyle {
75   my $self = shift;
76   my $response = $self->dump_generic(sub {
77     my($module,$service,$info) = @_;
78     return "$service($module) :: $info->{state}($info->{message})\n";
79   });
80   return $response;
81 }
82 sub dump_xml {
83   my $self = shift;
84   my $response = <<EOF
85 <?xml version="1.0" encoding="UTF-8"?>
86 <ResmonResults>
87 EOF
88   ;
89   $response .= $self->dump_generic(\&xml_info);
90   $response .= "</ResmonResults>\n";
91   return $response;
92 }
93 sub service {
94   my $self = shift;
95   my ($client, $req, $proto) = @_;
96   my $state = $self->get_shared_state();
97   if($req eq '/' or $req eq '/status') {
98     my $response .= $self->dump_xml();
99     $client->print(http_header(200, $proto?length($response):0));
100     $client->print($response . "\r\n");
101     return;
102   } elsif($req eq '/status.txt') {
103     my $response = $self->dump_oldstyle();
104     $client->print(http_header(200, $proto?length($response):0, 'text/plain'));
105     $client->print($response . "\r\n");
106     return;
107   } else {
108     if($req =~ /^\/([^\/]+)\/(.+)$/) {
109       if(exists($self->{store}->{$1}) &&
110          exists($self->{store}->{$1}->{$2})) {
111         my $info = $self->{store}->{$1}->{$2};
112         my $response = qq^<?xml version="1.0" encoding="UTF-8"?>\n^;
113         $response .= "<ResmonResults>\n".
114                      xml_info($1,$2,$info).
115                      "</ResmonRestults>\n";
116         $client->print(http_header(200, $proto?length($response):0));
117         $client->print( $response . "\r\n");
118         return;
119       }
120     }
121   }
122   die "Request not understood\n";
123 }
124 sub http_header {
125   my $code = shift;
126   my $len = shift;
127   my $type = shift || 'text/xml';
128   return qq^HTTP/1.0 $code OK
129 Server: resmon
130 ^ . (defined($len) ? "Content-length: $len" : "Connection: close") . q^
131 Content-Type: text/plain; charset=utf-8
132
133 ^;
134 }
135 sub serve_http_on {
136   my $self = shift;
137   my $ip = shift;
138   my $port = shift;
139   $ip = INADDR_ANY if(!defined($ip) || $ip eq '' || $ip eq '*');
140   $port ||= 81;
141
142   my $handle = IO::Socket->new();
143   socket($handle, PF_INET, SOCK_STREAM, getprotobyname('tcp'))
144     || die "socket: $!";
145   setsockopt($handle, SOL_SOCKET, SO_REUSEADDR, pack("l", 1))
146     || die "setsockopt: $!";
147   bind($handle, sockaddr_in($port, $ip))
148     || die "bind: $!";
149   listen($handle,SOMAXCONN);
150
151   $self->{http_port} = $port;
152   $self->{http_ip} = $ip;
153
154   $self->{child} = fork();
155   if($self->{child} == 0) {
156     eval {
157       while(my $client = $handle->accept) {
158         my $req;
159         my $proto;
160         while(<$client>) {
161           eval {
162             s/\r\n/\n/g;
163             chomp;
164             if(!$req) {
165               if(/^GET \s*(\S+)\s*?(?: HTTP\/(0\.9|1\.0|1\.1)\s*)?$/) {
166                 $req = $1;
167                 $proto = $2;
168               }
169               else {
170                 die "protocol deviations.\n";
171               }
172             }
173             elsif(/^$/) {
174               $self->service($client, $req, $proto);
175               last unless ($proto);
176               $req = undef;
177               $proto = undef;
178             }
179             elsif(/^\S+\s*:\s*.{1,4096}$/) {
180               # Valid request header... noop
181             }
182             else {
183               die "protocol deviations.\n";
184             }
185           };
186           if($@) {
187             print $client http_header(500, 0, 'text/plain');
188             print $client "$@\r\n";
189             last;
190           }
191         }
192         $client->close();
193       }
194     };
195     if($@) {
196       print STDERR "Error in listener: $@\n";
197     }
198     exit(0);
199   }
200   close($handle);
201   return;
202 }
203 sub open {
204   my $self = shift;
205   return 0 unless(ref $self);
206   return 1 if($self->{handle});  # Alread open
207   if($self->{file} eq '-' || !defined($self->{file})) {
208     $self->{handle} = IO::File->new_from_fd(fileno(STDOUT), "w");
209     return 1;
210   }
211   $self->{handle} = IO::File->new("> $self->{file}.swap");
212   die "open $self->{file}.swap failed: $!\n" unless($self->{handle});
213   $self->{swap_on_close} = 1; # move this to a non .swap version on close
214   chmod 0644, "$statusfile.swap";
215
216   unless($self->{shared_state}) {
217     my $id = ftok(__FILE__,$self->{http_port});
218     $self->{shared_state} = shmget($id, $SEGSIZE,
219                                    IPC_CREAT|S_IRWXU|S_IRWXG|S_IRWXO)
220       || die "$0: $!";
221   }
222   return 1;
223 }
224 sub store {
225   my ($self, $type, $name, $info) = @_;
226   %{$self->{store}->{$type}->{$name}} = %$info;
227   $self->{store}->{$type}->{$name}->{last_update} = time;
228   $self->store_shared_state();
229   if($self->{handle}) {
230     $self->{handle}->print("$name($type) :: $info->{state}($info->{message})\n");
231   } else {
232     print "$name($type) :: $info->{state}($info->{message})\n";
233   }
234 }
235 sub close {
236   my $self = shift;
237   $self->{handle}->close() if($self->{handle});
238   $self->{handle} = undef;
239   if($self->{swap_on_close}) {
240     link("$self->{file}.swap", $self->{file});
241     unlink("$self->{file}.swap");
242     delete($self->{swap_on_close});
243   }
244 }
245 sub DESTROY {
246   my $self = shift;
247   my $child = $self->{child};
248   if($child) {
249     kill 15, $child;
250     sleep 1;
251     kill 9, $child if(kill 0, $child);
252     waitpid(-1,WNOHANG);
253   }
254   if($self->{shared_state}) {
255     shmctl($self->{shared_state}, IPC_RMID, 0);
256   }
257 }
258 1;
Note: See TracBrowser for help on using the browser.