GeniAM.pm.in 41.3 KB
Newer Older
1
2
#!/usr/bin/perl -wT
#
3
# Copyright (c) 2008-2013 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
40
41
42
#
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 ( );

43
use GeniStd;
44
45
use GeniCMV2;
use GeniResponse;
Tom Mitchell's avatar
Tom Mitchell committed
46
use GeniCredential;
47
48
use GeniRegistry;
use emutil;
Tom Mitchell's avatar
Tom Mitchell committed
49
50
51

use Compress::Zlib;
use MIME::Base64;
Leigh B Stoller's avatar
Leigh B Stoller committed
52
use XML::LibXML;
53
use Date::Parse;
54
use Data::Dumper;
55
use Frontier::RPC2;
56
use POSIX qw(strftime);
Jonathon Duerig's avatar
Jonathon Duerig committed
57
58
59
60
use File::Temp qw(tempfile);

my $TB             = "@prefix@";
my $RSPECLINT      = "$TB/sbin/protogeni/rspeclint";
61

Tom Mitchell's avatar
Tom Mitchell committed
62
63
64
# Disable UUID checks in GeniCredential.
$GeniCredential::CHECK_UUID = 0;

65
my $API_VERSION = 2;
66
my $MAINSITE    = @TBMAINSITE@;
67

68
69
70
71
72
sub SetGeniVersion($)
{
    my ($new_version) = @_;
    if ($new_version eq "1.0") {
	$API_VERSION = 1;
73
74
75
76
77
78
    } elsif ($new_version eq "2.0") {
	$API_VERSION = 2;
    } elsif ($new_version eq "3.0") {
	$API_VERSION = 3;
    } else {
	$API_VERSION = 4;
79
80
81
    }
}

82
83
84
85
86
87
88
#
# 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()
{
89
90
    # $options is optional here for all versions
    my ($options) = @_;
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
    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/;

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

133
134
    my $default_ad = {
	"type" => "ProtoGENI",
135
	"version" => $coder->string("2") };
136
137
    my $request_0_1 = {
	"type" => "ProtoGENI",
138
	"version" => $coder->string("0.1"),
139
140
141
142
143
144
	"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",
145
	"version" => $coder->string("0.2"),
146
147
148
149
150
151
	"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",
152
	"version" => $coder->string("2"),
153
154
155
156
	"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"]
    };
157
158
159
160
161
    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
162
        "extensions" => ["http://www.protogeni.net/resources/rspec/ext/emulab/1"]
163
    };
164
165
    my $ad_0_1 = {
        "type" => "ProtoGENI",
166
        "version" => $coder->string("0.1"),
167
168
169
170
171
172
        "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",
173
        "version" => $coder->string("0.2"),
174
175
176
177
178
179
        "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",
180
        "version" => $coder->string("2"),
181
182
        "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
183
        "extensions" => ["http://www.protogeni.net/resources/rspec/ext/emulab/1"]
184
    };
185
186
187
188
189
190
191
    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"]
    };
192

193
194
195
196
197
198
199
    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";
    }

200
    my $blob = {
201
202
203
204
205
206
207
208
	"geni_api"   => $API_VERSION,
	"urn"        => $me->urn(),
	"hrn"        => $me->hrn(),
	"url"        => $url,
	"interface"  => "aggregate",
	"code_tag"   => $commithash,
	# XXX
	"hostname"   => $hostname,
209
210
211
212
213
	$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",
214
215
	    "2" => "$url/2.0",
	    "3" => "$url/3.0"
216
	}
217
    };
218
219
    $blob->{"peers"} = $peers
	if ($MAINSITE);
220
221
222
    $blob->{"default_ad_rspec"} = $default_ad
	if ($API_VERSION == 1);

223
    if ($API_VERSION >= 3) {
224
	$blob->{"geni_single_allocation"} = $coder->string("1");
Jonathon Duerig's avatar
Jonathon Duerig committed
225
	$blob->{"geni_allocate"} = "geni_disjoint";
226
227
228
229
230
231
	$blob->{"geni_credential_types"} = [
	    {"geni_type" => "geni_sfa",
	     "geni_version" => $coder->string("2")},
	    {"geni_type" => "geni_sfa",
	     "geni_version" => $coder->string("3")}
	    ];
232
    }
233
234
235
236
237
    my $response = GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    if ($API_VERSION > 1) {
	$response->{"geni_api"} = $API_VERSION;
    }
    return $response;
238
239
}

Tom Mitchell's avatar
Tom Mitchell committed
240
241
# List this aggregates resources. Invokes GeniCMV2::Resolve or
# GeniCMV2::DiscoverResources.
Tom Mitchell's avatar
Tom Mitchell committed
242
243
sub ListResources()
{
244
245
    my ($credential_args, $options) = @_;
    if (! defined($credential_args) || ! defined($options)
246
	|| ($API_VERSION > 1 && ! defined($options->{'geni_rspec_version'}))) {
247
248
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
Tom Mitchell's avatar
Tom Mitchell committed
249
250
    my $available = $options->{'geni_available'};
    my $compress = $options->{'geni_compressed'};
Tom Mitchell's avatar
Tom Mitchell committed
251
    my $slice_urn = $options->{'geni_slice_urn'};
252
253
254
255
    my $version;
    if ($API_VERSION == 1) {
	$version    = $options->{'rspec_version'} || undef;
    } else {
256
	$version    = $options->{'geni_rspec_version'};
257
    }
Tom Mitchell's avatar
Tom Mitchell committed
258

259
260
    my $credentials = $credential_args;
    if ($API_VERSION >= 3) {
261
	$credentials = GeniStd::FilterCredentials($credential_args);
262
263
    }

Tom Mitchell's avatar
Tom Mitchell committed
264
    my $xml = undef;
Tom Mitchell's avatar
Tom Mitchell committed
265
    if ($slice_urn) {
266
	main::AddLogfileMetaData("slice_urn", $slice_urn);
Tom Mitchell's avatar
Tom Mitchell committed
267

Tom Mitchell's avatar
Tom Mitchell committed
268
269
270
271
        # 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
272
273
274
275
276
277
278
279
        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
280
281
282
283
        # 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
284
285
        $resolve_args->{'urn'} = $sliver;
        $response = GeniCMV2::Resolve($resolve_args);
Tom Mitchell's avatar
Tom Mitchell committed
286
287
        if (GeniResponse::IsError($response)) {
            return $response;
Tom Mitchell's avatar
Tom Mitchell committed
288
        }
Tom Mitchell's avatar
Tom Mitchell committed
289
        $xml = GeniResponse::value($response)->{'manifest'};
Tom Mitchell's avatar
Tom Mitchell committed
290

291
    } else {
292
293
	my $pgversion = undef;
	if (! defined($version)) {
294
	    $pgversion = "2";
295
	} elsif (defined($version->{'type'}) &&
296
		 defined($version->{'version'}) &&
297
298
		 (lc($version->{'type'}) eq "protogeni"
		  || lc($version->{'type'}) eq "geni")) {
299
300
301
302
303
	    $pgversion = $version->{'version'};
	} else {
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					"Only ProtoGENI RSpec advertisements are supported");
	}
Tom Mitchell's avatar
Tom Mitchell committed
304
        # No slice was specified, so get the advertisement RSpec.
Tom Mitchell's avatar
Tom Mitchell committed
305
306
        my $discover_args = {
            'credentials' => $credentials,
307
            'available' => $available,
308
	    'rspec_version' => $pgversion,
Tom Mitchell's avatar
Tom Mitchell committed
309
310
311
312
313
        };
        my $response = GeniCMV2::DiscoverResources($discover_args);
        if (GeniResponse::IsError($response)) {
            return $response;
        } else {
Tom Mitchell's avatar
Tom Mitchell committed
314
            $xml = GeniResponse::value($response)
Tom Mitchell's avatar
Tom Mitchell committed
315
316
        }

317
    }
Tom Mitchell's avatar
Tom Mitchell committed
318
319
320
321
322
323
324
325
326
327
328
329
330

    # 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
331
332
}

333
334
335
336
###############################################################################
# AM API V2
###############################################################################

337
338
339
# Create a sliver by allocating and starting resources.
sub CreateSliver()
{
340
341
342
343
344
345
    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");
    }
346

347
348
349
350
351
    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.
352
        GeniStd::auto_add_sa($cred);
353
    }
354
355
356
357
358

    # 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;
359
360
361
362
363
    if (@$users) {
	$sliver_keys = [];
	foreach my $user (@$users) {
	    my $user_urn  = $user->{'urn'};
	    my @user_keys = ();
364

365
366
367
368
369
370
371
372
373
	    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});
	}
    }
374
375
376
377
    # Invoke CreateSliver
    my $create_args = {
        'slice_urn' => $slice_urn,
        'rspec' => $rspec,
378
379
        'credentials' => $credentials,
        'keys' => $sliver_keys
380
381
    };
    my $response = GeniCMV2::CreateSliver($create_args);
382
383
384
385
386
    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;
    }
387
388
389
390
391
392
    if (GeniResponse::IsError($response)) {
        # The create failed, so return the response.
        return $response
    }

    # The create succeeded so gather the response info
393
394
    my $listref = GeniResponse::value($response);
    my ($sliver_credential, $manifest_rspec) = @{$listref};
395
396
397
    return GeniResponse->Create( GENIRESPONSE_SUCCESS, $manifest_rspec );
}

Tom Mitchell's avatar
Tom Mitchell committed
398
399
400
# Just delegate to CMV2::DeleteSlice. If we ever change to sliver_urns
# for this call, we'll probably want to call CMV2::DeleteSliver
# instead.
401
402
sub DeleteSliver()
{
403
404
405
406
407
    my ($slice_urn, $credentials, $options) = @_;
    if (! defined($slice_urn) || ! defined($credentials)
	|| (! defined($options) && $API_VERSION > 1)) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
408
409
410
411
412

    my $delete_args = {
        'slice_urn' => $slice_urn,
        'credentials' => $credentials
    };
Tom Mitchell's avatar
Tom Mitchell committed
413
    my $response = GeniCMV2::DeleteSlice($delete_args);
414
    if (GeniResponse::IsError($response)) {
415
416
417
418
419
        return $response;
    } else {
        # Return an XML-RPC boolean
        my $coder = Frontier::RPC2->new();
        return GeniResponse->Create(GENIRESPONSE_SUCCESS, $coder->boolean(1));
420
421
422
    }
}

Leigh B Stoller's avatar
Leigh B Stoller committed
423
424
425
426
427
428
429
# 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) = @_;
430
    my $coder = Frontier::RPC2->new();
Leigh B Stoller's avatar
Leigh B Stoller committed
431
432
433
 
    my $attrs = {};
    foreach my $attr ($node->attributes) {
434
        $attrs->{$attr->nodeName()} = $coder->string($attr->nodeValue());
Leigh B Stoller's avatar
Leigh B Stoller committed
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
    }

    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;
}

452
453
454
455
# Get the status of the sliver associated with the given slice. This
# just passes on to the CM SliverStatus operation.
sub SliverStatus()
{
456
457
458
459
460
    my ($slice_urn, $credentials, $options) = @_;
    if (! defined($slice_urn) || ! defined($credentials)
	|| (! defined($options) && $API_VERSION > 1)) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
461
462
463
464
465

    my $status_args = {
        'slice_urn' => $slice_urn,
        'credentials' => $credentials,
    };
466
467
468
469
470
471
472
473
    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
474
    $status->{'geni_urn'} = $slice_urn;
475
476

    # Determine geni_status. XXX how to determine 'configuring'?
Tom Mitchell's avatar
Tom Mitchell committed
477
    if ($pgstatus->{'status'} eq 'ready') {
478
        $status->{'geni_status'} = 'ready';
Tom Mitchell's avatar
Tom Mitchell committed
479
    } elsif ($pgstatus->{'status'} eq 'failed') {
480
481
482
483
484
        $status->{'geni_status'} = 'failed';
    } else {
        $status->{'geni_status'} = 'unknown';
    }

Leigh B Stoller's avatar
Leigh B Stoller committed
485
486
    # include the pg status
    $status->{'pg_status'} = $pgstatus->{'status'};
487
488
    $status->{'pg_public_url'} = $pgstatus->{'public_url'}
        if (exists($pgstatus->{'public_url'}));
Leigh B Stoller's avatar
Leigh B Stoller committed
489

490
    # include the expiration, converting to UTC
Leigh B Stoller's avatar
Leigh B Stoller committed
491
    my $slice = GeniSlice->Lookup($slice_urn);
492
    my @expires = gmtime(str2time($slice->expires()));
493
    my $expires_str = POSIX::strftime("%Y-%m-%dT%H:%M:%S", @expires);
494
    $status->{'pg_expires'} = $expires_str;
Leigh B Stoller's avatar
Leigh B Stoller committed
495

496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
    # 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;
	}
    }

511
512
513
514
515
516
517
518
    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
519
            'pg_status' => $pgrstat->{'status'},
520
        };
521
522
523
524
525
526
527
528
        # 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
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547

        # 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);
548
549
550
551
        push @children, $child;
    }
    $status->{'geni_resources'} = \@children;

552
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, $status);
553
554
555
556
}

sub RenewSliver()
{
557
558
559
560
561
562
    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");
    }
563
564
565
566

    my $renew_args = {
        'slice_urn' => $slice_urn,
        'expiration' => $expiration_time,
567
568
        'credentials' => $credentials,
	'alap' => 0,
569
    };
570
571
572
573
574
    # extend as long as possible.
    if (exists($options->{'geni_extend_alap'}) &&
	$options->{'geni_extend_alap'}) {
	$renew_args->{'alap'} = 1;
    }
575
576
    my $response = GeniCMV2::RenewSlice($renew_args);
    if (GeniResponse::IsError($response)) {
Tom Mitchell's avatar
Tom Mitchell committed
577
        return $response;
578
579
    }

580
    # Return an XML-RPC boolean
581
    my $coder = Frontier::RPC2->new();
582
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, $coder->boolean(1));
583
584
585
586
}

sub Shutdown()
{
587
588
589
590
591
    my ($slice_urn, $credentials, $options) = @_;
    if (! defined($slice_urn) || ! defined($credentials)
	|| (! defined($options) && $API_VERSION > 1)) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
592

Tom Mitchell's avatar
Tom Mitchell committed
593
594
595
596
597
598
599
600
601
602
603
604
    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));
605
606
}

607
608
sub CreateImage()
{
609
610
    my ($slice_urn, $imagename, $sliver_urn, $credential_args, $options) = @_;
    if (! defined($slice_urn) || ! defined($credential_args) ||
611
612
613
614
615
	! defined($sliver_urn) || ! defined($imagename)
	|| (! defined($options) && $API_VERSION > 1)) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }

616
617
    my $credentials = $credential_args;
    if ($API_VERSION >= 3) {
618
	$credentials = GeniStd::FilterCredentials($credential_args);
619
620
    }

621
622
623
624
625
626
    my $args = {
        'slice_urn' => $slice_urn,
        'sliver_urn' => $sliver_urn,
        'imagename' => $imagename,
        'credentials' => $credentials
    };
627
628
629
    $args->{'global'} = $options->{'global'}
        if (defined($options) && exists($options->{'global'}));
	
630
    my $response = GeniCMV2::CreateImage($args);
631
    return $response;
632
633
}

634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
sub DeleteImage()
{
    my ($image_urn, $credentials, $options) = @_;
    if (! defined($image_urn) || ! defined($credentials) ||
	(! defined($options) && $API_VERSION > 1)) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }

    my $args = {
        'image_urn' => $image_urn,
        'credentials' => $credentials
    };
    $args->{'creator_urn'} = $options->{'creator_urn'}
        if (defined($options) && exists($options->{'creator_urn'}));
    
    my $response = GeniCMV2::DeleteImage($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));
}

659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
sub ListImages()
{
    my ($user_urn, $credentials, $options) = @_;
    if (! defined($user_urn) || ! defined($credentials) ||
	(! defined($options) && $API_VERSION > 1)) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }

    my $args = {
        'user_urn' => $user_urn,
        'credentials' => $credentials
    };
    my $response = GeniCMV2::ListImages($args);
    return $response;
}

675
676
677
678
679
680
681
682
683
684
685
686
###############################################################################
# AM API V3
###############################################################################

sub Describe
{
    my ($urn_args, $credential_args, $options) = @_;
    if (! defined($urn_args) || ! defined($credential_args)
	|| ! defined($options)) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
    my @urns = @{ $urn_args };
687
    my $credentials = GeniStd::FilterCredentials($credential_args);
688

689
    my $cred = GeniStd::CheckCredentials($credentials);
690
691
692
693
694
695
696
    return $cred
	if (GeniResponse::IsResponse($cred));

    my ($slice, $aggregate) = GeniCMV2::Credential2SliceAggregate($cred);
    return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
				"Slice credential not provided")
	if (! defined($slice));
Jonathon Duerig's avatar
Jonathon Duerig committed
697
698
    return $slice
	if (GeniResponse::IsResponse($slice));
699
700
701
702
703
704
705
706
707
708
    my $ticket = GeniTicket->SliceTicket($slice);
    return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
				"No slivers here")
	if (! defined($ticket) && ! defined($aggregate));

    if (scalar(@urns) != 1 || $urns[0] ne $slice->urn()) {
	return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
				    "Must pass only slice URN");
    }

709
710
711
712
713
    my $manifest;
    if (defined($aggregate)) {
	$aggregate->ComputeState();
	$manifest = $aggregate->GetManifest()
    }
714
715
716
    $manifest = $ticket->rspec()
	if (defined($ticket));
    my @geni_slivers = ();
Jonathon Duerig's avatar
Jonathon Duerig committed
717
718
719
    my $sliver_blob;

    # Add any slivers that are provisioned (exist in the aggregate)
720
721
722
723
724
725
726
    if (defined($aggregate)) {
	my @slivers = ();
	if ($aggregate->SliverList(\@slivers) != 0) {
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					"Could not get slivers list");
	}
	foreach my $sliver (@slivers) {
Jonathon Duerig's avatar
Jonathon Duerig committed
727
	    $sliver_blob = {
728
729
730
731
732
733
734
735
736
		'geni_sliver_urn' => $sliver->sliver_urn(),
		'geni_expires' => $aggregate->expires(),
		'geni_allocation_status' => "geni_provisioned",
		'geni_operational_status' => GetOpState($sliver),
		'geni_error' => ''
	    };
	    push(@geni_slivers, $sliver_blob);
	}
    }
Jonathon Duerig's avatar
Jonathon Duerig committed
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
    # Add any slivers which are allocated (exist in the ticket)
    if (defined($ticket)) {
	# Get expiration date from ticket
	my $parser = XML::LibXML->new;
	my $doc;
	eval {
	    $doc = $parser->parse_string($ticket->asString());
	};
	if ($@) {
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					"Failed to parse ticket string: $@");
	}
	my ($expires_node) = $doc->getElementsByTagName("expires");
	if (!defined($expires_node)) {
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					"Ticket is missing expires node");
	}
	my $expires = $expires_node->to_literal();

	# Get list of slivers from the rspec
	my $rspec = $ticket->rspec();
	my $sliverids = RspecToSlivers(GeniXML::Serialize($rspec));
	foreach my $sliverid (@{ $sliverids }) {
	    $sliver_blob = {
		'geni_sliver_urn' => $sliverid,
		'geni_expires' => $expires,
		'geni_allocation_status' => "geni_allocated",
		'geni_operational_status' => "geni_pending_allocation",
		'geni_error' => ''
	    };
	    push(@geni_slivers, $sliver_blob);
	}
    }

771
772
773
774
775
776
777
778
779
780
781
    my $blob = {
	'geni_rspec' => GeniXML::Serialize($manifest),
	'geni_urn' => $slice->urn(),
	'geni_slivers' => \@geni_slivers
    };
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
}

sub Allocate
{
    my ($slice_urn, $credential_args, $rspec, $options) = @_;
782
783
784
785
786
787
788
789
790
    Update($slice_urn, [], $credential_args, $rspec, $options);
}

sub Update
{
    my ($slice_urn, $urn_args, $credential_args, $rspec, $options) = @_;
    if (! defined($slice_urn) || ! defined($urn_args) ||
	! defined($credential_args) || ! defined($rspec) ||
	! defined($options)) {
791
792
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
793
    my @urns = @{ $urn_args };
794
795
    my $credentials = GeniStd::FilterCredentials($credential_args);
    my $cred = GeniStd::CheckCredentials($credentials);
Jonathon Duerig's avatar
Jonathon Duerig committed
796
797
    return $cred
	if (GeniResponse::IsResponse($cred));
798

799
    my ($slice, $aggregate) = GeniCMV2::Credential2SliceAggregate($cred);
800
    if (defined($slice)) {
801
	main::AddLogfileMetaDataFromSlice($slice);
802
803
804
805
806

	# If a monitor process is running, we are "busy".
	if ($slice->monitor_pid()) {
	    return GeniResponse->MonitorResponse();
	}
807
    }
808

809
810
811
812
813
    # The URN list must be either empty or contain the slice URN.
    if (scalar(@urns) > 1 ||
	(scalar(@urns) == 1 && $urns[0] ne $slice->urn())) {
	return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
				    "Must pass only slice URN");
Jonathon Duerig's avatar
Jonathon Duerig committed
814
    }
815
816
817
818
819
820

    # If the URN list is empty, then we just create new slivers,
    # combining the new rspec with the old.
    my $isCreate = 0;
    if (scalar(@urns) == 0) {
	$isCreate = 1;
Jonathon Duerig's avatar
Jonathon Duerig committed
821
    }
822
823
824
825

    my $response = CheckRspec("REQUEST", $rspec);
    return $response
	if (defined($response));
Jonathon Duerig's avatar
Jonathon Duerig committed
826
827
828
829
830
831
832
833

    my $ticket;
    if (defined($slice)) {
	return $slice
	    if (GeniResponse::IsResponse($slice));
	$ticket = GeniTicket->SliceTicket($slice);
    }

834
    my $combined = $rspec;
Jonathon Duerig's avatar
Jonathon Duerig committed
835
    if (defined($ticket)) {
836
837
838
839
840
841
842
843
	if ($isCreate) {
	    $combined = CombineDisjoint(GeniXML::Serialize($ticket->rspec()),
					$rspec);
	    $response = CheckRspec("COMBINED W/ TICKET", $combined);
	    return $response
		if (defined($response));
	}
	$response = AllocateTicket($slice_urn, $combined, $credentials,
Jonathon Duerig's avatar
Jonathon Duerig committed
844
845
				   $ticket->asString());
    } elsif (defined($aggregate)) {
846
847
848
849
850
851
852
853
	if ($isCreate) {
	    $combined = CombineDisjoint( $aggregate->GetManifest(), $rspec);
	    $response = CheckRspec("COMBINED W/ AGGREGATE", $combined);
	    return $response
		if (defined($response));
	}
	$response = AllocateAggregate($slice_urn, $combined, $credentials,
				      $aggregate->urn());
Jonathon Duerig's avatar
Jonathon Duerig committed
854
855
856
    } else {
	$response = AllocateEmpty($slice_urn, $rspec, $credentials);
    }
857
858
859
860

    if (! GeniResponse::IsError($response)) {
	my $description = Describe([$slice_urn], $credential_args, []);
	if (! GeniResponse::IsError($description)) {
Jonathon Duerig's avatar
Jonathon Duerig committed
861
	    my $rspec = $description->{'value'}->{'geni_rspec'};
862
	    my $blob = {
Jonathon Duerig's avatar
Jonathon Duerig committed
863
		'geni_rspec' => $rspec,
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
		'geni_slivers' => []
	    };
	    for my $sliver (@{ $description->{'value'}->{'geni_slivers'} }) {
		my $out = {
		    'geni_sliver_urn' => $sliver->{'geni_sliver_urn'},
		    'geni_expires' => $sliver->{'geni_expires'},
		    'geni_allocation_status' =>
			$sliver->{'geni_allocation_status'}
		};
		push (@{ $blob->{'geni_slivers'} }, $out);
	    }
	    $response = GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
	} else {
	    $response = $description;
	}
    }
    return $response;
}

Jonathon Duerig's avatar
Jonathon Duerig committed
883
884
885
# Allocate when there is a ticket or ticket+sliver
sub AllocateTicket
{
886
    my ($slice_urn, $combined, $credentials, $ticketStr) = @_;
Jonathon Duerig's avatar
Jonathon Duerig committed
887
888
889
    if (GeniResponse::IsResponse($combined)) {
	return $combined;
    }
890

Jonathon Duerig's avatar
Jonathon Duerig committed
891
892
893
894
895
896
897
898
899
900
901
902
    my $args = {
	'slice_urn' => $slice_urn,
	'ticket' => $ticketStr,
	'rspec' => $combined,
	'credentials' => $credentials
    };
    return GeniCMV2::UpdateTicket($args);
}

# Allocate when there is a sliver but no ticket
sub AllocateAggregate
{
903
    my ($slice_urn, $combined, $credentials, $sliver_urn) = @_;
Jonathon Duerig's avatar
Jonathon Duerig committed
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
    if (GeniResponse::IsResponse($combined)) {
	return $combined;
    }
    my $args = {
	'sliver_urn' => $sliver_urn,
	'rspec' => $combined,
	'credentials' => $credentials
    };
    return GeniCMV2::UpdateSliver($args);
}

# Allocate when there are no slices or slivers
sub AllocateEmpty
{
    my ($slice_urn, $rspec, $credentials) = @_;
    my $args = {
	'slice_urn' => $slice_urn,
	'rspec' => $rspec,
	'credentials' => $credentials
    };

    return GeniCMV2::GetTicket($args);
}

928
929
930
931
932
933
934
sub Renew
{
    my ($urn_args, $credential_args, $expiration_time, $options) = @_;
    if (! defined($urn_args) || ! defined($credential_args) ||
	! defined($expiration_time) || ! defined($options)) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
935
    my $credentials = GeniStd::FilterCredentials($credential_args);
936
    my @urns = @{ $urn_args};
937
    return GeniResponse->MalformedArgsResponse("Empty URN List")
938
939
940
941
	if (scalar(@urns) < 1);
    my $args = {
	'slice_urn' => $urns[0],
	'expiration' => $expiration_time,
942
943
	'credentials' => $credentials,
	'alap' => 0,
944
    };
945
946
947
948
949
    # extend as long as possible.
    if (exists($options->{'geni_extend_alap'}) &&
	$options->{'geni_extend_alap'}) {
	$args->{'alap'} = 1;
    }
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
    my $response = GeniCMV2::RenewSlice($args);
    if (! GeniResponse::IsError($response)) {
	my $description = Describe($urn_args, $credential_args, []);
	if (! GeniResponse::IsError($description)) {
	    $response = GeniResponse->Create(GENIRESPONSE_SUCCESS,
				      $description->{'value'}->{'geni_slivers'});
	} else {
	    $response = $description;
	}
    }
    return $response;
}

sub Provision
{
    my ($urn_args, $credential_args, $options) = @_;
    if (! defined($urn_args) || ! defined($credential_args) ||
	! defined($options)) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
    my @urns = @{ $urn_args };
971
    return GeniResponse->MalformedArgsResponse("Empty URN List")
972
	if (scalar(@urns) < 1);
973
    my $credentials = GeniStd::FilterCredentials($credential_args);
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
    my $users = $options->{'geni_users'};
    my $sliver_keys = [];
    if (defined($users) && @$users) {
	foreach my $user (@$users) {
	    my $user_urn  = $user->{'urn'};
	    my @user_keys = ();

	    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});
	}
    }

991
    my $cred = GeniStd::CheckCredentials($credentials);
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
    return $cred
	if (GeniResponse::IsResponse($cred));

    my ($slice, undef) = GeniCMV2::Credential2SliceAggregate($cred);
    return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
				"Slice credential not provided")
	if (! defined($slice));

    return $slice
	if (GeniResponse::IsResponse($slice));

    if (scalar(@urns) != 1 || $urns[0] ne $slice->urn()) {
	return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
				    "Must pass only slice URN");
    }

    my $ticket = GeniTicket->SliceTicket($slice);
    return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
				"No allocated slivers exist")
	if (! defined($ticket));

    my $args = {
	'slice_urn' => $urns[0],
	'ticket' => $ticket->ticket_string(),
	'credentials' => $credentials,
	'keys' => $sliver_keys
    };

    my $response = GeniCMV2::RedeemTicket($args);
    if (! GeniResponse::IsError($response)) {
	my $description = Describe($urn_args, $credential_args, []);
	if (! GeniResponse::IsError($description)) {
	    my $blob = {
		'geni_rspec' => $description->{'value'}->{'geni_rspec'},
		'geni_slivers' => $description->{'value'}->{'geni_slivers'}
	    };
	    $response = GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
	} else {
	    $response = $description;
	}
    }
    return $response;
}

sub Status
{
    my $response = Describe(@_);
    if (! GeniResponse::IsError($response)) {
	my $blob = {
	    'geni_urn' => $response->{'value'}->{'geni_urn'},
	    'geni_slivers' => $response->{'value'}->{'geni_slivers'}
	};
	$response = GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
    return $response;
}

sub PerformOperationalAction
{
    my ($urn_args, $credential_args, $action, $options) = @_;
    my @urns = @{ $urn_args };
1053
    return GeniResponse->MalformedArgsResponse("Empty URN List")
1054
1055
	if (scalar(@urns) < 1);

1056
    my $credentials = GeniStd::FilterCredentials($credential_args);
1057
1058
1059
1060
    my $args = {
	'credentials' => $credentials
    };

1061
    my $cred = GeniStd::CheckCredentials($credentials);
1062
1063
1064
    return $cred
	if (GeniResponse::IsResponse($cred));

1065
    my ($slice, $aggregate) = GeniCMV2::Credential2SliceAggregate($cred);
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
    return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
				"Slice credential not provided")
	if (! defined($slice));

    if ($urns[0] eq $slice->urn()) {
	$args->{'slice_urn'} = $slice->urn();
    } else {
	$args->{'sliver_urns'} = $urn_args;
    }

    if ($action eq 'geni_start') {
	return GeniCMV2::StartSliver($args);
Jonathon Duerig's avatar
Jonathon Duerig committed
1078
    } elsif ($action eq 'geni_restart') {
1079
	return GeniCMV2::RestartSliver($args);
Jonathon Duerig's avatar
Jonathon Duerig committed
1080
    } elsif ($action eq 'geni_stop') {
1081
	return GeniCMV2::StopSliver($args);
1082
    } elsif ($action eq 'geni_update_users') {
1083
	if (!exists($options->{"geni_users"})) {
1084
1085
	    return GeniResponse->MalformedArgsResponse("No keys provided!");
	}
1086
	my $users = $options->{'geni_users'};
1087
1088
1089
	if (! (ref($users) && ref($users) eq "ARRAY")) {
	    return GeniResponse->MalformedArgsResponse("Malformed keys!");
	}
1090
	my $sliver_keys = [];
1091
1092
1093
1094
1095
1096
1097
1098
	foreach my $user (@$users) {
	    my $user_urn  = $user->{'urn'};
	    my @user_keys = ();
	    
	    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});
1099
	    }
1100
1101
	    push(@{$sliver_keys}, {'urn'  => $user_urn,
				   'keys' => \@user_keys});
1102
	}
1103
	$args->{'slice_urn'} = $slice->urn();
1104
	$args->{'keys'}      = $sliver_keys;
1105
1106
1107
 	$args->{'amapiv3'}   = 1;
	
	return GeniCMV2::BindToSlice($args);
1108
    }
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
    elsif ($action eq 'geni_update_users_cancel') {
	#
	# All we care about is making sure the state is cleared
	# from the aggregate and all of the slivers. 
	#
	if ($slice->Lock() != 0) {
	    return GeniResponse->BusyResponse();
	}
	if ($aggregate->state() ne "updating_users") {
	    $slice->UnLock();
	    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
	}
	if ($aggregate->CancelUpdateAccounts()) {
	    $slice->UnLock();
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
	$slice->UnLock();
	return GeniResponse->Create(GENIRESPONSE_SUCCESS);
    }
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
    elsif ($action eq 'geni_sharelan') {
	if (!exists($options->{"geni_sharelan_lanname"})) {
	    return GeniResponse->MalformedArgsResponse("No lanname provided!");
	}
	if (!exists($options->{"geni_sharelan_token"})) {
	    return GeniResponse->MalformedArgsResponse("No token provided!");
	}
	$args->{'slice_urn'} = $slice->urn();
	$args->{'token'}     = $options->{"geni_sharelan_token"};
	$args->{'lanname'}   = $options->{"geni_sharelan_lanname"};
	
	return GeniCMV2::ShareLan($args);
    }
    elsif ($action eq 'geni_unsharelan') {
	if (!exists($options->{"geni_unsharelan_lanname"})) {
	    return GeniResponse->MalformedArgsResponse("No lanname provided!");
	}
	$args->{'slice_urn'} = $slice->urn();
	$args->{'lanname'}   = $options->{"geni_unsharelan_lanname"};
	
	return GeniCMV2::UnShareLan($args);
    }
1150
1151
    return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
				"Invalid operational action");
1152
1153
1154
1155
1156
1157
}

sub Delete
{
    my ($urn_args, $credential_args, $option_args) = @_;
    my @urns = @{ $urn_args };
1158
    return GeniResponse->MalformedArgsResponse("Empty URN List")
1159
	if (scalar(@urns) < 1);
Jonathon Duerig's avatar
Jonathon Duerig committed
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176

    # Must create return structure before deletion because this data
    # won't exist afterwards.
    my $description = Describe($urn_args, $credential_args, []);
    return $description
	if (GeniResponse::IsError($description));
    my $slivers = [];
    foreach my $sliver (@{ $description->{'value'}->{'geni_slivers'} }) {
	my $blob = {
	    'geni_sliver_urn' => $sliver->{'geni_sliver_urn'},
	    'geni_allocation_status' => 'geni_unallocated',
	    'geni_expires' => $sliver->{'geni_expires'},
	    'geni_error' => ''
	};
	push(@{ $slivers }, $blob);
    }

1177
    my $credentials = GeniStd::FilterCredentials($credential_args);
1178
1179
1180
1181
1182
1183
    my $args = {
	'slice_urn' => $urns[0],
	'credentials' => $credentials
    };
    my $response = GeniCMV2::DeleteSlice($args);
    if (! GeniResponse::IsError($response)) {
Jonathon Duerig's avatar
Jonathon Duerig committed
1184
	$response = GeniResponse->Create(GENIRESPONSE_SUCCESS, $slivers);
1185
1186
1187
1188
    }
    return $response;
}

1189
1190
1191
1192
sub Cancel
{
    my ($urn_args, $credential_args, $option_args) = @_;
    my @urns = @{ $urn_args };
1193
    return GeniResponse->MalformedArgsResponse("Empty URN List")
1194
1195
	if (scalar(@urns) < 1);

1196
1197
    my $credentials = GeniStd::FilterCredentials($credential_args);
    my $cred = GeniStd::CheckCredentials($credentials);
1198
1199
1200
1201
1202
1203
1204
    return $cred
	if (GeniResponse::IsResponse($cred));

    my ($slice, undef) = GeniCMV2::Credential2SliceAggregate($cred);
    my $response;
    my $ticket = GeniTicket->SliceTicket($slice);
    if (defined($ticket)) {
1205
	my $credentials = GeniStd::FilterCredentials($credential_args);
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
	my $args = {
	    'slice_urn' => $urns[0],
	    'ticket' => $ticket->ticket_string(),
	    'credentials' => $credentials
	};
	$response = GeniCMV2::ReleaseTicket($args);
    }
    if (! GeniResponse::IsError($response)) {
	$response = Describe($urn_args, $credential_args, []);
    }
    return $response;
}

1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
# Determines operational state based on the state/status of a sliver.
sub GetOpState
{
    my ($sliver) = @_;
    my $result = 'geni_ready';
    if ($sliver->status() eq 'failed') {
	$result = 'geni_failed';
    } elsif ($sliver->status() eq 'unknown') {
	$result = 'unknown';
    } elsif ($sliver->status() eq 'ready') {
	$result = 'geni_ready';
1230
    } elsif ($sliver->status() eq 'changing'
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
	     && $sliver->state() eq 'started') {
	$result = 'geni_configuring';
    } elsif ($sliver->status() eq 'notready') {
	$result = 'geni_notready';
    } elsif ($sliver->status() eq 'changing'
	     && $sliver->state() eq 'stopped') {
	$result = 'geni_stopping';
    } elsif ($sliver->status() eq 'created'
	     && $sliver->state() eq 'new') {
	$result = 'geni_notready';
1241
1242
1243
    } elsif ($sliver->status() eq 'changing'
	     && $sliver->state() eq 'updating_users') {
	$result = 'geni_updating_users';
1244
1245
1246
1247
    }
    return $result;
}

Jonathon Duerig's avatar
Jonathon Duerig committed
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
# Rspec is expected to be in string form.
# Returns a list of sliver URNs found in the rspec.
sub RspecToSlivers
{
    my $result = [];
    my ($rspecStr) = @_;
    my $rspec = GeniXML::Parse($rspecStr);
    if (defined($rspec)) {
	foreach my $noderef (GeniXML::FindNodes("n:node",
						$rspec)->get_nodelist()) {
	    my $sliver_id = GeniXML::GetSliverId($noderef);
	    if (defined($sliver_id)) {
		push(@{ $result }, $sliver_id);
	    }
	}
    }
    return $result;
}

# Rspec is an XML tree.
# Returns a table of client_ids
sub RspecToClientIds
{
    my $result = {};
    my ($rspec) = @_;
    if (defined($rspec)) {
	my @nodes = GeniXML::FindNodes("n:node",
				       $rspec)->get_nodelist();
	my @links = GeniXML::FindNodes("n:link",
				       $rspec)->get_nodelist();
	my @ifaces = GeniXML::FindNodes("n:node/n:interface",
					$rspec)->get_nodelist();
	push(@nodes, @links, @ifaces);
	foreach my $noderef (@nodes) {
	    my $id = GeniXML::GetVirtualId($noderef);
	    if (defined($id)) {
		$result->{$id} = 1;
	    }
	}
    }
    return $result;    
}

# currentStr and newStr are both rspec strings
# Returns a combined rspec string or a GeniResponse error
sub CombineDisjoint
{
    my ($currentStr, $newStr) = @_;
    my $current = GeniXML::Parse($currentStr);
    my $new = GeniXML::Parse($newStr);
    if (! defined($current) || ! defined($new)) {
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Could not parse rspecs on allocate");
    }
    my $currentIds = RspecToClientIds($current);
    my $newIds = RspecToClientIds($new);
    my $found = 0;
    foreach my $id (keys(%{ $newIds })) {
	if (exists($currentIds->{$id})) {
	    $found = 1;
	    last;
	}
    }
    if ($found) {
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "New rspec is not disjoint from sliver");
    }

    foreach my $child ($new->childNodes()) {
	$current->appendChild($child);
    }

    return GeniXML::Serialize($current);
}

# Returns true if the list of slivers has a slice urn
sub HasSliceUrn
{
    my ($slice, $slivers) = @_;
    my $result = 0;
    foreach my $item (@{ $slivers }) {
	if ($slice->urn() eq $item) {
	    $result = 1;
	    last;
	}
    }
    return $result;
}

# Returns true if left and right are the same set of slivers.
sub SameSlivers
{
    my ($left, $right) = @_;
    my $result = 1;
    my %leftTable = ();
    foreach my $item (@{ $left }) {
	$leftTable{$item} = 1;
    }
    if (scalar(keys(%leftTable)) != scalar(@{ $right })) {
	$result = 0;
    } else {
	foreach my $item (@{ $right }) {
	    if (! exists($leftTable{$item})) {
		$result = 0;
		last;
	    }
	}
    }
    return $result;
}

1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
# Check rspec using rspeclint
# Returns undefined on success or a GeniResponse on error.
sub CheckRspec
{
    my ($type, $rspec) = @_;
    my $result;

    my ($fh, $filename) = tempfile(UNLINK => 0);
    if (!defined($fh)) {
	$result = GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				       "Could not check rspec");
    } else {
	print $fh $rspec;
	close($fh);
	my $rspecerrors = `$RSPECLINT $filename 2>&1`;
	if ($?) {
	    unlink($filename);
	    $result = GeniResponse->Create(GENIRESPONSE_ERROR,
					   $rspecerrors,
					   $type . " rspec does not validate");
	}
	if ($rspecerrors ne "") {
	    print STDERR "--- BEGIN RSPECLINT ERRORS $type ---\n";
	    print STDERR $rspecerrors;
	    print STDERR "--- END RSPECLINT ERRORS $type ---\n\n";
	}
	unlink($filename);
    }
    return $result;
}

1390
1391
# _Always_ make sure that this 1 is at the end of the file...
1;