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

#
# 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 ( );

# Must come after package declaration!
use lib '@prefix@/lib';
use GeniDB;
use GeniResponse;
use GeniTicket;
use GeniCredential;
use GeniCertificate;
27
use GeniComponent;
28
29
30
31
use GeniSlice;
use GeniAggregate;
use GeniSliver;
use GeniUtil;
32
use GeniCM;
33
use GeniHRN;
34
use GeniXML;
35
36
37
38
39
40
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
use emutil;
use English;
use Data::Dumper;
use XML::Simple;
use Date::Parse;
use POSIX qw(strftime tmpnam);
use Time::Local;
use Compress::Zlib;
use MIME::Base64;

# Configure variables
my $TB		   = "@prefix@";
my $TBOPS          = "@TBOPSEMAIL@";
my $TBAPPROVAL     = "@TBAPPROVALEMAIL@";
my $TBAUDIT   	   = "@TBAUDITEMAIL@";
my $BOSSNODE       = "@BOSSNODE@";
my $OURDOMAIN      = "@OURDOMAIN@";
my $PGENIDOMAIN    = "@PROTOGENI_DOMAIN@";
my $CREATEEXPT     = "$TB/bin/batchexp";
my $ENDEXPT        = "$TB/bin/endexp";
my $NALLOC	   = "$TB/bin/nalloc";
my $NFREE	   = "$TB/bin/nfree";
my $AVAIL	   = "$TB/sbin/avail";
my $PTOPGEN	   = "$TB/libexec/ptopgen";
my $TBSWAP	   = "$TB/bin/tbswap";
my $SWAPEXP	   = "$TB/bin/swapexp";
my $PLABSLICE	   = "$TB/sbin/plabslicewrapper";
my $NAMEDSETUP     = "$TB/sbin/named_setup";
my $VNODESETUP     = "$TB/sbin/vnode_setup";
my $GENTOPOFILE    = "$TB/libexec/gentopofile";
my $TARFILES_SETUP = "$TB/bin/tarfiles_setup";
my $MAPPER         = "$TB/bin/mapper";
my $VTOPGEN        = "$TB/bin/vtopgen";
my $SNMPIT         = "$TB/bin/snmpit";
my $PRERENDER      = "$TB/libexec/vis/prerender";
my $EMULAB_PEMFILE = "@prefix@/etc/genicm.pem";
71
72
# Just one of these, at Utah.
my $GENICH_PEMFILE = "@prefix@/etc/genich.pem";
73
my $API_VERSION    = 2;
74
75
76
77
78
79
80
81

#
# 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()
{
82
    my @input_rspec_versions = ( "0.1", "2" );
Gary Wong's avatar
Gary Wong committed
83
84
85
    my $blob = {
	"api" => $API_VERSION,
	"level" => 1,
86
	"input_rspec" => \@input_rspec_versions,
Gary Wong's avatar
Gary Wong committed
87
88
89
	"output_rspec" => "0.1"
    };

90
    return GeniResponse->Create( GENIRESPONSE_SUCCESS, $blob);
91
92
93
94
95
96
97
98
}

#
# Respond to a Resolve request. 
#
sub Resolve($)
{
    my ($argref) = @_;
99
100
    my $credentials = $argref->{'credentials'};
    my $urn         = $argref->{'urn'};
101
    my $admin       = 0;
102
    my $isauth	    = 0;
103

104
105
106
107
108
109
110
111
112
113
    if (! (defined($credentials) && defined($urn))) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
    if (! GeniHRN::IsValid($urn)) {
	return GeniResponse->MalformedArgsResponse("Invalid URN");
    }
    my $credential = CheckCredentials($credentials);
    return $credential
	if (GeniResponse::IsResponse($credential));

114
115
116
    my ($object, $type) = LookupURN($urn);
    return $object
	if (GeniResponse::IsResponse($object));
117
118
119
120

    #
    # This is a convenience for testing. If a local user and that
    # user is an admin person, then do whatever it says. This is
121
122
    # easier then trying to do this with credential privs. But,
    # watch for credentials from authorities instead of users.
123
    #
124
125
126
127
128
129
130
131
132
    my (undef,$callertype,$callerid) = GeniHRN::Parse($credential->owner_urn());
    if ($callertype eq "user") {
	my $user = GeniCM::CreateUserFromCertificate($credential->owner_cert());
	if (defined($user) && $user->IsLocal() && $user->admin()) {
	    $admin = 1;
	}
    }
    elsif ($callertype eq "authority" && $callerid eq "cm") {
	$isauth = 1;
133
    }
134
135
    
    if ($type eq "node") {
136
	my $node  = $object;
137
	my $rspec = GeniCM::GetAdvertisement(0, $node->node_id(), "0.1", undef);
138
	if (! defined($rspec)) {
139
	    print STDERR "Could not get advertisement for $node!\n";
140
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
141
					"Error getting advertisement");
142
	}
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
	my $me = GeniAuthority->Lookup($ENV{'MYURN'});
	if (!defined($me)) {
	    print STDERR
		"Could not find local authority object for $ENV{'MYURN'}\n";
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					"Error getting advertisement");
	}
	my $myurn = GeniHRN::Generate($OURDOMAIN, "node", $node->node_id());
	my $myhrn = "${PGENIDOMAIN}." . $node->node_id();

	#
	# See if the component object exists; if not create it.
	#
	my $component = GeniComponent->Lookup($node->uuid());
	if (!defined($component)) {
	    my $certificate = GeniCertificate->Lookup($node->uuid());
	    if (!defined($certificate)) {
		$certificate =
		    GeniCertificate->Create({'urn'  => $myurn,
					     'hrn'  => $myhrn,
					     'email'=> $TBOPS,
					     'uuid' => $node->uuid(),
					     'url'  => $me->url()});
		if (!defined($certificate)) {
		    print STDERR "Could not generate certificate for $node\n";
		    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					    "Error getting advertisement");
		}
	    }
	    $component = GeniComponent->Create($certificate, $me);
	    if (!defined($component)) {
		print STDERR "Could not create component for $node\n";
		return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					    "Error getting advertisement");
	    }
	}
179
	# Return a blob.
180
	my $blob = { "hrn"          => $myhrn,
181
182
		     "uuid"         => $node->uuid(),
		     "role"	    => $node->role(),
183
184
		     "hostname"     =>
			 GeniUtil::FindHostname($node->node_id()),
185
186
		     "physctrl"     => 
			 Interface->LookupControl($node->phys_nodeid())->IP(),
187
188
189
190
		     "urn"          => $myurn,
		     "rspec"        => $rspec,
		     "url"          => $me->url(),
		     "gid"          => $component->cert(),
191
192
193
194
		   };

	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
195
    if ($type eq "slice") {
196
197
	my $slice = $object;

Leigh B. Stoller's avatar
Leigh B. Stoller committed
198
199
200
201
	#
	# In this implementation, the caller must hold a valid slice
	# credential for the slice being looked up. 
	#
202
203
	if (! ($isauth || $admin ||
	       $slice->urn() eq $credential->target_urn())) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
204
205
206
207
208
209
210
	    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN());
	}
	# Return a blob.
	my $blob = { "urn"          => $urn };

	my $aggregate = GeniAggregate->SliceAggregate($slice);
	if (defined($aggregate)) {
211
	    $blob->{'sliver_urn'} = $aggregate->urn();
212
213
214
215
	    my $manifest = $aggregate->GetManifest(1);
	    if (defined($manifest)) {
		$blob->{'manifest'}   = $manifest;
	    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
216
217
218
	}
	my $ticket = GeniTicket->SliceTicket($slice);
	if (defined($ticket)) {
219
	    $blob->{'ticket_urn'} = $ticket->urn();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
220
221
222
223
	}
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
    if ($type eq "sliver") {
224
225
	my $sliver = $object;

Leigh B. Stoller's avatar
Leigh B. Stoller committed
226
227
228
229
	#
	# In this implementation, the caller must hold a valid slice
	# or sliver credential for the slice being looked up. 
	#
230
	if (! ($admin ||
231
	       $sliver->urn() eq $credential->target_urn() ||
232
	       $sliver->slice_uuid() eq $credential->target_uuid())) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
233
234
	    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN);
	}
235
236
	my $manifest = $sliver->GetManifest(1);
	if (!defined($manifest)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
237
238
239
240
241
242
243
244
245
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
	# Return a blob.
	my $blob = { "urn"          => $urn,
		     "manifest"     => $manifest,
		 };
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
    if ($type eq "ticket") {
246
247
	my $ticket = $object;

Leigh B. Stoller's avatar
Leigh B. Stoller committed
248
249
250
251
	#
	# In this implementation, the caller must hold a valid slice
	# or sliver credential to get the ticket.
	#
252
	my $slice = GeniSlice->Lookup($ticket->slice_urn());
Leigh B. Stoller's avatar
Leigh B. Stoller committed
253
254
255
256
	if (!defined($slice)) {
	    print STDERR "Could not find slice for $ticket\n";
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
257
	if (! ($admin || $slice->urn() eq $credential->target_urn())) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
258
259
260
261
262
	    #
	    # See if its the sliver credential. 
	    #
	    my $aggregate = GeniAggregate->SliceAggregate($slice);
	    if (!defined($aggregate) ||
263
		$aggregate->urn() ne $credential->target_urn()) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
264
265
266
267
268
		return GeniResponse->Create(GENIRESPONSE_FORBIDDEN());
	    }
	}
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $ticket->asString());
    }
269
270
    return GeniResponse->Create(GENIRESPONSE_UNSUPPORTED, undef,
				"Cannot resolve $type at this authority");
271
272
273
274
275
276
277
278
}

#
# Discover resources on this component, returning a resource availablity spec
#
sub DiscoverResources($)
{
    my ($argref) = @_;
279
280
281
    my $credentials = $argref->{'credentials'};
    my $available   = $argref->{'available'} || 0;
    my $compress    = $argref->{'compress'} || 0;
282
    my $version     = $argref->{'rspec_version'} || undef;
283
284
285
286
287
288
289

    if (! (defined($credentials))) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
    my $credential = CheckCredentials($credentials);
    return $credential
	if (GeniResponse::IsResponse($credential));
290

291
292
    my $credential_objects = [];
    foreach my $credstr (@$credentials) {
293
294
295
        my $cred = CheckCredential($credstr);
        push(@$credential_objects, $cred) 
            if(!GeniResponse::IsResponse($cred));
296
297
298
    }
    return GeniCM::DiscoverResourcesAux($available, $compress,
        $credential_objects);
299
300
301
302
303
304
305
306
}

#
# Create a Sliver.
#
sub CreateSliver($)
{
    my ($argref) = @_;
307
308
309
310
311
    my $slice_urn    = $argref->{'slice_urn'};
    my $rspecstr     = $argref->{'rspec'};
    my $credentials  = $argref->{'credentials'};
    my $keys         = $argref->{'keys'};
    my $impotent     = $argref->{'impotent'} || 0;
312
313
    require Node;
    require Experiment;
314
315
    
    # For now, I am not worrying about the slice_urn argument.
316
317
    if (! (defined($credentials) &&
	   defined($slice_urn) && defined($rspecstr))) {
318
319
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
320
321
322
323
324
325
    if (! ($rspecstr =~ /^[\040-\176\012\015\011]+$/)) {
	return GeniResponse->MalformedArgsResponse("Bad characters in rspec");
    }
    if (! GeniHRN::IsValid($slice_urn)) {
	return GeniResponse->MalformedArgsResponse("Bad characters in URN");
    }
326
327
328
    my $credential = CheckCredentials($credentials);
    return $credential
	if (GeniResponse::IsResponse($credential));
329

330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
    #
    # In this implementation, the user must provide a slice credential,
    # so we ignore the slice_urn. For CreateSliver(), the slice must not
    # be instantiated.
    #
    my ($slice,$aggregate) = Credential2SliceAggregate($credential);
    if (defined($slice)) {
	if ($slice_urn ne $slice->urn()) {
	    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
					"Credential does not match the URN");
	}
	if (defined($aggregate)) {
	    return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
					"Must delete existing slice first");
	}
    }
346
    my $rspec = GeniCM::GetTicketAux($credential,
347
				     $rspecstr, 0, $impotent, 1, 0, undef);
348
349
350
    return $rspec
	if (GeniResponse::IsResponse($rspec));

351
352
353
354
    # Make sure that the next phase sees all changes.
    Experiment->FlushAll();
    Node->FlushAll();

355
    my $response = GeniCM::SliverWorkAux($credential,
356
					 $rspec, $keys, 0, $impotent, 1, 0);
357

358
359
360
361
362
363
364
    if (GeniResponse::IsError($response)) {
	#
	# We have to make sure there is nothing left over since there
	# is no actual ticket, so the resources will not get cleaned
	# up by the daemon. This is mostly cause I am reaching into
	# the V1 code, and its messy.
	#
365
	my $slice = GeniSlice->Lookup($credential->target_urn());
366
367
368
369
370
371
372
	if ($slice->Lock() != 0) {
	    print STDERR "CreateSliver: Could not lock $slice before delete\n";
	    return $response;
	}
	if (defined($slice)) {
	    GeniCM::CleanupDeadSlice($slice, 1);
	}
373
	return $response;
374
    }
375
376
    my ($sliver_credential, $sliver_manifest) = @{ $response->{'value'} };
    
377
378
379
    #
    # Leave the slice intact on error, so we can go look at it. 
    #
380
    $slice = GeniSlice->Lookup($credential->target_urn());
381
382
383
384
385
386
387
388
389
390
    if (!defined($slice)) {
	print STDERR "CreateSliver: Could not find slice for $credential\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Internal Error");
    }
    if ($slice->Lock() != 0) {
	print STDERR "CreateSliver: Could not lock $slice before start\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Internal Error");
    }
391
    $aggregate = GeniAggregate->SliceAggregate($slice);
392
393
394
395
396
    if (!defined($aggregate)) {
	print STDERR "CreateSliver: Could not find aggregate for $slice\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Internal Error");
    }
397
398
399
400
    # Make sure that the next phase sees all changes.
    Experiment->FlushAll();
    Node->FlushAll();

Leigh B. Stoller's avatar
Leigh B. Stoller committed
401
    if ($aggregate->Start($API_VERSION, 0) != 0) {
402
	$slice->UnLock();
403
404
405
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Could not start sliver");
    }
406
407
408
409
410
411
412
413
    GeniCM::UpdateManifest($slice);
    $sliver_manifest = $aggregate->GetManifest(1);
    if (!defined($sliver_manifest)) {
	print STDERR "CreateSliver: Could not get manifest for $aggregate\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Internal Error");
    }
    
414
    $slice->UnLock();
415
416
    return GeniResponse->Create(GENIRESPONSE_SUCCESS,
				[$sliver_credential, $sliver_manifest]);
417
418
419
420
421
422
}

#
# Delete a Sliver.
#
sub DeleteSliver($)
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
{
    my ($argref) = @_;
    my $sliver_urn   = $argref->{'sliver_urn'};
    my $credentials  = $argref->{'credentials'};
    my $impotent     = $argref->{'impotent'} || 0;

    if (! (defined($credentials) && defined($sliver_urn))) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
    if (! GeniHRN::IsValid($sliver_urn)) {
	return GeniResponse->MalformedArgsResponse("Bad characters in URN");
    }
    my $credential = CheckCredentials($credentials);
    return $credential
	if (GeniResponse::IsResponse($credential));

    #
    # In this implementation, the user must provide a slice or sliver
    # credential
    #
    my ($slice, $aggregate) = Credential2SliceAggregate($credential);
    if (! (defined($slice) && defined($aggregate))) {
	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
				    "Sliver does not exist");
    }
    if ($sliver_urn ne $aggregate->urn()) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
				    "Credential does not match the URN");
    }

    #
    # We need this below to sign the ticket.
    #
    my $authority = GeniCertificate->LoadFromFile($EMULAB_PEMFILE);
    if (!defined($authority)) {
458
	print STDERR " Could not load $EMULAB_PEMFILE\n";
459
460
461
462
463
464
	return GeniResponse->Create(GENIRESPONSE_ERROR);
	
    }
    #
    # We need the user to sign the new ticket to. 
    #
465
    my $user = GeniCM::CreateUserFromCertificate($credential->owner_cert());
466
    if (!defined($user)) {
467
	return GeniResponse->Create(GENIRESPONSE_ERROR);
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
    }
    
    my $response = GeniCM::DeleteSliverAux($credential, $impotent, 1);
    return $response
	if (GeniResponse::IsResponse($response));

    #
    # In the v2 API, return a new ticket for the resources
    # (which were not released). As with all tickets, it will
    # expire very quickly. 
    #
    #
    # Create a new ticket from the manifest.
    #
    my $manifest = $aggregate->GetManifest(0);
    if (!defined($manifest)) {
	print STDERR "No manifest found for $aggregate\n";
	$response = GeniResponse->Create(GENIRESPONSE_ERROR);
	goto bad;
    }
488
489
    my $ticket = GeniTicket->Create($authority, $user,
				    GeniXML::Serialize($manifest));
490
491
492
493
494
    if (!defined($ticket)) {
	print STDERR "Could not create new ticket for $slice\n";
	$response = GeniResponse->Create(GENIRESPONSE_ERROR);
	goto bad;
    }
495
    $ticket->SetSlice($slice);
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
    
    if ($ticket->Sign()) {
	$ticket->Delete();
	print STDERR "Could not sign new ticket $ticket\n";
	$response = GeniResponse->Create(GENIRESPONSE_ERROR);
	goto bad;
    }
    if ($ticket->Store()) {
	$ticket->Delete();
	print STDERR "Could not store new ticket $ticket\n";
	$response = GeniResponse->Create(GENIRESPONSE_ERROR);
	goto bad;
    }
    my $slice_uuid = $slice->uuid();
    DBQueryWarn("delete from geni_manifests ".
		"where slice_uuid='$slice_uuid'");
    $slice->UnLock();
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, $ticket->asString());

  bad:
    if (GeniCM::CleanupDeadSlice($slice) != 0) {
	print STDERR "Could not cleanup slice\n";
    }
    return $response;
}

#
# Delete a Slice
#
sub DeleteSlice($)
526
527
{
    my ($argref) = @_;
528
529
530
531
    my $slice_urn    = $argref->{'slice_urn'};
    my $credentials  = $argref->{'credentials'};
    my $impotent     = $argref->{'impotent'} || 0;

532
    if (! (defined($credentials) && defined($slice_urn))) {
533
534
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
535
536
537
    if (! GeniHRN::IsValid($slice_urn)) {
	return GeniResponse->MalformedArgsResponse("Bad characters in URN");
    }
538
539
540
    my $credential = CheckCredentials($credentials);
    return $credential
	if (GeniResponse::IsResponse($credential));
541

542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
    #
    # In this implementation, the user must provide a slice credential.
    #
    my ($slice, $aggregate) = Credential2SliceAggregate($credential);
    if (! defined($slice)) {
	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
				    "No such slice here");
    }
    if ($slice_urn ne $slice->urn()) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
				    "Credential does not match the URN");
    }
    if ($slice->Lock() != 0) {
	return GeniResponse->BusyResponse();
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
557
    if (GeniCM::CleanupDeadSlice($slice, 1) != 0) {
558
559
560
561
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Could not cleanup slice");
    }
    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
562
563
564
565
566
567
568
569
}

#
# Get a Sliver (credential)
#
sub GetSliver($)
{
    my ($argref) = @_;
570
571
    my $slice_urn    = $argref->{'slice_urn'};
    my $credentials  = $argref->{'credentials'};
572

573
    if (! (defined($credentials) && defined($slice_urn))) {
574
575
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
576
577
578
    if (! GeniHRN::IsValid($slice_urn)) {
	return GeniResponse->MalformedArgsResponse("Bad characters in URN");
    }
579
580
581
582
    my $credential = CheckCredentials($credentials);
    return $credential
	if (GeniResponse::IsResponse($credential));

583
584
585
586
587
588
589
590
591
592
593
594
    #
    # In this implementation, the user must provide a slice credential.
    #
    my ($slice, $aggregate) = Credential2SliceAggregate($credential);
    if (! (defined($slice) && defined($aggregate))) {
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "No slice or aggregate here");
    }
    if ($slice_urn ne $slice->urn()) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
				    "Credential does not match the URN");
    }
595
    return GeniCM::GetSliverAux($credential);
596
597
598
}

#
599
# Start a sliver (not sure what this means yet, so reboot for now).
600
#
601
sub StartSliver($)
602
603
{
    my ($argref) = @_;
604
    my $slice_urn    = $argref->{'slice_urn'};
605
    my $sliver_urns  = $argref->{'sliver_urns'} || $argref->{'component_urns'};
606
    my $credentials  = $argref->{'credentials'};
607
    my $manifest     = $argref->{'manifest'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
608
    
609
610
    return SliverAction("start",
			$slice_urn, $sliver_urns, $credentials, $manifest);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
611
612
613
614
615
616
}

sub StopSliver($)
{
    my ($argref) = @_;
    my $slice_urn    = $argref->{'slice_urn'};
617
    my $sliver_urns  = $argref->{'sliver_urns'} || $argref->{'component_urns'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
618
619
    my $credentials  = $argref->{'credentials'};

620
621
    return SliverAction("stop",
			$slice_urn, $sliver_urns, $credentials, undef);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
622
623
624
625
626
627
}

sub RestartSliver($)
{
    my ($argref) = @_;
    my $slice_urn    = $argref->{'slice_urn'};
628
    my $sliver_urns  = $argref->{'sliver_urns'} || $argref->{'component_urns'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
629
    my $credentials  = $argref->{'credentials'};
630
    my $manifest     = $argref->{'manifest'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
631

632
633
    return SliverAction("restart",
			$slice_urn, $sliver_urns, $credentials, $manifest);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
634
}
635

636
sub SliverAction($$$$$)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
637
{
638
    my ($action, $slice_urn, $sliver_urns, $credentials, $manifest) = @_;
639
    my $response;
640

641
642
    if (! (defined($credentials) &&
	   (defined($slice_urn) || defined($sliver_urns)))) {
643
644
645
646
647
648
649
650
651
652
653
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
    my $credential = CheckCredentials($credentials);
    return $credential
	if (GeniResponse::IsResponse($credential));

    $credential->HasPrivilege( "pi" ) or
	$credential->HasPrivilege( "info" ) or
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "Insufficient privilege");

654
655
656
657
658
659
660
661
662
    if (defined($manifest)) {
	$manifest = GeniXML::Parse($manifest);
	if (!defined($manifest)) {
	    print STDERR "Error reading manifest\n";
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					"Bad manifest");
	}
    }
    
663
664
665
    #
    # For now, only allow top level aggregate or the slice
    #
666
    my ($slice, $aggregate) = Credential2SliceAggregate($credential);
Srikanth's avatar
Srikanth committed
667

668
669
670
671
672
    if ( (!defined($slice)) && 
          ($credential->target_urn() =~ /\+authority\+cm$/)) {
          # administrative credentials are presented.
          my $cm_urn = GeniHRN::Generate($OURDOMAIN, "authority", "cm");
          if ($cm_urn != $credential->target_urn()) {
Srikanth's avatar
Srikanth committed
673
            return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
674
675
676
677
                      "Credential target does not match CM URN");
          }

      if (!defined($slice_urn)) {
Srikanth's avatar
Srikanth committed
678
679
          return GeniResponse->MalformedArgsResponse("Missing arguments");
      }       
680
681
682
683
684
685
686
687
      $slice = GeniSlice->Lookup($slice_urn);
      return GeniResponse->Create(GENIRESPONSE_ERROR, undef, 
                "No Slice with urn $slice_urn here")
          if (!defined($slice));
      $aggregate = GeniAggregate->SliceAggregate($slice);
      return GeniResponse->Create(GENIRESPONSE_ERROR, undef, 
                      "No Aggregate here")
          if (!defined($aggregate));
Srikanth's avatar
Srikanth committed
688
    } 
689

690
691
692
693
694
695
    if (! (defined($slice) && defined($aggregate))) {
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "No slice or aggregate here");
    }
    if (defined($slice_urn)) {
	if (! GeniHRN::IsValid($slice_urn)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
696
697
	    return
		GeniResponse->MalformedArgsResponse("Bad characters in URN");
698
	}
699
700
701
	if ($slice_urn ne $slice->urn()) {
	    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
					"Credential does not match the URN");
702
	}
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
    }
    if ($slice->Lock() != 0) {
	return GeniResponse->BusyResponse();
    }
    # Shutdown slices get nothing.
    if ($slice->shutdown()) {
	$slice->UnLock();
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "Slice has been shutdown");
    }
    if ($aggregate->ComputeState()) {
	$slice->UnLock();
	print STDERR "Could not determine current state\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
    my $CheckState = sub {
	my ($object, $action) = @_;

Leigh B. Stoller's avatar
Leigh B. Stoller committed
721
	if ($action eq "start") {
722
723
	    if ($object->state() ne "stopped" && $object->state() ne "new"
		&& $object->state() ne "mixed") {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
724
725
726
727
728
		return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
					    "Sliver is not stopped (yet)");
	    }
	}
	elsif ($action eq "stop") {
729
	    if ($object->state() ne "started" && $object->state() ne "mixed") {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
730
731
732
733
734
		return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
					    "Sliver is not started (yet)");
	    }
	}
	elsif ($action eq "restart") {
735
	    if ($object->state() ne "started" && $object->state() ne "mixed") {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
736
737
738
		return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
					    "Sliver is not started (yet)");
	    }
739
740
741
742
743
744
	}
	return 0;
    };
    my $PerformAction = sub {
	my ($object, $action) = @_;

745
746
	my $exitval = 0;

747
	if ($action eq "start") {
748
	    $exitval = $object->Start($API_VERSION, 0);
749
	}
750
	elsif ($action eq "stop") {
751
	    $exitval = $object->Stop($API_VERSION);
752
753
	}
	elsif ($action eq "restart") {
754
	    $exitval = $object->Start($API_VERSION, 1);
755
	}
756
757
758
759
	return GeniResponse->Create(GENIRESPONSE_ERROR, 
				    "Could not $action sliver")
	    if ($exitval);
	
760
761
762
763
764
765
766
767
	return 0;
    };

    if (defined($slice_urn)) {
	$response = &$CheckState($aggregate, $action);
	goto bad
	    if (GeniResponse::IsResponse($response));
	    
768
769
770
771
772
773
774
775
776
	if ($action eq "start" && defined($manifest)) {
	    if ($aggregate->ProcessManifest($manifest)) {
		$response = GeniResponse->Create(GENIRESPONSE_ERROR,
						 undef,
						 "Error processing manifest");
		goto bad;
	    }
	}
	
777
778
779
780
	$response = &$PerformAction($aggregate, $action);
	goto bad
	    if (GeniResponse::IsResponse($response));

781
	if ($action eq "start" || $action eq "restart") {
782
783
	    GeniCM::UpdateManifest($slice);
	}
784
785
	$slice->UnLock();
	return GeniResponse->Create(GENIRESPONSE_SUCCESS);
786
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
787
    else {
788
	my @slivers = ();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
789

790
791
792
793
794
	#
	# Sanity check all arguments before doing anything.
	#
	foreach my $urn (@{ $sliver_urns }) {
	    my $sliver = GeniSliver->Lookup($urn);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
795
796
797
798
799
800
	    if (!defined($sliver)) {
		$response = GeniResponse->Create(GENIRESPONSE_SEARCHFAILED,
						 undef,
						 "Nothing here by that name");
		goto bad;
	    }
801
802
803
804
805
806
807
808
	    
	    $response = &$CheckState($sliver, $action);
	    goto bad
		if (GeniResponse::IsResponse($response));

	    push(@slivers, $sliver);
	}
	foreach my $sliver (@slivers) {
809
810
811
812
813
814
815
816
	    if ($action eq "start" && defined($manifest)) {
		if ($sliver->ProcessManifest($manifest)) {
		    $response = GeniResponse->Create(GENIRESPONSE_ERROR,
				     undef,
				     "Error processing manifest for $sliver");
		    goto bad;
		}
	    }
817
818
819
820
821
822
	    $response = &$PerformAction($sliver, $action);
	    goto bad
		if (GeniResponse::IsResponse($response));
	}
	$slice->UnLock();
	return GeniResponse->Create(GENIRESPONSE_SUCCESS);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
823
    }
824
825
826
  bad:
    $slice->UnLock();
    return $response;
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
}

#
# Get sliver status
#
sub SliverStatus($)
{
    my ($argref) = @_;
    my $slice_urn    = $argref->{'slice_urn'};
    my $credentials  = $argref->{'credentials'};

    if (! (defined($credentials) && defined($slice_urn))) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
    if (! GeniHRN::IsValid($slice_urn)) {
	return GeniResponse->MalformedArgsResponse("Bad characters in URN");
    }
    my $credential = CheckCredentials($credentials);
    return $credential
	if (GeniResponse::IsResponse($credential));

    $credential->HasPrivilege( "pi" ) or
	$credential->HasPrivilege( "info" ) or
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "Insufficient privilege");

    #
    # For now, only allow top level aggregate or the slice
    #
    my ($slice, $aggregate) = Credential2SliceAggregate($credential);
    if (! (defined($slice) && defined($aggregate))) {
858
	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
859
860
861
862
863
				    "No slice or aggregate here");
    }
    if ($slice_urn ne $slice->urn()) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
				    "Credential does not match the URN");
864
865
866
867
    }
    if ($slice->Lock() != 0) {
	return GeniResponse->BusyResponse();
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
868
869
870
871
872
    if ($aggregate->ComputeState()) {
	print STDERR "SliverStatus: Could not compute state for $aggregate\n";
	$slice->UnLock();
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
873
874
875
876
877
878
879
880
881
882
883

    #
    # Grab all the slivers for this slice, and then
    # look for just the nodes.
    #
    my @slivers    = ();
    if ($aggregate->SliverList(\@slivers) != 0) {
	print STDERR "SliverStatus: Could not get slivers for $aggregate\n";
	$slice->UnLock();
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
884
885
886

    my $blob = {
	"state"   => $aggregate->state(),
Leigh B. Stoller's avatar
Leigh B. Stoller committed
887
	"status"  => $aggregate->status(),
Leigh B. Stoller's avatar
Leigh B. Stoller committed
888
889
890
	"details" => {},
    };
    
891
892
893
894
895
    foreach my $sliver (@slivers) {
	next
	    if ($sliver->isa("GeniAggregate"));
	next
	    if ($sliver->resource_type() ne "Node");
896

897
898
	my $sliver_urn    = $sliver->sliver_urn();
	my $component_urn = $sliver->component_urn();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
899
900
901
	my $state         = $sliver->state();
	my $status        = $sliver->status();
	my $error         = "";
902

903
904
905
906
	# New is the same as stopped. Separate state is handy.
	$state = "stopped"
	    if ($state eq "new");

Leigh B. Stoller's avatar
Leigh B. Stoller committed
907
908
	if ($status eq "failed") {
	    $error = $sliver->ErrorLog();
909
	}
910
911
	$blob->{'details'}->{$sliver_urn} = {
	    "component_urn" => $component_urn,
912
913
914
915
916
917
918
	    "state"  => $state,
	    "status" => $status,
	    "error"  => $error,
	};
    }
    $slice->UnLock();
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
919
920
921
922
923
924
925
926
}

#
# Shutdown sliver
#
sub Shutdown($)
{
    my ($argref) = @_;
927
928
929
    my $slice_urn    = $argref->{'slice_urn'};
    my $clear        = $argref->{'clear'} || 0;
    my $credentials  = $argref->{'credentials'};
930
    require libtestbed;
931

932
    if (! (defined($credentials) && defined($slice_urn))) {
933
934
935
936
937
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
    my $credential = CheckCredentials($credentials);
    return $credential
	if (GeniResponse::IsResponse($credential));
938

939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
    $credential->HasPrivilege( "pi" ) or
	$credential->HasPrivilege( "instantiate" ) or
	$credential->HasPrivilege( "control" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );

    #
    # The clearinghouse generates a different credential to do this.
    #
    if ($slice_urn ne $credential->target_urn()) {
	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_urn() ne $certificate->urn()) {
	    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
					"Insufficient privilege");
	}
    }

    #
    # No slice here? Done.
    #
    my $slice = GeniSlice->Lookup($slice_urn);
    if (!defined($slice)) {
	return GeniResponse->Create(GENIRESPONSE_SUCCESS);
    }
    #
    # Do not worry about locking when setting the shutdown time.
    # This can lead to race though, if a clear shutdown comes in first.
    # Seems unlikely though. 
    #
    if (!$clear) {
	# Do not overwrite original shutdown time
	$slice->SetShutdown(1)
	    if (!defined($slice->shutdown()) || $slice->shutdown() eq "");
    }
    else {
	$slice->SetShutdown(0);
    }
    # Always make sure the slice is shutdown.
    if ($slice->shutdown()) {
	# The expire daemon is going to look for this, so it will get
	# taken care of shortly.
	if ($slice->Lock() != 0) {
	    return GeniResponse->BusyResponse();
	}
	if (GeniCM::CleanupDeadSlice($slice, 0) != 0) {
990
991
	    libtestbed::SENDMAIL($TBOPS, "Emergency Shutdown failed",
				 "Emergency shutdown failed on $slice\n");
992
993
994
995
996
997
998
	    print STDERR "Could not shutdown $slice!\n";
	    # Lets call this a non-error since the local admin person
	    # is going to have to deal with it anyway. 
	}
	$slice->UnLock();
    }
    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
999
1000
1001
}

#
1002
# Renew a slice
1003
#
1004
sub RenewSlice($)
1005
1006
{
    my ($argref) = @_;
1007
    my $slice_urn    = $argref->{'slice_urn'};
1008
    my $valid_until  = $argref->{'valid_until'} || $argref->{'expiration'};
1009
1010
    my $credentials  = $argref->{'credentials'};

Leigh B. Stoller's avatar
Leigh B. Stoller committed
1011
    if (! (defined($credentials) && defined($slice_urn))) {
1012
1013
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
1014
1015
1016
    if (! GeniHRN::IsValid($slice_urn)) {
	return GeniResponse->MalformedArgsResponse("Bad characters in URN");
    }
1017
1018
1019
1020
    my $credential = CheckCredentials($credentials);
    return $credential
	if (GeniResponse::IsResponse($credential));

1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
    #
    # In this implementation, the user must provide a slice credential.
    #
    my ($slice, $aggregate) = Credential2SliceAggregate($credential);
    if (! (defined($slice) && defined($aggregate))) {
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "No slice or aggregate here");
    }
    if ($slice_urn ne $slice->urn()) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
				    "Credential does not match the URN");
    }
1033
1034
    my $credential_objects = [];
    foreach my $credstr (@$credentials) {
1035
1036
1037
        my $cred = CheckCredential($credstr);
        push(@$credential_objects, $cred) 
            if(!GeniResponse::IsResponse($cred));
1038
1039
    }
    return GeniCM::RenewSliverAux($credential_objects, $valid_until);
1040
1041
}

1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
#
# Get a Ticket.
#
sub GetTicket($)
{
    my ($argref) = @_;
    my $slice_urn    = $argref->{'slice_urn'};
    my $rspecstr     = $argref->{'rspec'};
    my $credentials  = $argref->{'credentials'};
    my $impotent     = $argref->{'impotent'} || 0;

    if (! (defined($credentials) &&
	   defined($slice_urn) && defined($rspecstr))) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
    if (! ($rspecstr =~ /^[\040-\176\012\015\011]+$/)) {
	return GeniResponse->MalformedArgsResponse("Bad characters in rspec");
    }
    my $credential = CheckCredentials($credentials);
    return $credential
	if (GeniResponse::IsResponse($credential));

    #
    # This implementation requires a slice credential, and it must
    # match the slice_urn.
    #
    my ($slice, $aggregate) = Credential2SliceAggregate($credential);
    if (defined($slice)) {
	if ($slice_urn ne $slice->urn()) {
	    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
					"Credential does not match the URN");
	}
	#
	# GetTicket applies only to slices that are not active. Must
	# use UpdateSliver() for an active sliver.
	#
	if (defined($aggregate)) {
	    return GeniResponse->Create(GENIRESPONSE_REFUSED(), undef,
				"Cannot get a ticket for active sliver");
	}
	#
	# It is an error if there is an outstanding ticket. That ticket
	# must be released first.
	#
	my $ticket = GeniTicket->SliceTicket($slice);
	if (defined($ticket)) {
	    return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
				    "Must release unredeemed ticket first");
	}
1091
1092
1093
1094
	if ($slice->IsExpired()) {
	    return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
					"Slice has expired");
	}
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
    }
    else {
	# Slice does not exist yet. 
    }
    return GeniCM::GetTicketAux($credential,
				$rspecstr, 0, $impotent, 1, 1, undef);
}    
	
#
# Update a ticket, returning a new ticket. 
#
sub UpdateTicket($)
{
    my ($argref) = @_;
    my $slice_urn    = $argref->{'slice_urn'};
    my $ticketstr    = $argref->{'ticket'};
    my $rspecstr     = $argref->{'rspec'};
    my $credentials  = $argref->{'credentials'};
    my $impotent     = $argref->{'impotent'} || 0;

    if (! (defined($credentials) && defined($ticketstr) &&
	   defined($slice_urn) && defined($rspecstr))) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
    if (! ($rspecstr =~ /^[\040-\176\012\015\011]+$/)) {
	return GeniResponse->MalformedArgsResponse("Bad characters in rspec");
    }
    my $credential = CheckCredentials($credentials);
    return $credential
	if (GeniResponse::IsResponse($credential));

    defined($credential) &&
	($credential->HasPrivilege( "pi" ) or
	 $credential->HasPrivilege( "instantiate" ) or
	 $credential->HasPrivilege( "bind" ) or
	 return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				      "Insufficient privilege" ));

    #
    # This implementation requires a slice credential, and it must
    # match the slice_urn.
    #
    my ($slice, $aggregate) = Credential2SliceAggregate($credential);
    if (defined($slice)) {
	if ($slice_urn ne $slice->urn()) {
	    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
					"Credential does not match the URN");
	}
    }
    else {
	# Slice should exist at this point.
	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED(), undef,
				    "Slice does not exist here");
    }
1149
1150
1151
1152
1153
    if ($slice->IsExpired()) {
	return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
				    "Slice has expired");
    }
    
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
    #
    # UpdateTicket applies only to slices that are not active. Must
    # use UpdateSliver() for an active sliver.
    #
    if (defined($aggregate)) {
	return GeniResponse->Create(GENIRESPONSE_REFUSED(), undef,
			    "Cannot update a ticket for active sliver");
    }

    my $ticket = GeniTicket->CreateFromSignedTicket($ticketstr);
    if (!defined($ticket)) {
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Could not create GeniTicket object");
    }
    #
    # Make sure the ticket was issued to the caller.
    #
1171
    if ($ticket->owner_urn() ne $ENV{'GENIURN'}) {
1172
1173
1174
1175
1176
1177
1178
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "This is not your ticket");
    }
    if (!$ticket->stored()) {
	return GeniResponse->Create(GENIRESPONSE_REFUSED(), undef,
				    "Not an active ticket");
    }
1179
    if ($ticket->slice_urn() ne $slice->urn()) {
1180
1181
1182
1183
1184
1185
1186
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "This ticket is for another slice");
    }
    
    #
    # We need the user to sign the new ticket to. 
    #
1187
    my $user = GeniCM::CreateUserFromCertificate($credential->owner_cert());
1188
    if (!defined($user)) {
1189
	return GeniResponse->Create(GENIRESPONSE_ERROR);
1190
    }
1191
1192
    my $credential_objects = [];
    foreach my $credstr (@$credentials) {
1193
1194
1195
        my $cred = CheckCredential($credstr);
        push(@$credential_objects, $cred) 
            if(!GeniResponse::IsResponse($cred));
1196
    }
1197
    return GeniCM::GetTicketAuxAux($slice, $user,
1198
				   $rspecstr, 1, $impotent, 1, 1, $ticket, $credential_objects);
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
}

#
# Update a sliver, returning a new ticket. 
#
sub UpdateSliver($)
{
    my ($argref) = @_;
    my $sliver_urn   = $argref->{'sliver_urn'};
    my $rspecstr     = $argref->{'rspec'};
    my $credentials  = $argref->{'credentials'};
    my $impotent     = $argref->{'impotent'} || 0;

    if (! (defined($credentials) &&
	   defined($sliver_urn) && defined($rspecstr))) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
    if (! ($rspecstr =~ /^[\040-\176\012\015\011]+$/)) {
	return GeniResponse->MalformedArgsResponse("Bad characters in rspec");
    }
    my $credential = CheckCredentials($credentials);
    return $credential
	if (GeniResponse::IsResponse($credential));

    defined($credential) &&
	($credential->HasPrivilege( "pi" ) or
	 $credential->HasPrivilege( "instantiate" ) or
	 $credential->HasPrivilege( "bind" ) or
	 return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				      "Insufficient privilege" ));

    my ($slice, $aggregate) = Credential2SliceAggregate($credential);
    if (! (defined($slice) && defined($aggregate))) {
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "No slice or aggregate here");
    }
    # Must be an aggregate (top level sliver).
    if (ref($aggregate) ne "GeniAggregate") {
	return GeniResponse->MalformedArgsResponse("Must supply aggregate");
    }
    if ($sliver_urn ne $aggregate->urn()) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
				    "Credential does not match the URN");
    }
    #
    # It is an error if there is an outstanding ticket. That ticket
    # must be released first.
    #
    my $ticket = GeniTicket->SliceTicket($slice);
    if (defined($ticket)) {
	return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
				    "Must release unredeemed ticket first");
    }

1253
1254
1255
1256
1257
    if ($slice->IsExpired()) {
	return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
				    "Slice has expired");
    }

1258
1259
1260
    #
    # Any user can update the sliver. The ticket is signed to that user.
    #
1261
    my $user = GeniCM::CreateUserFromCertificate($credential->owner_cert());
1262
    if (!defined($user)) {
1263
	return GeniResponse->Create(GENIRESPONSE_ERROR);
1264
    }
1265
1266
    my $credential_objects = [];
    foreach my $credstr (@$credentials) {
1267
1268
1269
        my $cred = CheckCredential($credstr);
        push(@$credential_objects, $cred) 
            if(!GeniResponse::IsResponse($cred));
1270
    }
1271
    return GeniCM::GetTicketAuxAux($slice, $user,
1272
				   $rspecstr, 1, $impotent, 1, 1, undef, $credential_objects);
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
}

#
# Redeem a ticket
#
sub RedeemTicket($)
{
    my ($argref) = @_;
    my $slice_urn    = $argref->{'slice_urn'};
    my $ticketstr    = $argref->{'ticket'};
    my $credentials  = $argref->{'credentials'};
    my $keys         = $argref->{'keys'};
    my $impotent     = $argref->{'impotent'} || 0;
    
    if (! (defined($credentials) &&
	   defined($slice_urn) && defined($ticketstr))) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
    my $credential = CheckCredentials($credentials);
    return $credential
	if (GeniResponse::IsResponse($credential));

    my $ticket = GeniTicket->CreateFromSignedTicket($ticketstr);
    if (!defined($ticket)) {
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Could not create GeniTicket object");
    }
    #
    # Make sure the ticket was issued to the caller.
    #
1303
    if ($ticket->owner_urn() ne $ENV{'GENIURN'}) {
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "This is not your ticket");
    }
    my ($slice, $aggregate) = Credential2SliceAggregate($credential);
    if (! (defined($slice))) {
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "No slice here");
    }
    if ($slice_urn ne $slice->urn()) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
				    "Credential does not match the URN");
    }
    my $isupdate = defined($aggregate);

    return GeniCM::SliverWorkAux($credential,
				 $ticket, $keys, $isupdate, $impotent, 1, 1);
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
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
#
# Redeem a ticket
#
sub BindToSlice($)
{
    my ($argref) = @_;
    my $slice_urn    = $argref->{'slice_urn'};
    my $credentials  = $argref->{'credentials'};
    my $keys         = $argref->{'keys'};
    
    if (! (defined($credentials) &&
	   defined($slice_urn) && defined($keys))) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
    my $credential = CheckCredentials($credentials);
    return $credential
	if (GeniResponse::IsResponse($credential));

    $credential->HasPrivilege( "pi" ) or
	$credential->HasPrivilege( "bind" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );

    my ($slice, $aggregate) = Credential2SliceAggregate($credential);
    if (! (defined($slice))) {
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "No slice here");
    }
    if ($slice_urn ne $slice->urn()) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
				    "Credential does not match the URN");
    }
    
    #
    # Find or create the user.
    #
1358
    my $user = GeniCM::CreateUserFromCertificate($credential->owner_cert());
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1359
    if (!defined($user)) {
1360
	return GeniResponse->Create(GENIRESPONSE_ERROR);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
    }
    if (!$user->IsLocal() && defined($keys)) {
	$user->Modify(undef, undef, $keys);
    }
    if ($slice->Lock() != 0) {
	return GeniResponse->BusyResponse();
    }
    # Bind for future slivers.
    if ($slice->BindUser($user) != 0) {
	$slice->UnLock();
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Error binding slice to user");
    }
    # Bind for existing slivers. 
    if ($user->BindToSlice($slice) != 0) {
	$slice->UnLock();
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Error binding user to slice");
    }
    $slice->UnLock();
    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
}

1384
1385
1386
1387
1388
1389
#
# Release a ticket.
#
sub ReleaseTicket($)
{
    my ($argref) = @_;
1390
    my $slice_urn    = $argref->{'slice_urn'};
1391
    my $ticketstr    = $argref->{'ticket'};
1392
1393
1394
1395
    my $credentials  = $argref->{'credentials'};
    
    if (! (defined($credentials) &&
	   defined($slice_urn) && defined($ticketstr))) {
1396
1397
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
    my $credential = CheckCredentials($credentials);
    return $credential
	if (GeniResponse::IsResponse($credential));

    $credential->HasPrivilege( "pi" ) or
	$credential->HasPrivilege( "bind" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );

    my ($slice, $aggregate) = Credential2SliceAggregate($credential);
    if (! (defined($slice))) {