GeniCHClient.pm.in 5.58 KB
Newer Older
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1 2 3 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
#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
# Copyright (c) 2008 University of Utah and the Flux Group.
# All rights reserved.
#
package GeniCHClient;

#
# The client side of the Emulab to Geni ClearingHouse API. This is where we
# register local users, experiments, etc at the clearinghouse and also how
# we look up things at the clearinghouse.
#
use strict;
use Exporter;
use vars qw(@ISA @EXPORT);

@ISA    = "Exporter";
@EXPORT = qw ( );

# Must come after package declaration!
use lib '@prefix@/lib';
use Genixmlrpc;
use GeniResponse;
use English;
use Data::Dumper;

# Configure variables
Leigh B. Stoller's avatar
Leigh B. Stoller committed
29
my $GENICENTRAL    = "myboss.myelab.testbed.emulab.net";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
30
my $GENICENTRALURL = "https://$GENICENTRAL/protogeni/xmlrpc/ch";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
31 32

#
33
# Context for making calls to the clearinghouse. Opaque to this module.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
34
#
35 36 37 38 39 40
my $MyContext;

#
# Set the context for subsequent calls made to the clearing house.
#
sub SetContext($$)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
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 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94
    my ($class, $context) = @_;

    $MyContext = $context;
    return 0;
}

#
# Our credential for talking to the clearinghouse. Should be cached
# but currently asking for a new one each time.
#
my $Credential;

sub SetCredential()
{
    return
	if (defined($Credential));

    GetCredential(undef, undef, undef, \$Credential) == 0
	or die("Could not get our CH credential from the clearinghouse.\n");
}

#
# Ask the clearing house for a credential.
#
sub GetCredential($$$$)
{
    my ($credential, $uuid, $type, $pref) = @_;

    my %args = ();
    $args{'credential'} = $credential
	if (defined($credential));
    $args{'uuid'} = $uuid
	if (defined($uuid));
    $args{'type'} = $type
	if (defined($type));

    my $response =
	Genixmlrpc::CallMethod($GENICENTRALURL, $MyContext,
			       "GetCredential", \%args);

    return -1
	if (!defined($response) || $response->code() != GENIRESPONSE_SUCCESS);
    
    $$pref = $response->value();
    return 0;
}

#
# Lookup a record at the clearing house.
#
sub Resolve($$$)
{
    my ($uuid, $type, $pref) = @_;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
95 96

    $$pref = undef;
97 98

    SetCredential();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
99 100
    
    my $response =
101 102 103 104
	Genixmlrpc::CallMethod($GENICENTRALURL, $MyContext, "Resolve",
			       { "credential" => $Credential,
				 "type"       => $type,
				 "uuid"       => $uuid });
Leigh B. Stoller's avatar
Leigh B. Stoller committed
105 106 107 108 109 110 111
    return -1
	if (!defined($response) || $response->code() != GENIRESPONSE_SUCCESS);
    
    $$pref = $response->value();
    return 0;
}

112 113 114 115 116 117 118 119 120 121
#
# Lookup a user at the clearing house.
#
sub LookupUser($$)
{
    my ($uuid, $pref) = @_;

    return Resolve($uuid, "User", $pref);
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
122 123 124 125 126
#
# Lookup a slice (experiment) at the clearing house.
#
sub LookupSlice($$)
{
Leigh B. Stoller's avatar
Leigh B. Stoller committed
127
    my ($uuid, $pref) = @_;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
128

129 130 131 132 133 134 135 136 137 138 139
    return Resolve($uuid, "Slice", $pref);
}

#
# Register a record at the clearing house.
#
sub Register($$$$)
{
    my ($hrn, $type, $cert, $info) = @_;

    SetCredential();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
140 141
    
    my $response =
142 143 144 145 146 147
	Genixmlrpc::CallMethod($GENICENTRALURL, $MyContext, "Register",
			       { "credential" => $Credential,
				 "type"       => $type,
				 "hrn"        => $hrn,
			         "cert"       => $cert,
			         "info"       => $info });
Leigh B. Stoller's avatar
Leigh B. Stoller committed
148 149 150 151 152 153 154 155 156 157
    return -1
	if (!defined($response) || $response->code() != GENIRESPONSE_SUCCESS);
    
    return 0;
}

#
# Register a local Emulab user at the Geni ClearingHouse (which in the
# prototype is Utah Emulab).
#
158
sub RegisterUser($$$$$)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
159
{
160 161 162 163 164
    my ($hrn, $name, $email, $cert, $sshkey) = @_;

    my $info = { "name"   => $name,
		 "email"  => $email };
    $info->{"sshkey"} = $sshkey
Leigh B. Stoller's avatar
Leigh B. Stoller committed
165
	if (defined($sshkey));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
166

167 168
    return Register($hrn, "User", $cert, $info);
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
169

170 171 172 173 174 175 176 177 178 179
#
# Register a slice at the Clearinghouse.
#
sub RegisterSlice($$$)
{
    my ($hrn, $creator_uuid, $cert) = @_;

    my $info = { "creator_uuid"  => $creator_uuid };

    return Register($hrn, "Slice", $cert, $info);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
180 181 182
}

#
183
# Remove a record at the clearing house.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
184
#
185
sub Remove($$)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
186
{
187
    my ($type, $uuid) = @_;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
188

189
    SetCredential();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
190
    
191 192 193 194 195
    my $response =
	Genixmlrpc::CallMethod($GENICENTRALURL, $MyContext, "Remove",
			       { "credential" => $Credential,
				 "type"       => $type,
			         "uuid"       => $uuid });
Leigh B. Stoller's avatar
Leigh B. Stoller committed
196 197 198 199 200 201 202 203 204
    return -1
	if (!defined($response) || $response->code() != GENIRESPONSE_SUCCESS);
    
    return 0;
}

#
# Delete a slice registration.
#
205
sub RemoveSlice($)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
206
{
Leigh B. Stoller's avatar
Leigh B. Stoller committed
207
    my ($uuid) = @_;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
208

209
    return Remove("Slice", $uuid);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
210 211 212 213 214 215 216 217 218 219 220
}

#
# Discover resources for a slice (local experiment). This contacts Geni
# Central to get a list of components. I think the interface is supposed
# to be that we send an rspec and it sends back a list of components. But
# lets not worry about that; just get a list of all components we can ask
# for resources from.
#
sub DiscoverResources($$)
{
Leigh B. Stoller's avatar
Leigh B. Stoller committed
221
    my ($slice, $pref) = @_;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
222 223

    my $response =
224
	Genixmlrpc::CallMethod($GENICENTRALURL, $MyContext,
Leigh B. Stoller's avatar
Leigh B. Stoller committed
225
				   "CH::DiscoverResources",
Leigh B. Stoller's avatar
Leigh B. Stoller committed
226
				   { "slice"  => $slice->cert() });
Leigh B. Stoller's avatar
Leigh B. Stoller committed
227 228 229 230 231 232 233

    return -1
	if (!defined($response));

    return -1
	if ($response->code() != GENIRESPONSE_SUCCESS);

234
    $$pref = $response->value();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
235 236 237
    return 0;
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
238 239 240 241 242 243 244 245 246 247 248
#
# Bind and unbind users to/from slices
#
sub BindUser($$)
{
    my ($slice_uuid, $user_uuid) = @_;

    my $args = { "slice_uuid" => $slice_uuid,
		 "user_uuid"  => $user_uuid };

    my $response =
249
	Genixmlrpc::CallMethod($GENICENTRALURL, $MyContext,
Leigh B. Stoller's avatar
Leigh B. Stoller committed
250 251 252 253 254 255 256 257 258 259 260 261 262 263 264
				   "CH::BindUser", $args);

    return -1
	if (!defined($response) || $response->code() != GENIRESPONSE_SUCCESS);
    
    return 0;
}
sub UnBindUser($$)
{
    my ($slice_uuid, $user_uuid) = @_;

    my $args = { "slice_uuid" => $slice_uuid,
		 "user_uuid"  => $user_uuid };

    my $response =
265
	Genixmlrpc::CallMethod($GENICENTRALURL, $MyContext,
Leigh B. Stoller's avatar
Leigh B. Stoller committed
266 267 268 269 270 271 272 273
				   "CH::UnBindUser", $args);

    return -1
	if (!defined($response) || $response->code() != GENIRESPONSE_SUCCESS);
    
    return 0;
}

274 275
# _Always_ make sure that this 1 is at the end of the file...
1;