Changeset c43001e8e3ac31dae3bfc11c22a72d78347fda07
- Timestamp:
- 03/22/07 19:53:21
(11 years ago)
- Author:
- Theo Schlossnagle <jesus@omniti.com>
- git-committer:
- Theo Schlossnagle <jesus@omniti.com> 1174593201 +0000
- git-parent:
[e5d09e81c6b6816e904b241f852e542e067c2d4c]
- git-author:
- Theo Schlossnagle <jesus@omniti.com> 1174593201 +0000
- Message:
working web server and shared updated state
git-svn-id: https://labs.omniti.com/resmon/trunk@27 8c0face9-b7db-6ec6-c4b3-d5f7145c7d55
-
Files:
-
Legend:
- Unmodified
- Added
- Removed
- Modified
- Copied
- Moved
r3596d9c |
rc43001e |
|
37 | 37 | next; |
---|
38 | 38 | } |
---|
39 | | elsif(/\S*LIB\s+(\S+)\s*;?\s*/) { |
---|
| 39 | elsif(/\S*LIB\s+(\S+)\s*;\s*/) { |
---|
40 | 40 | eval "use lib '$1';"; |
---|
41 | 41 | next; |
---|
42 | 42 | } |
---|
43 | | elsif(/\s*INTERVAL\s+(\d+)\s*;?\s*/) { |
---|
| 43 | elsif(/\s*INTERVAL\s+(\d+)\s*;\s*/) { |
---|
44 | 44 | $self->{interval} = $1; |
---|
45 | 45 | next; |
---|
46 | 46 | } |
---|
47 | | elsif(/\s*STATUSFILE\s+(\S+)\s*;?\s*/) { |
---|
| 47 | elsif(/\s*STATUSFILE\s+(\S+)\s*;\s*/) { |
---|
48 | 48 | $self->{statusfile} = $1; |
---|
49 | 49 | next; |
---|
re5d09e8 |
rc43001e |
|
32 | 32 | shmread($self->{shared_state}, $blob, length(pack('i', 0)), $len); |
---|
33 | 33 | # unlock |
---|
34 | | die "LEN: $len [$blob]\n"; |
---|
35 | | $self->{store} = eval $blob; |
---|
| 34 | my $VAR1; |
---|
| 35 | eval $blob; |
---|
| 36 | die $@ if ($@); |
---|
| 37 | $self->{store} = $VAR1; |
---|
36 | 38 | return $self->{store}; |
---|
37 | 39 | } |
---|
… | … | |
43 | 45 | # Lock shared segment |
---|
44 | 46 | # Write state and flush |
---|
45 | | shmwrite($self->{shared_state}, pack("l", length($blob)), |
---|
| 47 | shmwrite($self->{shared_state}, pack('i', length($blob)), |
---|
46 | 48 | 0, length(pack('i', 0))) || die "$!"; |
---|
47 | 49 | shmwrite($self->{shared_state}, $blob, length(pack('i', 0)), |
---|
48 | | length($blob) - length(pack('i', 0))) || die "$!"; |
---|
| 50 | length($blob)) || die "$!"; |
---|
49 | 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; |
---|
50 | 92 | } |
---|
51 | 93 | sub service { |
---|
… | … | |
53 | 95 | my ($client, $req, $proto) = @_; |
---|
54 | 96 | my $state = $self->get_shared_state(); |
---|
55 | | if($req eq '/' or $req eq '/status' or $req eq '/status.txt') { |
---|
56 | | my $response = Dumper($self->{store}); |
---|
57 | | print $client http_header(200, length($response)) if($proto); |
---|
| 97 | if($req eq '/' or $req eq '/status') { |
---|
| 98 | my $response .= $self->dump_xml(); |
---|
| 99 | print $client http_header(200, $proto?length($response):0); |
---|
58 | 100 | print $client $response . "\r\n"; |
---|
59 | | } |
---|
| 101 | return; |
---|
| 102 | } elsif($req eq '/status.txt') { |
---|
| 103 | my $response = $self->dump_oldstyle(); |
---|
| 104 | print $client http_header(200, $proto?length($response):0, 'text/plain'); |
---|
| 105 | print $client $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 | print $client http_header(200, $proto?length($response):0); |
---|
| 117 | print $client $response . "\r\n"; |
---|
| 118 | return; |
---|
| 119 | } |
---|
| 120 | } |
---|
| 121 | } |
---|
| 122 | die "Request not understood\n"; |
---|
60 | 123 | } |
---|
61 | 124 | sub http_header { |
---|
62 | 125 | my $code = shift; |
---|
63 | 126 | my $len = shift; |
---|
| 127 | my $type = shift || 'text/xml'; |
---|
64 | 128 | return qq^HTTP/1.0 $code OK |
---|
65 | 129 | Server: resmon |
---|
66 | 130 | ^ . (defined($len) ? "Content-length: $len" : "Connection: close") . q^ |
---|
67 | | Content-Type: text/plain |
---|
| 131 | Content-Type: text/plain; charset=utf-8 |
---|
68 | 132 | |
---|
69 | 133 | ^; |
---|
… | … | |
98 | 162 | s/\r\n/\n/g; |
---|
99 | 163 | chomp; |
---|
100 | | print "CLIENT <= $_\n"; |
---|
101 | 164 | if(!$req) { |
---|
102 | | if(/^GET \s*(\S+) \s*HTTP\/(0\.9|1\.0|1\.1)\s*$/) { |
---|
| 165 | if(/^GET \s*(\S+)\s*?(?: HTTP\/(0\.9|1\.0|1\.1)\s*)?$/) { |
---|
103 | 166 | $req = $1; |
---|
104 | 167 | $proto = $2; |
---|
105 | | } |
---|
106 | | elsif(/^GET \s*(\S+)\s*$/) { |
---|
107 | | $req = $1; |
---|
108 | | $proto = undef; |
---|
109 | 168 | } |
---|
110 | 169 | else { |
---|
… | … | |
114 | 173 | elsif(/^$/) { |
---|
115 | 174 | $self->service($client, $req, $proto); |
---|
| 175 | last unless ($proto); |
---|
116 | 176 | $req = undef; |
---|
117 | 177 | $proto = undef; |
---|
… | … | |
125 | 185 | }; |
---|
126 | 186 | if($@) { |
---|
127 | | print $client http_header(500); |
---|
128 | | print $client "$@"; |
---|
| 187 | print $client http_header(500, 0, 'text/plain'); |
---|
| 188 | print $client "$@\r\n"; |
---|
129 | 189 | last; |
---|
130 | 190 | } |
---|