Commit 83dd607b authored by Leigh B. Stoller's avatar Leigh B. Stoller

Add support for getting the list of active slices on each CM. The

listusage script gets the list of CMs from the clearinghouse DB, and
calls the ListUsage() method on each one. The return is a list of
slices (gids) and for each slice, a list of slivers that represent
nodes. Currently just for debugging other CMs, but eventually will be
used to populate the clearinghouse DB with an informational snapshot
of the federation.
parent eb312189
......@@ -1840,6 +1840,100 @@ sub Shutdown($)
return GeniResponse->Create(GENIRESPONSE_SUCCESS);
}
#
# Return a list of resources currently in use.
# This is used by the clearinghouse to get a global sense of usage.
# Currently, only the ClearingHouse will be allowed to make this call,
# but eventually I think it should be opened up to any of federation
# roots
#
sub ListUsage($)
{
my ($argref) = @_;
my $cred = $argref->{'credential'};
if (! (defined($cred))) {
return GeniResponse->MalformedArgsResponse();
}
my $credential = GeniCredential->CreateFromSigned($cred);
if (!defined($credential)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Could not create GeniCredential object");
}
#
# Make sure the credential was issued to the caller.
#
if ($credential->owner_uuid() ne $ENV{'GENIUUID'}) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"This is not your credential!");
}
#
# And that the target of the credential is this registry.
#
if ($credential->target_uuid() ne $ENV{'MYUUID'}) {
return GeniResponse->Create(GENIRESPONSE_FORBIDDEN,
undef, "This is not your authority!");
}
# Just one of these, at Utah.
my $GENICH_PEMFILE = "@prefix@/etc/genich.pem";
my $certificate = GeniCertificate->LoadFromFile($GENICH_PEMFILE);
if (!defined($certificate)) {
print STDERR "Could not load certificate from $GENICH_PEMFILE\n";
return GeniResponse->Create(GENIRESPONSE_ERROR);
}
# The caller has to match the clearinghouse.
if ($credential->owner_uuid() ne $certificate->uuid()) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Only the clearinghouse can do this!");
}
my @slices;
if (GeniSlice->ListAll(\@slices) != 0) {
return GeniResponse->Create(GENIRESPONSE_ERROR);
}
my @result = ();
foreach my $slice (@slices) {
#
# Grab all the slivers for this slice, and then
# look for just the nodes.
#
my @slivers = ();
my @components = ();
if (GeniSliver->SliceSlivers($slice, \@slivers) != 0) {
print STDERR "Could not slice slivers for $slice\n";
return GeniResponse->Create(GENIRESPONSE_ERROR);
}
foreach my $sliver (@slivers) {
next
if ($sliver->resource_type() ne "Node");
my $node = {"sliver_gid" => $sliver->cert(),
"sliver_hrn" => $sliver->hrn() };
my $component = GeniComponent->Lookup($sliver->resource_uuid());
if (defined($component)) {
$node->{"component_gid"} = $component->cert();
$node->{"component_hrn"} = $component->hrn();
}
else {
print STDERR "No component in DB for resource ".
$sliver->resource_uuid() . "\n";
}
push(@components, $node);
}
next
if (!@components);
my $blob = {"slice_gid" => $slice->cert(),
"slice_hrn" => $slice->hrn(),
"slivers" => \@components };
push(@result, $blob);
}
return GeniResponse->Create(GENIRESPONSE_SUCCESS, \@result);
}
#
# Utility Routines.
#
......
......@@ -14,7 +14,7 @@ include $(OBJDIR)/Makeconf
SBIN_STUFF = cleanupslice
PSBIN_STUFF = register_resources expire_daemon gencrl postcrl \
createcerts initsite addauthority getcacerts \
gencrlbundle shutdownslice remauthority
gencrlbundle shutdownslice remauthority listusage
# These scripts installed setuid, with sudo.
SETUID_BIN_SCRIPTS =
......
#!/usr/bin/perl -w
#
# EMULAB-COPYRIGHT
# Copyright (c) 2009 University of Utah and the Flux Group.
# All rights reserved.
#
use strict;
use English;
use Getopt::Std;
use Data::Dumper;
#
# Ask all components managers for a list of resources used.
#
sub usage()
{
print "Usage: listusage\n";
exit(1);
}
my $optlist = "";
my $errors = 0;
sub fatal($);
#
# Configure variables
#
my $TB = "@prefix@";
my $TBOPS = "@TBOPSEMAIL@";
my $TBLOGS = "@TBLOGSEMAIL@";
# un-taint path
$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin:/usr/site/bin';
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
#
# Turn off line buffering on output
#
$| = 1;
#
# Check args.
#
my %options = ();
if (! getopts($optlist, \%options)) {
usage();
}
usage()
if (@ARGV);
use vars qw($GENI_DBNAME);
$GENI_DBNAME = "geni-ch";
# Now we can load the libraries after setting the proper DB.
use lib '@prefix@/lib';
use libtestbed;
require GeniDB;
require Genixmlrpc;
use GeniResponse;
require GeniCertificate;
require GeniCredential;
require GeniAuthority;
require GeniSlice;
#
# The RPC context for this script is as the CH
#
my $EMULAB_PEMFILE = "@prefix@/etc/genich.pem";
my $certificate = GeniCertificate->LoadFromFile($EMULAB_PEMFILE);
if (!defined($certificate)) {
fatal("Could not load certificate from $EMULAB_PEMFILE");
}
Genixmlrpc->SetContext(Genixmlrpc->Context($certificate));
Genixmlrpc->SetTimeout(15);
#
# The credential will be issued to the ClearingHouse.
#
my $authority = GeniAuthority->Lookup($certificate->uuid());
if (!defined($authority)) {
fatal("Could not find local authority object");
}
#
# List of all CMs.
#
my $query_result =
GeniDB::DBQueryWarn("select uuid from geni_authorities where type='cm'");
fatal("Could not lookup CM list")
if (!defined($query_result));
fatal("No managers listed in the DB; is this a ClearingHouse?")
if (!$query_result->numrows);
while (my ($manager_uuid) = $query_result->fetchrow_array()) {
my $manager = GeniAuthority->Lookup($manager_uuid);
print STDERR "Could not lookup up CM $manager_uuid\n"
if (!defined($manager));
my $manager_credential = GeniCredential->Create($manager, $authority);
if (!defined($manager_credential)) {
fatal("Could not create new credential for $manager");
}
if ($manager_credential->Sign($certificate) != 0) {
fatal("Could not sign credential for $manager");
}
print "$manager\n";
my $response =
Genixmlrpc::CallMethod($manager->url(), undef,
"ListUsage",
{ "credential" =>
$manager_credential->asString() });
if (!defined($response) || $response->code() != GENIRESPONSE_SUCCESS) {
print STDERR
"Could not listusage on $manager: ". $response->output();
$errors++;
}
foreach my $ref (@{$response->value()}) {
my $slice_hrn = $ref->{'slice_hrn'};
my @slivers = @{$ref->{'slivers'}};
print "$slice_hrn\n";
foreach my $sliver (@slivers) {
my $sliver_hrn = $sliver->{'sliver_hrn'};
my $component_hrn =
(exists($sliver->{'component_hrn'}) ?
"(" . $sliver->{'component_hrn'} . ")" : "");
print " $sliver_hrn $component_hrn\n";
}
}
$manager_credential->Delete();
}
exit($errors);
sub fatal($) {
my ($msg) = @_;
print STDERR "$msg\n";
exit(1);
}
#!/usr/bin/perl -w
#
# EMULAB-COPYRIGHT
# Copyright (c) 2008 University of Utah and the Flux Group.
# Copyright (c) 2008-2009 University of Utah and the Flux Group.
# All rights reserved.
#
......@@ -135,6 +135,7 @@ my $responder = Frontier::Responder->new( "methods" => {
"GetSliver" => \&GeniCM::GetSliver,
"BindToSlice" => \&GeniCM::BindToSlice,
"Shutdown" => \&GeniCM::Shutdown,
"ListUsage" => \&GeniCM::ListUsage,
},
);
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment