GeniAM.pm.in 20.7 KB
Newer Older
1
2
3
#!/usr/bin/perl -wT
#
# GENIPUBLIC-COPYRIGHT
4
# Copyright (c) 2008-2012 University of Utah and the Flux Group.
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
# All rights reserved.
#
package GeniAM;

#
# The server side of the CM interface on remote sites. Also communicates
# with the GMC interface at Geni Central as a client.
#
use strict;
use Exporter;
use vars qw(@ISA @EXPORT);

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

use GeniCMV2;
use GeniResponse;
Tom Mitchell's avatar
Tom Mitchell committed
22
use GeniCredential;
23
24
use GeniRegistry;
use emutil;
Tom Mitchell's avatar
Tom Mitchell committed
25
26
27

use Compress::Zlib;
use MIME::Base64;
Leigh B Stoller's avatar
Leigh B Stoller committed
28
use XML::LibXML;
29
use URI;
30
use Date::Parse;
31
use Data::Dumper;
32
use Frontier::RPC2;
33
use POSIX qw(strftime);
34

Tom Mitchell's avatar
Tom Mitchell committed
35
36
37
# Disable UUID checks in GeniCredential.
$GeniCredential::CHECK_UUID = 0;

38
my $API_VERSION = 2;
39
my $MAINSITE    = @TBMAINSITE@;
40

41
42
43
44
45
46
47
48
sub SetGeniVersion($)
{
    my ($new_version) = @_;
    if ($new_version eq "1.0") {
	$API_VERSION = 1;
    }
}

49
50
51
52
53
54
55
#
# Tell the client what API revision we support.  The correspondence
# between revision numbers and API features is to be specified elsewhere.
# No credentials are required.
#
sub GetVersion()
{
56
57
    # $options is optional here for all versions
    my ($options) = @_;
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
95
96
97
    my $me = GeniAuthority->Lookup($ENV{'MYURN'});
    if (!defined($me)) {
	print STDERR "Could not find local authority object\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
    my $commithash = VersionInfo("commithash") || "";
    my $hostname   = `hostname`;
    chomp($hostname);
    my $peers      = {};

    #
    # Ask the Clearinghouse for the peers info.
    #
    if ($MAINSITE) {
	my $clearinghouse = GeniRegistry::ClearingHouse->Create();
	if (!defined($clearinghouse)) {
	    print STDERR "Could not create clearinghouse object.\n";
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
	my $versioninfo;
	if ($clearinghouse->GetVersion(\$versioninfo)) {
	    print STDERR "Could not get peers from clearinghouse.\n";
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
	$peers = $versioninfo->{"peers"};

	foreach my $urn (keys(%{ $peers })) {
	    my $url = $peers->{$urn};
	    $url =~ s/cm$/am/;
	    $peers->{$urn} = $url;
	}
    }

    #
    # We have some confusion here. This is the AM interface, and the
    # URL is different, but the URN and HRN are that of the CM.
    #
    my $url = $me->url();
    $url =~ s/cm$/am/;

98
99
    my $coder = Frontier::RPC2->new('use_objects' => 1);

100
101
    my $default_ad = {
	"type" => "ProtoGENI",
102
	"version" => $coder->string("2") };
103
104
    my $request_0_1 = {
	"type" => "ProtoGENI",
105
	"version" => $coder->string("0.1"),
106
107
108
109
110
111
	"schema" => "http://www.protogeni.net/resources/rspec/0.1/request.xsd",
	"namespace" => "http://www.protogeni.net/resources/rspec/0.1",
	"extensions" => []
    };
    my $request_0_2 = {
	"type" => "ProtoGENI",
112
	"version" => $coder->string("0.2"),
113
114
115
116
117
118
	"schema" => "http://www.protogeni.net/resources/rspec/0.2/request.xsd",
	"namespace" => "http://www.protogeni.net/resources/rspec/0.2",
	"extensions" => []
    };
    my $request_2 = {
	"type" => "ProtoGENI",
119
	"version" => $coder->string("2"),
120
121
122
123
	"schema" => "http://www.protogeni.net/resources/rspec/2/request.xsd",
	"namespace" => "http://www.protogeni.net/resources/rspec/2",
	"extensions" => ["http://www.protogeni.net/resources/rspec/ext/emulab/1"]
    };
124
125
126
127
128
    my $request_3 = {
	"type" => "GENI",
	"version" => $coder->string("3"),
	"schema" => "http://www.geni.net/resources/rspec/3/request.xsd",
        "namespace" => "http://www.geni.net/resources/rspec/3",
Jonathon Duerig's avatar
Jonathon Duerig committed
129
        "extensions" => ["http://www.protogeni.net/resources/rspec/ext/emulab/1"]
130
    };
131
132
    my $ad_0_1 = {
        "type" => "ProtoGENI",
133
        "version" => $coder->string("0.1"),
134
135
136
137
138
139
        "schema" => "http://www.protogeni.net/resources/rspec/0.1/ad.xsd",
        "namespace" => "http://www.protogeni.net/resources/rspec/0.1",
        "extensions" => []
    };
    my $ad_0_2 = {
        "type" => "ProtoGENI",
140
        "version" => $coder->string("0.2"),
141
142
143
144
145
146
        "schema" => "http://www.protogeni.net/resources/rspec/0.2/ad.xsd",
        "namespace" => "http://www.protogeni.net/resources/rspec/0.2",
        "extensions" => []
    };
    my $ad_2 = {
        "type" => "ProtoGENI",
147
        "version" => $coder->string("2"),
148
149
        "schema" => "http://www.protogeni.net/resources/rspec/2/ad.xsd",
        "namespace" => "http://www.protogeni.net/resources/rspec/2",
Jonathon Duerig's avatar
Jonathon Duerig committed
150
        "extensions" => ["http://www.protogeni.net/resources/rspec/ext/emulab/1"]
151
    };
152
153
154
155
156
157
158
    my $ad_3 = {
	"type" => "GENI",
	"version" => $coder->string("3"),
	"schema" => "http://www.geni.net/resources/rspec/3/ad.xsd",
        "namespace" => "http://www.geni.net/resources/rspec/3",
        "extensions" => ["http://www.protogeni.net/resources/rspec/ext/emulab/1"]
    };
159

160
161
162
163
164
165
166
    my $request_name = "request_rspec_versions";
    my $ad_name = "ad_rspec_versions";
    if ($API_VERSION > 1) {
	$request_name = "geni_request_rspec_versions";
	$ad_name = "geni_ad_rspec_versions";
    }

167
    my $blob = {
168
169
170
171
172
173
174
175
	"geni_api"   => $API_VERSION,
	"urn"        => $me->urn(),
	"hrn"        => $me->hrn(),
	"url"        => $url,
	"interface"  => "aggregate",
	"code_tag"   => $commithash,
	# XXX
	"hostname"   => $hostname,
176
177
178
179
180
181
182
	$request_name => [$request_0_1, $request_0_2, $request_2,
			   $request_3],
	$ad_name => [$ad_0_1, $ad_0_2, $ad_2, $ad_3],
	"geni_api_versions" => {
	    "1" => "$url/1.0",
	    "2" => "$url/2.0"
	}
183
    };
184
185
    $blob->{"peers"} = $peers
	if ($MAINSITE);
186
187
188
189
190
191
192
193
    $blob->{"default_ad_rspec"} = $default_ad
	if ($API_VERSION == 1);

    my $response = GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    if ($API_VERSION > 1) {
	$response->{"geni_api"} = $API_VERSION;
    }
    return $response;
194
195
}

Tom Mitchell's avatar
Tom Mitchell committed
196
197
# List this aggregates resources. Invokes GeniCMV2::Resolve or
# GeniCMV2::DiscoverResources.
Tom Mitchell's avatar
Tom Mitchell committed
198
199
sub ListResources()
{
200
    my ($credentials, $options) = @_;
201
202
    if (! defined($credentials) || ! defined($options)
	|| ($API_VERSION > 1 && ! defined($options->{'geni_rspec_version'}))) {
203
204
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
Tom Mitchell's avatar
Tom Mitchell committed
205
206
    my $available = $options->{'geni_available'};
    my $compress = $options->{'geni_compressed'};
Tom Mitchell's avatar
Tom Mitchell committed
207
    my $slice_urn = $options->{'geni_slice_urn'};
208
209
210
211
    my $version;
    if ($API_VERSION == 1) {
	$version    = $options->{'rspec_version'} || undef;
    } else {
212
	$version    = $options->{'geni_rspec_version'};
213
    }
Tom Mitchell's avatar
Tom Mitchell committed
214

Tom Mitchell's avatar
Tom Mitchell committed
215
    my $xml = undef;
Tom Mitchell's avatar
Tom Mitchell committed
216
217
    if ($slice_urn) {

Tom Mitchell's avatar
Tom Mitchell committed
218
219
220
221
        # If $slice_urn is defined, this turns into a Resolve call.  We
        # need to resolve twice: once to get the sliver urn from the
        # slice, then to get the resources associated with the sliver (a
        # manifest rspec).
Tom Mitchell's avatar
Tom Mitchell committed
222
223
224
225
226
227
228
229
        my $resolve_args = {
            'urn' => $slice_urn,
            'credentials' => $credentials
        };
        my $response = GeniCMV2::Resolve($resolve_args);
        if (GeniResponse::IsError($response)) {
            return $response;
        }
Tom Mitchell's avatar
Tom Mitchell committed
230
231
232
233
        # Get the hash out of the response
        my $slice_hash = GeniResponse::value($response);
        my $sliver = $slice_hash->{'sliver_urn'};
        # Resolve the sliver to get the manifest RSpec
Tom Mitchell's avatar
Tom Mitchell committed
234
235
        $resolve_args->{'urn'} = $sliver;
        $response = GeniCMV2::Resolve($resolve_args);
Tom Mitchell's avatar
Tom Mitchell committed
236
237
        if (GeniResponse::IsError($response)) {
            return $response;
Tom Mitchell's avatar
Tom Mitchell committed
238
        }
Tom Mitchell's avatar
Tom Mitchell committed
239
        $xml = GeniResponse::value($response)->{'manifest'};
Tom Mitchell's avatar
Tom Mitchell committed
240

241
    } else {
242
243
	my $pgversion = undef;
	if (! defined($version)) {
244
	    $pgversion = "2";
245
	} elsif (defined($version->{'type'}) &&
246
247
		 (lc($version->{'type'}) eq "protogeni"
		  || lc($version->{'type'}) eq "geni")) {
248
249
250
251
252
	    $pgversion = $version->{'version'};
	} else {
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					"Only ProtoGENI RSpec advertisements are supported");
	}
Tom Mitchell's avatar
Tom Mitchell committed
253
        # No slice was specified, so get the advertisement RSpec.
Tom Mitchell's avatar
Tom Mitchell committed
254
255
        my $discover_args = {
            'credentials' => $credentials,
256
            'available' => $available,
257
	    'rspec_version' => $pgversion,
Tom Mitchell's avatar
Tom Mitchell committed
258
259
260
261
262
        };
        my $response = GeniCMV2::DiscoverResources($discover_args);
        if (GeniResponse::IsError($response)) {
            return $response;
        } else {
Tom Mitchell's avatar
Tom Mitchell committed
263
            $xml = GeniResponse::value($response)
Tom Mitchell's avatar
Tom Mitchell committed
264
265
        }

266
    }
Tom Mitchell's avatar
Tom Mitchell committed
267
268
269
270
271
272
273
274
275
276
277
278
279

    # Was compression requested?
    if (defined($compress) && ref($compress) eq 'Frontier::RPC2::Boolean') {
	$compress = $compress->value;
    }
    # If compression was requested, do it. The result is a String
    # whose contents are a base64 encoding of a zlib compressed RSpec.
    if ($compress) {
        my $coder = Frontier::RPC2->new();
        $xml = encode_base64( compress( $xml ) );
    }
    # Finally, return the RSpec
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, $xml);
Tom Mitchell's avatar
Tom Mitchell committed
280
281
}

282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
sub auto_add_sa($)
{
    my ($cred_str) = @_;
    my $verify_sig = 1;
    my $cred = GeniCredential->CreateFromSigned($cred_str, $verify_sig);
    my $signers = $cred->signer_certs();

    # The credential has been verified, so the signer derives from a
    # trusted root.
    my $sa_cert = @$signers[0];

    # These are borrowed from protogeni/scripts/addauthority
    my $certificate = GeniCertificate->LoadFromString($sa_cert);
    if (!defined($certificate)) {
        print STDERR "auto_add_sa: could not get certificate from $sa_cert\n";
        return;
    }
    if (! ($certificate->uuid() =~ /\w*-(\w*)$/)) {
        print STDERR "auto_add_sa: could not get prefix from uuid\n";
        return;
    }
    my $url = $certificate->URL();
    if (!defined($url)) {
305
        print STDERR "auto_add_sa: certificate does not have a URL extension\n";
306
    }
307
308
    my $urn = $certificate->urn();
    if (!defined($urn)) {
309
        print STDERR "auto_add_sa: certificate does not have a URN extension\n";
310
311
        return;
    }
312
313
314
315
316
317
318
319
320
321
    # Look to see if already registered.
    my $authority = GeniAuthority->Lookup($urn);
    if (defined($authority)) {
	#
	# See if the certificate has changed. If so we want to replace it.
	#
	return
	    if ($certificate->SameCert($authority->GetCertificate()));

	#
322
323
324
325
326
	# Want to reuse the old uuid since we use it as a table cross
	# reference index. Eventually need to use the URN. Anyway, change
	# the uuid in the new certificate so that it goes into the DB
	# with the original one. Then update the Authority record with
	# the new certificate.
327
	#
328
329
330
331
332
333
334
	print STDERR "Updating $authority with new certificate: $certificate\n";
	
	$certificate->setuuid($authority->uuid());
	if ($authority->UpdateCertificate($certificate)) {
	    print STDERR "Failed to update $authority with $certificate\n";
	    return;
	}
335
336
	return;
    }
337
338
339
    #
    # We want the URL! 
    #
340
341
342
    goto goturl
	if (defined($url));
    
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
    # First get the list of registries from PLC.
    my $registry = GeniRegistry::PLC->Create();
    if (!defined($registry)) {
	print STDERR "Cannot create a PLC registry object\n";
	return;
    }
    my $blob;
    if ($registry->GetRegistries(\$blob)) {
	print STDERR "Cannot get PLC registry listing\n";
	return;
    }
    print STDERR Dumper($blob);

    #
    # Now look at the last signer certificate; this is the actual authority.
    #
    my $authcertstr = @$signers[scalar(@$signers) - 1];
    my $authcert = GeniCertificate->LoadFromString($authcertstr);
    if (!defined($authcert)) {
362
363
        print STDERR
	    "auto_add_sa: could not get certificate from $authcertstr\n";
364
365
366
367
368
369
370
        return;
    }
    my $authurn = $authcert->urn();
    if (!defined($authurn)) {
        print STDERR "auto_add_sa: $authcert does not have a URN extension\n";
        return;
    }
371

372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
    #
    # Now search ...
    #
    foreach my $ref (@$blob) {
	if ($ref->{'urn'} eq $authurn) {
	    $url = $ref->{'url'};
	    last;
	}
    }
    if (!defined($url)) {
        print STDERR "auto_add_sa: could not get a URL for $authcert\n";
	return;
    }
    #
    # Gack. Replace the URL with a modified URL which says https.
    # Why does PLC set the scheme to http?
    #
389
  goturl:
390
391
392
393
    my $uri = URI->new($url);
    $uri->scheme("https");
    $url = "$uri";
    
394
395
396
397
398
399
400
    if (!GeniAuthority->Create($certificate, $url, "sa")) {
        print STDERR "auto_add_sa: unable to add authority\n";
        return;
    }
    return $certificate;
}

401
402
403
# Create a sliver by allocating and starting resources.
sub CreateSliver()
{
404
405
406
407
408
409
    my ($slice_urn, $credentials, $rspec, $users, $options) = @_;
    if (! defined($slice_urn) || ! defined($credentials)
	|| ! defined($rspec) || ! defined($users)
	|| (! defined($options) && $API_VERSION > 1)) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
410

411
412
413
414
415
416
417
    foreach my $cred (@$credentials) {
        # If we want to remove the SA(s) after this call, push them
        # onto a list here and remove them at the end of this
        # function. The other AM calls do not need the dynamically
        # added SA.
        auto_add_sa($cred);
    }
418
419
420
421
422

    # Package the caller_keys in a list of hashes the way the CM wants
    # it. Each hash has two keys ('type' and 'key'). 'type' is always
    # 'ssh' for us, and 'key' is the key.
    my $sliver_keys = undef;
423
424
425
426
427
    if (@$users) {
	$sliver_keys = [];
	foreach my $user (@$users) {
	    my $user_urn  = $user->{'urn'};
	    my @user_keys = ();
428

429
430
431
432
433
434
435
436
437
	    foreach my $key (@{ $user->{keys} }) {
		# The CMV2 does not like newlines at the end of the keys.
		chomp($key);
		push(@user_keys, {'type' => 'ssh', 'key' => $key});
	    }
	    push(@{$sliver_keys}, {'urn'  => $user_urn,
				   'keys' => \@user_keys});
	}
    }
438
439
440
441
    # Invoke CreateSliver
    my $create_args = {
        'slice_urn' => $slice_urn,
        'rspec' => $rspec,
442
443
        'credentials' => $credentials,
        'keys' => $sliver_keys
444
445
    };
    my $response = GeniCMV2::CreateSliver($create_args);
446
447
448
449
450
    if (!ref($response)) {
	# This is cause GeniCMV2::CreateSliver does a fork, and the child
	# returns plain status code, which should go to our caller. 
	return $response;
    }
451
452
453
454
455
456
    if (GeniResponse::IsError($response)) {
        # The create failed, so return the response.
        return $response
    }

    # The create succeeded so gather the response info
457
458
    my $listref = GeniResponse::value($response);
    my ($sliver_credential, $manifest_rspec) = @{$listref};
459
460
461
    return GeniResponse->Create( GENIRESPONSE_SUCCESS, $manifest_rspec );
}

Tom Mitchell's avatar
Tom Mitchell committed
462
463
464
# Just delegate to CMV2::DeleteSlice. If we ever change to sliver_urns
# for this call, we'll probably want to call CMV2::DeleteSliver
# instead.
465
466
sub DeleteSliver()
{
467
468
469
470
471
    my ($slice_urn, $credentials, $options) = @_;
    if (! defined($slice_urn) || ! defined($credentials)
	|| (! defined($options) && $API_VERSION > 1)) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
472
473
474
475
476

    my $delete_args = {
        'slice_urn' => $slice_urn,
        'credentials' => $credentials
    };
Tom Mitchell's avatar
Tom Mitchell committed
477
    my $response = GeniCMV2::DeleteSlice($delete_args);
478
    if (GeniResponse::IsError($response)) {
479
480
481
482
483
        return $response;
    } else {
        # Return an XML-RPC boolean
        my $coder = Frontier::RPC2->new();
        return GeniResponse->Create(GENIRESPONSE_SUCCESS, $coder->boolean(1));
484
485
486
    }
}

Leigh B Stoller's avatar
Leigh B Stoller committed
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
# No prototype because it is recursive and as such, the prototype
# causes a warning.
#
# Return a hash containing a JSONish representation of the given node.
sub XmlToJson
{
    my ($node) = @_;
 
    my $attrs = {};
    foreach my $attr ($node->attributes) {
        $attrs->{$attr->nodeName()} = $attr->nodeValue();
    }

    my $children = [];
    foreach my $child ($node->childNodes) {
        if ($child->nodeType() == XML_ELEMENT_NODE) {
            push(@$children, XmlToJson($child));
        }
    }

    my $result = {
        "name" => $node->nodeName(),
        "attributes" => $attrs,
        "children" => $children
    };
    return $result;
}

515
516
517
518
# Get the status of the sliver associated with the given slice. This
# just passes on to the CM SliverStatus operation.
sub SliverStatus()
{
519
520
521
522
523
    my ($slice_urn, $credentials, $options) = @_;
    if (! defined($slice_urn) || ! defined($credentials)
	|| (! defined($options) && $API_VERSION > 1)) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
524
525
526
527
528

    my $status_args = {
        'slice_urn' => $slice_urn,
        'credentials' => $credentials,
    };
529
530
531
532
533
534
535
536
    my $response = GeniCMV2::SliverStatus($status_args);
    if (GeniResponse::IsError($response)) {
        return $response
    }
    # $status is a hash ref
    my $pgstatus = GeniResponse::value($response);
    my $status = {};

Leigh B Stoller's avatar
Leigh B Stoller committed
537
    $status->{'geni_urn'} = $slice_urn;
538
539

    # Determine geni_status. XXX how to determine 'configuring'?
Tom Mitchell's avatar
Tom Mitchell committed
540
    if ($pgstatus->{'status'} eq 'ready') {
541
        $status->{'geni_status'} = 'ready';
Tom Mitchell's avatar
Tom Mitchell committed
542
    } elsif ($pgstatus->{'status'} eq 'failed') {
543
544
545
546
547
        $status->{'geni_status'} = 'failed';
    } else {
        $status->{'geni_status'} = 'unknown';
    }

Leigh B Stoller's avatar
Leigh B Stoller committed
548
549
550
    # include the pg status
    $status->{'pg_status'} = $pgstatus->{'status'};

551
    # include the expiration, converting to UTC
Leigh B Stoller's avatar
Leigh B Stoller committed
552
    my $slice = GeniSlice->Lookup($slice_urn);
553
    my @expires = gmtime(str2time($slice->expires()));
554
    my $expires_str = POSIX::strftime("%Y-%m-%dT%H:%M:%S", @expires);
555
    $status->{'pg_expires'} = $expires_str;
Leigh B Stoller's avatar
Leigh B Stoller committed
556

557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
    # Grab the keys (logins) for inclusion.
    my $slice_experiment = $slice->GetExperiment();
    if (!defined($slice_experiment)) {
	print STDERR "*** No Experiment for $slice\n";
    }
    else {
	my $bindings;
	if ($slice_experiment->NonLocalUsers(\$bindings)) {
	    print STDERR "*** No bindings for $slice_experiment\n";
	}
	elsif (@{ $bindings }) {
	    $status->{'users'} = $bindings;
	}
    }

572
573
574
575
576
577
578
579
    my $details = $pgstatus->{'details'};
    my @children = ();
    while ( my ($pgurn, $pgrstat) = each(%$details) ) {
        my $child = {
            'geni_urn' => $pgurn,
            # XXX Need to massage status to one of the AM status values
            'geni_status' => $pgrstat->{'status'},
            'geni_error' => $pgrstat->{'error'},
Leigh B Stoller's avatar
Leigh B Stoller committed
580
            'pg_status' => $pgrstat->{'status'},
581
        };
582
583
584
585
586
587
588
589
        # Look up the sliver so we can extract info from the manifest.
        my $sliver = GeniSliver->Lookup($pgurn);
	if (!defined($sliver)) {
	    $sliver = GeniAggregate->Lookup($pgurn);
	}
	# Signal an error?
	next
	    if (!defined($sliver));
Leigh B Stoller's avatar
Leigh B Stoller committed
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608

        # Put manifest info in...
        my $manifest = $sliver->GetManifest(0);
        if (0) {
            # An example of how to include a single element from the
            # manifest. Abondoned this approach and went to XmlToJson
            # instead. Finds the "login", then the "hostname" inside
            # the rspec
            my $login = GeniXML::FindNodes(".//n:services//n:login", $manifest);
            if (defined($login)) {
                my $login = @$login[0];
                my $host = GeniXML::GetText("hostname", $login);
                if (defined($host)) {
                    $child->{'pg_hostname'} = $host;
                }
            }
        }
        $child->{'pg_manifest'} = XmlToJson($manifest);
        #$child->{'pg_xml_manifest'} = GeniXML::Serialize($manifest);
609
610
611
612
        push @children, $child;
    }
    $status->{'geni_resources'} = \@children;

613
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, $status);
614
615
616
617
}

sub RenewSliver()
{
618
619
620
621
622
623
    my ($slice_urn, $credentials, $expiration_time, $options) = @_;
    if (! defined($slice_urn) || ! defined($credentials)
	|| ! defined($expiration_time)
	|| (! defined($options) && $API_VERSION > 1)) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
624
625
626
627
628
629
630
631

    my $renew_args = {
        'slice_urn' => $slice_urn,
        'expiration' => $expiration_time,
        'credentials' => $credentials
    };
    my $response = GeniCMV2::RenewSlice($renew_args);
    if (GeniResponse::IsError($response)) {
Tom Mitchell's avatar
Tom Mitchell committed
632
        return $response;
633
634
    }

635
    # Return an XML-RPC boolean
636
637
    my $coder = Frontier::RPC2->new();
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, $coder->boolean(1));
638
639
640
641
}

sub Shutdown()
{
642
643
644
645
646
    my ($slice_urn, $credentials, $options) = @_;
    if (! defined($slice_urn) || ! defined($credentials)
	|| (! defined($options) && $API_VERSION > 1)) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
647

Tom Mitchell's avatar
Tom Mitchell committed
648
649
650
651
652
653
654
655
656
657
658
659
    my $shutdown_args = {
        'slice_urn' => $slice_urn,
        'credentials' => $credentials
    };
    my $response = GeniCMV2::Shutdown($shutdown_args);
    if (GeniResponse::IsError($response)) {
        return $response;
    }

    # Return an XML-RPC boolean
    my $coder = Frontier::RPC2->new();
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, $coder->boolean(1));
660
661
}

662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
sub CreateImage()
{
    my ($slice_urn, $imagename, $sliver_urn, $credentials, $options) = @_;
    if (! defined($slice_urn) || ! defined($credentials) ||
	! defined($sliver_urn) || ! defined($imagename)
	|| (! defined($options) && $API_VERSION > 1)) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }

    my $args = {
        'slice_urn' => $slice_urn,
        'sliver_urn' => $sliver_urn,
        'imagename' => $imagename,
        'credentials' => $credentials
    };
    my $response = GeniCMV2::CreateImage($args);
    if (GeniResponse::IsError($response)) {
        return $response;
    }

    # Return an XML-RPC boolean
    my $coder = Frontier::RPC2->new();
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, $coder->boolean(1));
}

687
688
# _Always_ make sure that this 1 is at the end of the file...
1;