Changeset c43001e8e3ac31dae3bfc11c22a72d78347fda07

Show
Ignore:
Timestamp:
03/22/07 19:53:21 (7 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
  • lib/Resmon/Config.pm

    r3596d9c rc43001e  
    3737        next; 
    3838      } 
    39       elsif(/\S*LIB\s+(\S+)\s*;?\s*/) { 
     39      elsif(/\S*LIB\s+(\S+)\s*;\s*/) { 
    4040        eval "use lib '$1';"; 
    4141        next; 
    4242      } 
    43       elsif(/\s*INTERVAL\s+(\d+)\s*;?\s*/) { 
     43      elsif(/\s*INTERVAL\s+(\d+)\s*;\s*/) { 
    4444        $self->{interval} = $1; 
    4545        next; 
    4646      } 
    47       elsif(/\s*STATUSFILE\s+(\S+)\s*;?\s*/) { 
     47      elsif(/\s*STATUSFILE\s+(\S+)\s*;\s*/) { 
    4848        $self->{statusfile} = $1; 
    4949        next; 
  • lib/Resmon/Status.pm

    re5d09e8 rc43001e  
    3232  shmread($self->{shared_state}, $blob, length(pack('i', 0)), $len); 
    3333  # 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; 
    3638  return $self->{store}; 
    3739} 
     
    4345  # Lock shared segment 
    4446  # Write state and flush 
    45   shmwrite($self->{shared_state}, pack("l", length($blob)), 
     47  shmwrite($self->{shared_state}, pack('i', length($blob)), 
    4648           0, length(pack('i', 0))) || die "$!"; 
    4749  shmwrite($self->{shared_state}, $blob, length(pack('i', 0)), 
    48            length($blob) - length(pack('i', 0))) || die "$!"; 
     50           length($blob)) || die "$!"; 
    4951  # unlock 
     52} 
     53sub 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} 
     63sub 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} 
     74sub 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} 
     82sub dump_xml { 
     83  my $self = shift; 
     84  my $response = <<EOF 
     85<?xml version="1.0" encoding="UTF-8"?> 
     86<ResmonResults> 
     87EOF 
     88  ;  
     89  $response .= $self->dump_generic(\&xml_info); 
     90  $response .= "</ResmonResults>\n"; 
     91  return $response; 
    5092} 
    5193sub service { 
     
    5395  my ($client, $req, $proto) = @_; 
    5496  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); 
    58100    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"; 
    60123} 
    61124sub http_header { 
    62125  my $code = shift; 
    63126  my $len = shift; 
     127  my $type = shift || 'text/xml'; 
    64128  return qq^HTTP/1.0 $code OK 
    65129Server: resmon 
    66130^ . (defined($len) ? "Content-length: $len" : "Connection: close") . q^ 
    67 Content-Type: text/plain 
     131Content-Type: text/plain; charset=utf-8 
    68132 
    69133^; 
     
    98162            s/\r\n/\n/g; 
    99163            chomp; 
    100 print "CLIENT <= $_\n"; 
    101164            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*)?$/) { 
    103166                $req = $1; 
    104167                $proto = $2; 
    105               } 
    106               elsif(/^GET \s*(\S+)\s*$/) { 
    107                 $req = $1; 
    108                 $proto = undef; 
    109168              } 
    110169              else { 
     
    114173            elsif(/^$/) { 
    115174              $self->service($client, $req, $proto); 
     175              last unless ($proto); 
    116176              $req = undef; 
    117177              $proto = undef; 
     
    125185          }; 
    126186          if($@) { 
    127             print $client http_header(500); 
    128             print $client "$@"; 
     187            print $client http_header(500, 0, 'text/plain'); 
     188            print $client "$@\r\n"; 
    129189            last; 
    130190          }