#!/usr/bin/perl -w
#-----------------------------------------------------------------
# service_tester.pl
# Author: Edward Kawas <edward.kawas@gmail.com>,
# For copyright and disclaimer see below.
#
# $Id: service_tester.pl,v 1.6 2008/11/25 19:37:10 kawas Exp $
#
# BETA
#
# This script goes ahead an asks a registry what services exist
# and then goes ahead and calls them all determining who is alive
# and who is not. This info is kept in a file as XML.
#
# Configurable options:
# TIMEOUT - the timeout in seconds to wait for each service
# THREAD_COUNT - the number of workers that will call services
# CATEGORIES - the moby service categories to test
# URL - the registry endpoint <optional>
# URI - the registry namespace <optional>
# DIRECTORY - the place to store details between jobs <optional>
#
# IMPORTANT NOTE:
# This script currently does not run on windows because of the
# IPC::Shareable module. A work around is being looked into.
#
# This script works on unix/linux. Other machines have not been
# tested.
#-----------------------------------------------------------------
use strict;
use warnings;
use MOBY::Config;
use MOBY::Client::Central;
use SOAP::Lite;
use XML::LibXML;
use HTTP::Request::Common qw(POST);
use LWP::UserAgent;
# Because of this library, cannot run on windows
use IPC::Shareable;
######-------USER CONFIGURABLE PARAMETERS-------######
# how long in seconds to wait for a service to respond
my $TIMEOUT = 20;
# the total number of 'threads' to use ...
my $THREAD_COUNT = 15;
# the categories of services to ping
my @CATEGORIES = qw / moby /;
######-------------------------------------------######
# the registry to query
my $URL = $ENV{MOBY_SERVER} || 'http://moby.ucalgary.ca/moby/MOBY-Central.pl';
my $URI = $ENV{MOBY_URI} || 'http://moby.ucalgary.ca/MOBY/Central';
# The directory to store the job details
my $CONF = MOBY::Config->new;
my $DIRECTORY = $CONF->{mobycentral}->{service_tester_path} || '/tmp/';
# hashes whose key is the service provider and the value is an array of service names
my %ALIVE = ();
my $FILENAME = 'isAliveStats.xml';
# this is just to test if I'm going to have permissions
# right now, rather than an hour from now... Arghghg!
open( OUT, ">>$DIRECTORY/$FILENAME" ) || die("Cannot Open File '$DIRECTORY/$FILENAME' $!");
close OUT;
# create some shared variables
my $alive_handle = tie %ALIVE, 'IPC::Shareable', undef, { } or die "\n\tCouldn't tie shared variable:\n$!";
# create the central client and get all service providers once
my $central =
MOBY::Client::Central->new(
Registries => {
mobycentral => {
URL => $URL,
URI => $URI
}
}
);
my @providers = $central->retrieveServiceProviders();
foreach my $cat (@CATEGORIES) {
foreach my $authURI (@providers) {
my ( $second, $minute, $hour, @whatever ) = localtime();
$hour = "0$hour" if $hour <= 9;
$second = "0$second" if $second <= 9;
$minute = "0$minute" if $minute <= 9;
print "Finding services registered by '$authURI' as '$cat' @ $hour:$minute:$second\n";
my ( $services, $reg ) = $central->findService( Registry => "mobycentral",category => $cat, authURI => $authURI );
( $second, $minute, $hour, @whatever ) = localtime();
$hour = "0$hour" if $hour <= 9;
$second = "0$second" if $second <= 9;
$minute = "0$minute" if $minute <= 9;
print "Services found "
. scalar @$services
. "... processing @ $hour:$minute:$second \n";
my $count = 0;
print "\tservice count: " . scalar (@$services) . "\n";
foreach (@$services) {
# ignore test services
next if $_->authority eq 'samples.jmoby.net';
wait, $count-- while $count >= $THREAD_COUNT;
$count++;
my $pid = fork();
$count-- unless defined $pid;
do { IPC::Shareable->clean_up_all; die "Couldn't fork: $!"; }
unless defined $pid;
if ($pid) {
# parent - do nothing ...s
} elsif ( $pid == 0 ) {
my $name = $_->name;
my $auth = $_->authority;
my $url = $_->URL;
do {
# dont process localhost addresses ...
exit(0);
} if $url =~ /localhost/;
# child - stuff to do goes here
my $out = undef;
my $input = _empty_input();
#print "Calling: " . $auth . "," . $name . "\n";
do {
my $soap =
SOAP::Lite->uri("http://biomoby.org/")
->proxy( $url, timeout => $TIMEOUT )->on_fault(
sub {
my $soap = shift;
my $res = shift;
#TODO add to DEAD hash ...
$alive_handle->shlock();
$ALIVE{$auth} = () if not exists $ALIVE{$auth};
push @{ $ALIVE{$auth} }, {name=>$name, alive=>undef};
$alive_handle->shunlock();
#print "\t" . $auth . "," . $name . " ~isAlive\n";
exit(0);
}
);
$out =
$soap->$name( SOAP::Data->type( 'string' => "$input" ) )->result;
} unless $cat eq 'cgi';
# test cgi services
do {
my $ua = LWP::UserAgent->new;
$ua->timeout($TIMEOUT);
my $req = POST $url, [ data => $input];
$req = $ua->request($req);
$out = $req->content if $req->is_success;
} if $cat eq 'cgi';
do {
#TODO add to ALIVE hash ...
#print "\t" . $auth . "," . $name . " isAlive\n";
$alive_handle->shlock();
$ALIVE{$auth} = () if not exists $ALIVE{$auth};
push @{ $ALIVE{$auth} }, {name=>$name, alive=>1};
$alive_handle->shunlock();
exit(0);
} if $out;
do {
#TODO add to DEAD hash ...
#print "\t" . $auth . "," . $name . " ~isAlive\n";
$alive_handle->shlock();
$ALIVE{$auth} = () if not exists $ALIVE{$auth};
push @{ $ALIVE{$auth} }, {name=>$name, alive=>undef};
$alive_handle->shunlock();
exit(0);
} unless $out;
} else {
IPC::Shareable->clean_up_all;
die "couldnt fork: $!\n";
}
}
# dont proceed until we are completed with the first batch of children!
wait, $count-- while $count > 0;
( $second, $minute, $hour, @whatever ) = localtime();
$hour = "0$hour" if $hour <= 9;
$second = "0$second" if $second <= 9;
$minute = "0$minute" if $minute <= 9;
print "Testing of '$cat' services from '$authURI' completed @ $hour:$minute:$second \n";
}
}
my $doc = XML::LibXML::Document->new( "1.0", "UTF-8" );
my $root = $doc->createElement('Services');
$doc->setDocumentElement($root);
for my $auth ( sort keys %ALIVE ) {
my $element = $doc->createElement('authority');
$element->setAttribute( 'id', $auth );
my @services = @{$ALIVE{$auth}};
next unless @services;
foreach my $s (@services) {
next unless $s;
my $child = $doc->createElement('service');
$child->setAttribute( 'id', $auth . ',' . $s->{name} );
$child->appendText(($s->{alive} ? 'true' : 'false'));
$element->appendChild($child);
}
$root->appendChild($element);
}
# clean up the shared memory
eval {
warn "Attempting to clean up shared memory ...";
IPC::Shareable->clean_up_all;
warn "Shared memory cleaned up successfully";
};
warn "There was a problem cleaning up shared memory segments:\n$@\n" if $@;
open( OUT, ">$DIRECTORY/$FILENAME" ) || die("Cannot Open File $DIRECTORY/$FILENAME $!");
print OUT $doc->toString(1);
close OUT;
sub _empty_input {
return <<'END_OF_XML';
<?xml version="1.0" encoding="UTF-8"?>
<moby:MOBY xmlns:moby="http://www.biomoby.org/moby">
<moby:mobyContent>
</moby:mobyContent>
</moby:MOBY>
END_OF_XML
}