xmlrpc_status.pl

OpenCDN内容分发系统

#!/usr/bin/perl -I ../../ -w
#
# xmlrpc_status.pl
#
# The oCDN package is released under the terms of the Perl Artistic Licence
# (see http://www.perl.com/pub/a/language/misc/Artistic.html) by their
# Copyright Holders, hosted at the University of Roma "La Sapienza",
# at http://labtel.ing.uniroma1.it/~ocdn
#

use CGI;
use RPC::XML;
use RPC::XML::Client;
use etc::CommConf qw($rrdm_addr $rrdm_port $log_to);
require 'etc/RRDMconfig.pm';    # needed for $forked_addr

$q = new CGI;
print $q->header(-expires=>'-10y');
print $q->start_html(-title=>'OpenCDN XML-RPC Status Page');

#$addr  = hostname;             # RRDM defaults
$addr  = $rrdm_addr;            # RRDM defaults
$port  = $rrdm_port;            # Core server
$addr2 = $RRDMconfig::forked_addr;  # Forked server (if any)
$port2 = $rrdm_port + 1;
$label = 'Core';

$req = $q->param('req');
if ($req eq 'node') {           # loads node values
  $addr  = $q->param('addr');
  $port  = $q->param('port');
  $port2 = '0';
  $label = 'Node';
  print $q->h3("Query of node $addr at $port");
} elsif ($req eq 'origin') {    # loads origin values
  $addr  = $q->param('addr');
  $port  = $q->param('port');
  $port2 = '0';
  $label = 'Origin';
  print $q->h3("Query of Origin $addr at $port");
} else {
  print $q->h3("Query of RRDM $addr at $port");
}

$cli   = RPC::XML::Client->new("http://$addr:$port/",
                               'useragent', ['timeout', 8]);
$risp  = $cli  -> simple_request('system.identity');
unless ( $risp ) {
  print "<br><br>The Request Routing and Distribution Management (RRDM) entity seems to be down.\n";
  print "<br>Error is: $RPC::XML::ERROR\n";
  print "<br>Please enform developers and retry later\n";
  goto END;
}

$cli2  = RPC::XML::Client->new("http://$addr2:$port2/");
$risp2 = $cli2 -> simple_request('system.identity');
if ( $risp2 ) {
  $forked = 1;                 # flags Net::Server use
  print $q->i('A forked server is in use. Page will report both
             Core Status Server and Forked Request Server data');
}


print $q->h2('system.identity');
print "<table border=1 cellspacing=2 cellpadding=4>\n";
print $q->Tr($q->td([$label, $risp])), "\n";
if ($forked) {
  print $q->Tr($q->td([Forked, $risp2])), "\n";
}
print "</table><BR>\n";


print $q->h2('system.status');
$risp = $cli -> simple_request('system.status');
print "<table border=1 cellspacing=2 cellpadding=4>\n";
  @k = sort keys %$risp;
  print $q->Tr($q->td([' ', @k])), "\n";
  foreach $k (@k) {
    push @v, $$risp{$k};
  }
  print $q->Tr($q->td([$label, @v])), "\n";
  if ($forked) {
    $risp = $cli2 -> simple_request('system.status');
    @v = ();
    foreach $k (@k) {
      push @v, $$risp{$k};
    }
    print $q->Tr($q->td([Forked, @v])), "\n";
  }
print "</table><BR>\n";


print $q->h2('system.listMethods');
$risp  = $cli  -> simple_request('system.listMethods');
$risp2 = $cli2 -> simple_request('system.listMethods');
print "<table border=1 cellspacing=2 cellpadding=4>\n";
  (@v, @q) = ((), ());
  foreach (sort @$risp) {
    push @v, "$_ " unless ($_ =~ /system/);
  }
  foreach (sort @$risp2) {
    push @q, "$_ " unless ($_ =~ /system/);
  }
  print $q->Tr($q->td([$label, @v])), "\n";
  if ($forked) {
    print $q->Tr($q->td([Forked, @q])), "\n";
  }
print "</table><BR>\n";


print $q->h2('system.introspection');
$risp  = $cli  -> simple_request('system.introspection');
$risp2 = $cli2 -> simple_request('system.introspection');
print "<table border=1 cellspacing=2 cellpadding=4>\n";
  print $q->Tr($q->td([' ', 'name', 'version', 'signature', 'help'])), "\n";
  foreach $h (@$risp) {
    $help = '<pre>' . $$h{help} . '</pre>';
    unless ($$h{name} =~ /system/) {
      print $q->Tr($q->td([$label, $$h{name}, $$h{version}, @{$$h{signature}}, $help])), "\n";
    }
  }
  if ($forked) {
    foreach $h (@$risp2) {
      $help = '<pre>' . $$h{help} . '</pre>';
      unless ($$h{name} =~ /system/) {
        print $q->Tr($q->td([Forked, $$h{name}, $$h{version}, @{$$h{signature}}, $help])), "\n";
      }
    }
  }
print "</table><BR>\n";

END {
  print $q->end_html;
  exit;
}