GeniCMV2.pm.in 71.5 KB
Newer Older
1
2
3
#!/usr/bin/perl -wT
#
# GENIPUBLIC-COPYRIGHT
4
# Copyright (c) 2008-2012 University of Utah and the Flux Group.
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
# 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 GeniDB;
use GeniResponse;
use GeniTicket;
use GeniCredential;
use GeniCertificate;
26
use GeniComponent;
27
28
29
30
use GeniSlice;
use GeniAggregate;
use GeniSliver;
use GeniUtil;
31
use GeniCM;
32
use GeniHRN;
33
use GeniXML;
34
35
36
37
38
39
40
41
use emutil;
use English;
use Data::Dumper;
use XML::Simple;
use Date::Parse;
use POSIX qw(strftime tmpnam);
use Time::Local;
use Compress::Zlib;
42
use File::Temp qw(tempfile);
43
44
45
46
47
48
49
50
51
52
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@";
53
my $ELABINELAB     = "@ELABINELAB@";
54
my $TBBASE         = "@TBBASE@";
55
56
57
58
my $CREATEEXPT     = "$TB/bin/batchexp";
my $ENDEXPT        = "$TB/bin/endexp";
my $NALLOC	   = "$TB/bin/nalloc";
my $NFREE	   = "$TB/bin/nfree";
59
my $TEVC	   = "$TB/bin/tevc";
60
61
62
63
64
65
66
67
68
69
70
71
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";
72
73
my $CLONEIMAGE     = "$TB/sbin/clone_image";
my $CREATEIMAGE    = "$TB/bin/create_image";
74
my $XMLLINT	   = "/usr/local/bin/xmllint";
75
76
my $PRERENDER      = "$TB/libexec/vis/prerender";
my $EMULAB_PEMFILE = "@prefix@/etc/genicm.pem";
77
78
# Just one of these, at Utah.
my $GENICH_PEMFILE = "@prefix@/etc/genich.pem";
79
my $API_VERSION    = 2;
80
81
82
83
84
85
86
87

#
# 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()
{
88
89
    my @input_rspec_versions = ( "0.1", "0.2", "2", "3", "PG 0.1", "PG 0.2", "PG 2" );
    my @ad_rspec_versions = ( "0.1", "0.2", "2", "3", "PG 0.1", "PG 0.2", "PG 2" );
Gary Wong's avatar
Gary Wong committed
90
91
92
    my $blob = {
	"api" => $API_VERSION,
	"level" => 1,
93
	"input_rspec" => \@input_rspec_versions,
94
	"output_rspec" => "2",
95
	"ad_rspec" => \@ad_rspec_versions
Gary Wong's avatar
Gary Wong committed
96
97
    };

98
    return GeniResponse->Create( GENIRESPONSE_SUCCESS, $blob);
99
100
101
102
103
104
105
106
}

#
# Respond to a Resolve request. 
#
sub Resolve($)
{
    my ($argref) = @_;
107
108
    my $credentials = $argref->{'credentials'};
    my $urn         = $argref->{'urn'};
109
    my $admin       = 0;
110
    my $isauth	    = 0;
111

112
113
114
115
116
117
118
119
120
121
    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));

122
123
124
    my ($object, $type) = LookupURN($urn);
    return $object
	if (GeniResponse::IsResponse($object));
125
126
127
128

    #
    # This is a convenience for testing. If a local user and that
    # user is an admin person, then do whatever it says. This is
129
130
    # easier then trying to do this with credential privs. But,
    # watch for credentials from authorities instead of users.
131
    #
132
133
    my (undef,$callertype,$callerid) = GeniHRN::Parse($credential->owner_urn());
    if ($callertype eq "user") {
134
	my $user = GeniCM::CreateUserFromCertificate($credential);
135
136
	if (!GeniResponse::IsResponse($user) &&
	    $user->IsLocal() && $user->admin()) {
137
138
139
	    $admin = 1;
	}
    }
140
141
    elsif ($callertype eq "authority" &&
	   ($callerid eq "cm" || $callerid eq "sa")) {
142
	$isauth = 1;
143
    }
144
145
    
    if ($type eq "node") {
146
	my $node  = $object;
147
148
149
150
151
	# Not sure about this, but I do know that Resolving a virtnode
	# is not useful right now. 
	if ($node->isvirtnode()) {
	    $node = Node->Lookup($node->phys_nodeid());
	}
152
	my $rspec = GeniCM::GetAdvertisement(0, $node->node_id(), "0.1", undef);
153
	if (! defined($rspec)) {
154
	    print STDERR "Could not get advertisement for $node!\n";
155
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
156
					"Error getting advertisement");
157
	}
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
	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");
	    }
	}
194
	# Return a blob.
195
	my $blob = { "hrn"          => $myhrn,
196
197
		     "uuid"         => $node->uuid(),
		     "role"	    => $node->role(),
198
199
		     "hostname"     =>
			 GeniUtil::FindHostname($node->node_id()),
200
201
		     "physctrl"     => 
			 Interface->LookupControl($node->phys_nodeid())->IP(),
202
203
204
205
		     "urn"          => $myurn,
		     "rspec"        => $rspec,
		     "url"          => $me->url(),
		     "gid"          => $component->cert(),
206
207
208
209
		   };

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
213
214
215
216
	#
	# In this implementation, the caller must hold a valid slice
	# credential for the slice being looked up. 
	#
217
218
	if (! ($isauth || $admin ||
	       $slice->urn() eq $credential->target_urn())) {
219
220
	    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
					"No permission to resolve $slice\n");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
221
222
223
224
225
226
	}
	# Return a blob.
	my $blob = { "urn"          => $urn };

	my $aggregate = GeniAggregate->SliceAggregate($slice);
	if (defined($aggregate)) {
227
	    $blob->{'sliver_urn'} = $aggregate->urn();
228
229
230
231
	    my $manifest = $aggregate->GetManifest(1);
	    if (defined($manifest)) {
		$blob->{'manifest'}   = $manifest;
	    }
232
233
234
235
236
237
238
239
240
241
242
	    # For key bindings.
	    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 }) {
243
		    $blob->{'users'} = $bindings;
244
245
		}
	    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
246
247
248
	}
	my $ticket = GeniTicket->SliceTicket($slice);
	if (defined($ticket)) {
249
	    $blob->{'ticket_urn'} = $ticket->urn();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
250
251
252
253
	}
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
    if ($type eq "sliver") {
254
	my $sliver = $object;
255
256
257
	my $slice  = $sliver->GetSlice();
	return GeniResponse->Create(GENIRESPONSE_ERROR)
	    if (!defined($slice));
258

Leigh B. Stoller's avatar
Leigh B. Stoller committed
259
260
261
262
	#
	# In this implementation, the caller must hold a valid slice
	# or sliver credential for the slice being looked up. 
	#
263
	if (! ($admin || $isauth ||
264
	       $sliver->urn() eq $credential->target_urn() ||
265
266
267
268
269
	       $slice->urn() eq $credential->target_urn())) {
	    print STDERR $sliver->urn() . "\n";
	    print STDERR $slice->urn() . "\n";
	    print STDERR $credential->target_urn() . "\n";
	    print STDERR $ENV{'MYURN'} . "\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
270
271
	    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN);
	}
272
273
	my $manifest = $sliver->GetManifest(1);
	if (!defined($manifest)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
274
275
276
277
278
279
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
	# Return a blob.
	my $blob = { "urn"          => $urn,
		     "manifest"     => $manifest,
		 };
280
281
282
283
284
285
286
287
288
289
290
	# For key bindings.
	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 }) {
291
		$blob->{'users'} = $bindings;
292
293
	    }
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
294
295
296
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
    if ($type eq "ticket") {
297
298
	my $ticket = $object;

Leigh B. Stoller's avatar
Leigh B. Stoller committed
299
300
301
302
	#
	# In this implementation, the caller must hold a valid slice
	# or sliver credential to get the ticket.
	#
303
	my $slice = GeniSlice->Lookup($ticket->slice_urn());
Leigh B. Stoller's avatar
Leigh B. Stoller committed
304
305
306
307
	if (!defined($slice)) {
	    print STDERR "Could not find slice for $ticket\n";
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
308
	if (! ($admin || $slice->urn() eq $credential->target_urn())) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
309
310
311
312
313
	    #
	    # See if its the sliver credential. 
	    #
	    my $aggregate = GeniAggregate->SliceAggregate($slice);
	    if (!defined($aggregate) ||
314
		$aggregate->urn() ne $credential->target_urn()) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
315
316
317
318
319
		return GeniResponse->Create(GENIRESPONSE_FORBIDDEN());
	    }
	}
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $ticket->asString());
    }
320
321
    return GeniResponse->Create(GENIRESPONSE_UNSUPPORTED, undef,
				"Cannot resolve $type at this authority");
322
323
324
325
326
327
328
329
}

#
# Discover resources on this component, returning a resource availablity spec
#
sub DiscoverResources($)
{
    my ($argref) = @_;
330
331
332
    my $credentials = $argref->{'credentials'};
    my $available   = $argref->{'available'} || 0;
    my $compress    = $argref->{'compress'} || 0;
333
    my $version     = $argref->{'rspec_version'} || undef;
334
335
336
337
338
339
340

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

342
343
    my $credential_objects = [];
    foreach my $credstr (@$credentials) {
344
345
346
        my $cred = CheckCredential($credstr);
        push(@$credential_objects, $cred) 
            if(!GeniResponse::IsResponse($cred));
347
348
    }
    return GeniCM::DiscoverResourcesAux($available, $compress,
349
        $version, $credential_objects);
350
351
352
353
354
355
356
357
}

#
# Create a Sliver.
#
sub CreateSliver($)
{
    my ($argref) = @_;
358
359
360
361
362
    my $slice_urn    = $argref->{'slice_urn'};
    my $rspecstr     = $argref->{'rspec'};
    my $credentials  = $argref->{'credentials'};
    my $keys         = $argref->{'keys'};
    my $impotent     = $argref->{'impotent'} || 0;
363
364
    require Node;
    require Experiment;
365
366
    require libtestbed;
    require libaudit;
367
368
    
    # For now, I am not worrying about the slice_urn argument.
369
370
    if (! (defined($credentials) &&
	   defined($slice_urn) && defined($rspecstr))) {
371
372
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
373
374
375
376
377
378
    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");
    }
379
380
381
    my $credential = CheckCredentials($credentials);
    return $credential
	if (GeniResponse::IsResponse($credential));
382

383
384
385
386
387
388
389
    #
    # 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)) {
390
391
392
	return $slice
	    if (GeniResponse::IsResponse($slice));

393
394
395
396
	if ($slice_urn ne $slice->urn()) {
	    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
					"Credential does not match the URN");
	}
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
	#
	# Watch for a placeholder slice and update it.
	#
	if ($slice->isplaceholder()) {
	    if ($slice->Lock() != 0) {
		return GeniResponse->BusyResponse();
	    }
	    #
	    # Confirm that the slice certificate is the same.
	    #
	    if ($slice->cert() ne $credential->target_cert()->cert()) {
		$slice->UnLock();
		return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
					    "Slice certificate mismatch");
	    }
	    my $user =
413
		GeniCM::CreateUserFromCertificate($credential);
414
	    if (GeniResponse::IsResponse($user)) {	    
415
		$slice->UnLock();
416
		return $user;
417
418
419
420
421
422
423
424
	    }
	    if ($slice->ConvertPlaceholder($user) != 0) {
		$slice->UnLock();
		return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					    "Could not convert placeholder");
	    }
	    $slice->UnLock();
	}
425
426
427
428
429
	if (defined($aggregate)) {
	    return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
					"Must delete existing slice first");
	}
    }
430
    my $rspec = GeniCM::GetTicketAux($credential,
431
				     $rspecstr, 0, $impotent, 1, 0, undef);
432
433
434
    return $rspec
	if (GeniResponse::IsResponse($rspec));

435
436
437
438
    # Make sure that the next phase sees all changes.
    Experiment->FlushAll();
    Node->FlushAll();

439
    my $response = GeniCM::SliverWorkAux($credential,
440
					 $rspec, $keys, 0, $impotent, 1, 0);
441

442
443
444
445
446
447
448
    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.
	#
449
	my $slice = GeniSlice->Lookup($credential->target_urn());
450
451
452
453
454
455
456
	if ($slice->Lock() != 0) {
	    print STDERR "CreateSliver: Could not lock $slice before delete\n";
	    return $response;
	}
	if (defined($slice)) {
	    GeniCM::CleanupDeadSlice($slice, 1);
	}
457
	return $response;
458
    }
459
460
    my ($sliver_credential, $sliver_manifest) = @{ $response->{'value'} };
    
461
462
463
    #
    # Leave the slice intact on error, so we can go look at it. 
    #
464
    $slice = GeniSlice->Lookup($credential->target_urn());
465
466
467
468
469
470
471
472
473
474
    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");
    }
475
    $aggregate = GeniAggregate->SliceAggregate($slice);
476
477
478
479
480
    if (!defined($aggregate)) {
	print STDERR "CreateSliver: Could not find aggregate for $slice\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Internal Error");
    }
481
482
483
484
485
486
487
488
489
490
491
492
493
494
    #
    # At this point we want to return and let the startsliver proceed
    # in the background
    #
    my $mypid = fork();
    if ($mypid) {
	# Let the child get going.
	sleep(1);
	return GeniResponse->Create(GENIRESPONSE_SUCCESS,
				    [$sliver_credential, $sliver_manifest]);
    }
    # This switches the file that we are writing to. 
    libaudit::AuditFork();
    
495
496
497
498
    # Make sure that the next phase sees all changes.
    Experiment->FlushAll();
    Node->FlushAll();

Leigh B. Stoller's avatar
Leigh B. Stoller committed
499
    if ($aggregate->Start($API_VERSION, 0) != 0) {
500
	$slice->UnLock();
501
502
	print STDERR "Could not start sliver\n";
	return -1;
503
    }
504
    $slice->UnLock();
505
    return 0;
506
507
508
509
510
511
}

#
# Delete a Sliver.
#
sub DeleteSliver($)
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
{
    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);
533
534
535
    return $slice
	if (defined($slice) && GeniResponse::IsResponse($slice));
    
536
537
538
539
540
541
542
543
544
545
546
547
548
549
    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)) {
550
	print STDERR " Could not load $EMULAB_PEMFILE\n";
551
552
553
554
555
556
	return GeniResponse->Create(GENIRESPONSE_ERROR);
	
    }
    #
    # We need the user to sign the new ticket to. 
    #
557
    my $user = GeniCM::CreateUserFromCertificate($credential);
558
559
    return $user
	if (GeniResponse::IsResponse($user));
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
    
    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;
    }
579
580
    my $ticket = GeniTicket->Create($authority, $user,
				    GeniXML::Serialize($manifest));
581
582
583
584
585
    if (!defined($ticket)) {
	print STDERR "Could not create new ticket for $slice\n";
	$response = GeniResponse->Create(GENIRESPONSE_ERROR);
	goto bad;
    }
586
    $ticket->SetSlice($slice);
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
    
    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($)
617
618
{
    my ($argref) = @_;
619
620
621
622
    my $slice_urn    = $argref->{'slice_urn'};
    my $credentials  = $argref->{'credentials'};
    my $impotent     = $argref->{'impotent'} || 0;

623
    if (! (defined($credentials) && defined($slice_urn))) {
624
625
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
626
627
628
    if (! GeniHRN::IsValid($slice_urn)) {
	return GeniResponse->MalformedArgsResponse("Bad characters in URN");
    }
629
630
631
    my $credential = CheckCredentials($credentials);
    return $credential
	if (GeniResponse::IsResponse($credential));
632

633
634
635
636
    #
    # In this implementation, the user must provide a slice credential.
    #
    my ($slice, $aggregate) = Credential2SliceAggregate($credential);
637
638
639
    return $slice
	if (defined($slice) && GeniResponse::IsResponse($slice));

640
641
642
643
644
645
646
647
648
649
650
    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
651
    if (GeniCM::CleanupDeadSlice($slice, 1) != 0) {
652
653
654
655
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Could not cleanup slice");
    }
    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
656
657
658
659
660
661
662
663
}

#
# Get a Sliver (credential)
#
sub GetSliver($)
{
    my ($argref) = @_;
664
665
    my $slice_urn    = $argref->{'slice_urn'};
    my $credentials  = $argref->{'credentials'};
666

667
    if (! (defined($credentials) && defined($slice_urn))) {
668
669
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
670
671
672
    if (! GeniHRN::IsValid($slice_urn)) {
	return GeniResponse->MalformedArgsResponse("Bad characters in URN");
    }
673
674
675
676
    my $credential = CheckCredentials($credentials);
    return $credential
	if (GeniResponse::IsResponse($credential));

677
678
679
680
    #
    # In this implementation, the user must provide a slice credential.
    #
    my ($slice, $aggregate) = Credential2SliceAggregate($credential);
681
682
683
    return $slice
	if (defined($slice) && GeniResponse::IsResponse($slice));

684
    if (! (defined($slice) && defined($aggregate))) {
685
	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
686
687
688
689
690
691
				    "No slice or aggregate here");
    }
    if ($slice_urn ne $slice->urn()) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
				    "Credential does not match the URN");
    }
692
    return GeniCM::GetSliverAux($credential);
693
694
695
}

#
696
# Start a sliver (not sure what this means yet, so reboot for now).
697
#
698
sub StartSliver($)
699
700
{
    my ($argref) = @_;
701
    my $slice_urn    = $argref->{'slice_urn'};
702
    my $sliver_urns  = $argref->{'sliver_urns'} || $argref->{'component_urns'};
703
    my $credentials  = $argref->{'credentials'};
704
    my $manifest     = $argref->{'manifest'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
705
    
706
707
    return SliverAction("start",
			$slice_urn, $sliver_urns, $credentials, $manifest);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
708
709
710
711
712
713
}

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

717
718
    return SliverAction("stop",
			$slice_urn, $sliver_urns, $credentials, undef);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
719
720
721
722
723
724
}

sub RestartSliver($)
{
    my ($argref) = @_;
    my $slice_urn    = $argref->{'slice_urn'};
725
    my $sliver_urns  = $argref->{'sliver_urns'} || $argref->{'component_urns'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
726
    my $credentials  = $argref->{'credentials'};
727
    my $manifest     = $argref->{'manifest'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
728

729
730
    return SliverAction("restart",
			$slice_urn, $sliver_urns, $credentials, $manifest);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
731
}
732

733
sub SliverAction($$$$$)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
734
{
735
    my ($action, $slice_urn, $sliver_urns, $credentials, $manifest) = @_;
736
    my $response;
737
    my $isasync = 0;
738

739
740
    if (! (defined($credentials) &&
	   (defined($slice_urn) || defined($sliver_urns)))) {
741
742
743
744
745
746
747
748
749
750
751
	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");

752
753
754
755
756
757
758
759
760
    if (defined($manifest)) {
	$manifest = GeniXML::Parse($manifest);
	if (!defined($manifest)) {
	    print STDERR "Error reading manifest\n";
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					"Bad manifest");
	}
    }
    
761
762
763
    #
    # For now, only allow top level aggregate or the slice
    #
764
    my ($slice, $aggregate) = Credential2SliceAggregate($credential);
765
766
    return $slice
	if (defined($slice) && GeniResponse::IsResponse($slice));
Srikanth's avatar
Srikanth committed
767

768
769
770
771
772
    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
773
            return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
774
775
776
777
                      "Credential target does not match CM URN");
          }

      if (!defined($slice_urn)) {
Srikanth's avatar
Srikanth committed
778
779
          return GeniResponse->MalformedArgsResponse("Missing arguments");
      }       
780
781
782
783
784
785
786
787
      $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
788
    } 
789

790
791
792
793
794
795
    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
796
797
	    return
		GeniResponse->MalformedArgsResponse("Bad characters in URN");
798
	}
799
800
801
	if ($slice_urn ne $slice->urn()) {
	    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
					"Credential does not match the URN");
802
	}
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
    }
    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
821
	if ($action eq "start") {
822
823
	    if ($object->state() ne "stopped" && $object->state() ne "new"
		&& $object->state() ne "mixed") {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
824
825
826
827
828
		return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
					    "Sliver is not stopped (yet)");
	    }
	}
	elsif ($action eq "stop") {
829
	    if ($object->state() ne "started" && $object->state() ne "mixed") {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
830
831
832
833
834
		return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
					    "Sliver is not started (yet)");
	    }
	}
	elsif ($action eq "restart") {
835
	    if ($object->state() ne "started" && $object->state() ne "mixed") {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
836
837
838
		return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
					    "Sliver is not started (yet)");
	    }
839
840
841
842
843
844
	}
	return 0;
    };
    my $PerformAction = sub {
	my ($object, $action) = @_;

845
846
	my $exitval = 0;

847
	if ($action eq "start") {
848
	    $exitval = $object->Start($API_VERSION, 0);
849
	}
850
	elsif ($action eq "stop") {
851
	    $exitval = $object->Stop($API_VERSION);
852
853
	}
	elsif ($action eq "restart") {
854
	    $exitval = $object->Start($API_VERSION, 1);
855
	}
856
857
858
859
	return GeniResponse->Create(GENIRESPONSE_ERROR, 
				    "Could not $action sliver")
	    if ($exitval);
	
860
861
862
	return 0;
    };

863
864
865
866
867
868
869
870
871
872
873
    my $user = GeniCM::CreateUserFromCertificate($credential);
    return $user
	if (GeniResponse::IsResponse($user));

    my $realuser = GeniCM::FlipToUser($slice, $user);
    if (! (defined($realuser) && $realuser)) {
	print STDERR "Error flipping to real user\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "FlipToUser Error");
    }

874
875
876
877
878
    if (defined($slice_urn)) {
	$response = &$CheckState($aggregate, $action);
	goto bad
	    if (GeniResponse::IsResponse($response));
	    
879
880
881
	if ($action eq "start" || $action eq "restart") {
	    if (defined($manifest) &&
		$aggregate->ProcessManifest($manifest)) {
882
883
884
885
886
		$response = GeniResponse->Create(GENIRESPONSE_ERROR,
						 undef,
						 "Error processing manifest");
		goto bad;
	    }
887
888
889
890
891
892
893
894
895
896
897
898
899
900
	    #
	    # At this point we want to return and let the startsliver proceed
	    # in the background
	    #
	    my $mypid = fork();
	    if ($mypid) {
		# Let the child get going.
		sleep(1);
		return GeniResponse->Create(GENIRESPONSE_SUCCESS);
	    }
	    $isasync = 1;
	    
	    # This switches the file that we are writing to. 
	    libaudit::AuditFork();
901
	}
902
903
904
905
	$response = &$PerformAction($aggregate, $action);
	goto bad
	    if (GeniResponse::IsResponse($response));

906
	$slice->UnLock();
907
908
	return ($isasync ? GENIRESPONSE_SUCCESS :
		GeniResponse->Create(GENIRESPONSE_SUCCESS));
909
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
910
    else {
911
	my @slivers = ();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
912

913
914
915
916
917
	#
	# 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
918
919
920
921
922
923
	    if (!defined($sliver)) {
		$response = GeniResponse->Create(GENIRESPONSE_SEARCHFAILED,
						 undef,
						 "Nothing here by that name");
		goto bad;
	    }
924
925
926
927
928
929
930
931
	    
	    $response = &$CheckState($sliver, $action);
	    goto bad
		if (GeniResponse::IsResponse($response));

	    push(@slivers, $sliver);
	}
	foreach my $sliver (@slivers) {
932
933
934
935
936
937
938
939
	    if ($action eq "start" && defined($manifest)) {
		if ($sliver->ProcessManifest($manifest)) {
		    $response = GeniResponse->Create(GENIRESPONSE_ERROR,
				     undef,
				     "Error processing manifest for $sliver");
		    goto bad;
		}
	    }
940
941
942
943
944
945
	    $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
946
    }
947
948
  bad:
    $slice->UnLock();
949
    return ($isasync ? $response->{'code'} : $response);
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
}

#
# 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);
980
981
982
    return $slice
	if (defined($slice) && GeniResponse::IsResponse($slice));

983
    if (! (defined($slice) && defined($aggregate))) {
984
	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
985
986
987
988
989
				    "No slice or aggregate here");
    }
    if ($slice_urn ne $slice->urn()) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
				    "Credential does not match the URN");
990
991
992
993
    }
    if ($slice->Lock() != 0) {
	return GeniResponse->BusyResponse();
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
994
995
996
997
998
    if ($aggregate->ComputeState()) {
	print STDERR "SliverStatus: Could not compute state for $aggregate\n";
	$slice->UnLock();
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
999
1000

    #