listusage.in 4.5 KB
Newer Older
1 2
#!/usr/bin/perl -w
#
Leigh B Stoller's avatar
Leigh B Stoller committed
3
# Copyright (c) 2009-2011 University of Utah and the Flux Group.
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28
# 
# {{{GENIPUBLIC-LICENSE
# 
# GENI Public License
# 
# Permission is hereby granted, free of charge, to any person obtaining
# a copy of this software and/or hardware specification (the "Work") to
# deal in the Work without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense,
# and/or sell copies of the Work, and to permit persons to whom the Work
# is furnished to do so, subject to the following conditions:
# 
# The above copyright notice and this permission notice shall be
# included in all copies or substantial portions of the Work.
# 
# THE WORK IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
# OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
# HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
# WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE WORK OR THE USE OR OTHER DEALINGS
# IN THE WORK.
# 
# }}}
29 30 31 32 33 34 35 36 37 38 39
#
use strict;
use English;
use Getopt::Std;
use Data::Dumper;

#
# Ask all components managers for a list of resources used.
# 
sub usage()
{
Leigh B Stoller's avatar
Leigh B Stoller committed
40
    print "Usage: listusage [urn]\n";
41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69
    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();
}
Leigh B Stoller's avatar
Leigh B Stoller committed
70 71
my $urn = $ARGV[0]
    if (@ARGV == 1);
72 73 74 75 76 77 78 79 80 81 82 83 84 85

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;
Leigh B Stoller's avatar
Leigh B Stoller committed
86
require GeniRegistry;
87 88 89 90

#
# The RPC context for this script is as the CH
#
Leigh B Stoller's avatar
Leigh B Stoller committed
91
my $certificate = GeniRegistry::ClearingHouse->GetCertificate();
92
if (!defined($certificate)) {
Leigh B Stoller's avatar
Leigh B Stoller committed
93
    fatal("Could not load ClearingHouse certificate");
94 95 96 97
}
Genixmlrpc->SetContext(Genixmlrpc->Context($certificate));
Genixmlrpc->SetTimeout(15);

Leigh B Stoller's avatar
Leigh B Stoller committed
98
my $authority = GeniAuthority->Lookup($certificate->urn());
99
if (!defined($authority)) {
Leigh B Stoller's avatar
Leigh B Stoller committed
100
    fatal("Could not locate ClearingHouse authority object");
101 102 103
}

#
Leigh B Stoller's avatar
Leigh B Stoller committed
104
# Use a self signed clearinghouse credential.
105
#
Leigh B Stoller's avatar
Leigh B Stoller committed
106 107 108 109
my $credential = GeniCredential->GetSelfCredential($authority);
if (!defined($credential)) {
    fatal("Could not create self signed clearinghouse credential");
}
110

Leigh B Stoller's avatar
Leigh B Stoller committed
111 112 113 114 115 116 117
#
# Call listusage on a CM.
#
sub ListUsage($)
{
    my ($manager) = @_;
    
118 119 120 121 122
    print "$manager\n";
	
    my $response =
	Genixmlrpc::CallMethod($manager->url(), undef,
			       "ListUsage",
Leigh B Stoller's avatar
Leigh B Stoller committed
123 124
			       { "credential"  => $credential->asString(),
				 "credentials" => [$credential->asString()]});
125 126
    if (!defined($response) || $response->code() != GENIRESPONSE_SUCCESS) {
	print STDERR
Leigh B Stoller's avatar
Leigh B Stoller committed
127 128
	    "Could not listusage on $manager: ".
	    (defined($response) ? $response->output() : "") . "\n";
129
	    $errors++;
Leigh B Stoller's avatar
Leigh B Stoller committed
130
	return;
131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146
    }
    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";
	}

    }
Leigh B Stoller's avatar
Leigh B Stoller committed
147 148 149 150 151 152 153 154 155 156 157 158 159 160 161
}

if (defined($urn)) {
    my $manager = GeniAuthority->Lookup($urn);
    fatal("Could not find manager in the DB")
	if (!defined($manager));
    
    ListUsage($manager);
}
else {
    #
    # List of all CMs.
    #
    my $query_result =
	GeniDB::DBQueryWarn("select uuid from geni_authorities ".
Leigh B Stoller's avatar
Leigh B Stoller committed
162
			    "where type='cm' and disabled=0");
Leigh B Stoller's avatar
Leigh B Stoller committed
163 164 165 166 167 168 169 170 171 172 173 174
    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));

	ListUsage($manager);
    }
175 176 177 178 179 180 181 182 183
}
exit($errors);

sub fatal($) {
    my ($msg) = @_;

    print STDERR "$msg\n";
    exit(1);
}