GeniSliver.pm.in 24.4 KB
Newer Older
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1
2
#!/usr/bin/perl -wT
#
3
# GENIPUBLIC-COPYRIGHT
4
# Copyright (c) 2008-2009 University of Utah and the Flux Group.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
5
6
7
8
9
10
11
12
13
14
15
16
17
# All rights reserved.
#
package GeniSliver;

#
use strict;
use Exporter;
use vars qw(@ISA @EXPORT);

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

use GeniDB;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
18
use GeniComponent;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
19
use GeniSlice;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
20
use GeniCredential;
21
use GeniCertificate;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
22
use GeniAggregate;
23
use GeniUsage;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
24
# Hate to import all this crap; need a utility library.
25
use emutil;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
26
use Experiment;
27
use OSinfo;
28
use Node;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
29
use English;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
30
use XML::Simple;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
31
32
use Data::Dumper;
use File::Temp qw(tempfile);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
33
use overload ('""' => 'Stringify');
Leigh B. Stoller's avatar
Leigh B. Stoller committed
34
35
36
37
38
39
40
41

# Configure variables
my $TB		   = "@prefix@";
my $TBOPS          = "@TBOPSEMAIL@";
my $TBAPPROVAL     = "@TBAPPROVALEMAIL@";
my $TBAUDIT   	   = "@TBAUDITEMAIL@";
my $BOSSNODE       = "@BOSSNODE@";
my $OURDOMAIN      = "@OURDOMAIN@";
42
my $PGENIDOMAIN    = "@PROTOGENI_DOMAIN@";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
43
my $SIGNCRED	   = "$TB/sbin/signgenicred";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
44
45
46
my $AVAIL	   = "$TB/sbin/avail";
my $NALLOC	   = "$TB/bin/nalloc";
my $NFREE	   = "$TB/bin/nfree";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
47
my $NODEREBOOT	   = "$TB/bin/node_reboot";
48
my $NAMEDSETUP     = "$TB/sbin/named_setup";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
49
50
my $PLABNODE       = "$TB/sbin/plabnodewrapper";
my $VNODESETUP     = "$TB/sbin/vnode_setup";
51
my $GENTOPOFILE    = "$TB/libexec/gentopofile";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
52
53
54

# Cache of instances to avoid regenerating them.
my %slivers      = ();
55
BEGIN { use GeniUtil; GeniUtil::AddCache(\%slivers); }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
56
57
58
59
60
61
62
63

#
# Lookup by idx, or uuid.
#
sub Lookup($$)
{
    my ($class, $token) = @_;
    my $query_result;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
64
    my $idx;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
65
66

    if ($token =~ /^\d+$/) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
67
	$idx = $token;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
68
69
70
    }
    elsif ($token =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/) {
	$query_result =
Leigh B. Stoller's avatar
Leigh B. Stoller committed
71
	    DBQueryWarn("select idx from geni_slivers ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
72
			"where uuid='$token'");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
73
74
75
76
	    return undef
		if (! $query_result || !$query_result->numrows);

	    ($idx) = $query_result->fetchrow_array();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
77
78
79
80
    }
    else {
	return undef;
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
81
82
83
84
85
86
87
88

    # Look in cache first
    return $slivers{"$idx"}
        if (exists($slivers{"$idx"}));

    $query_result = DBQueryWarn("select * from geni_slivers ".
				"where idx='$idx'");

Leigh B. Stoller's avatar
Leigh B. Stoller committed
89
90
91
    return undef
	if (!$query_result || !$query_result->numrows);

Leigh B. Stoller's avatar
Leigh B. Stoller committed
92
93
    my $self              = {};
    $self->{'SLIVER'}     = $query_result->fetchrow_hashref();
94
    $self->{'SLICE'}      = undef;	# server
Leigh B. Stoller's avatar
Leigh B. Stoller committed
95
    $self->{'AGGREGATE'}  = undef;	# server
96
    $self->{'RSPEC'}      = undef;	# server
Leigh B. Stoller's avatar
Leigh B. Stoller committed
97
98
99
100
101
102

    my $rspec_string = $self->{'SLIVER'}->{'rspec_string'};
    if (defined($rspec_string) && $rspec_string ne "") {
	$self->{'RSPEC'} = XMLin($rspec_string,
				 ForceArray => ["node", "link"]);
    }
103
104
105
106
107
108
109
110
111
112
113

    #
    # Grab the certificate, since we will probably want it.
    #
    my $uuid = $self->{'SLIVER'}->{'uuid'};
    my $certificate = GeniCertificate->Lookup($uuid);
    if (!defined($certificate)) {
	print STDERR "Could not find certificate for sliver $idx ($uuid)\n";
	return undef;
    }
    $self->{'CERTIFICATE'} = $certificate;
114
115
116
117

    # Bless into sub package if called for.
    my $resource_type = $self->{'SLIVER'}->{'resource_type'};
    if (defined($resource_type) && $resource_type ne "") {
118
	bless($self, $class . "::" . $resource_type);
119
120
121
122
    }
    else {
	bless($self, $class);
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
    
    # Add to cache. 
    $slivers{$self->{'SLIVER'}->{'idx'}} = $self;
    
    return $self;
}

#
# Stringify for output.
#
sub Stringify($)
{
    my ($self) = @_;
    
    my $uuid = $self->uuid();
    my $idx  = $self->idx();

    return "[GeniSliver: $uuid, IDX: $idx]";
}

#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
144
# Create a sliver record in the DB. On the client side we save the credential
Leigh B. Stoller's avatar
Leigh B. Stoller committed
145
# that allows control of it, for later operations.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
146
#
147
sub Create($$$$$$$$$)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
148
{
149
    my ($class, $slice, $owner, $uuid, $resource_uuid, $resource_type,
150
	$hrn, $nickname, $rspec) = @_;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
151
    my @insert_data = ();
152
    my $certificate;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
153
154
155

    # Every sliver gets a new unique index.
    my $idx = TBGetUniqueIndex('next_sliver', 1);
156
157
158
159
160
161
162
163
    
    # Create a cert pair, for this resource uuid.
    if (defined($uuid) && $resource_type eq "Node") {
	$certificate = GeniCertificate->Lookup($uuid);

	if (defined($certificate) && $certificate->hrn() ne $hrn) {
	    print STDERR "GeniSliver::Create: ".
		"Already have a certificate for $hrn/$uuid\n";
164
165
	    return undef;
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
166
    }
167
168
    $certificate = GeniCertificate->Create("sliver", $hrn, $TBOPS, $uuid)
	if (!defined($certificate));
169
	
170
171
172
173
    if (!defined($certificate)) {
	print STDERR "GeniSliver::Create: ".
	    "Could not generate new certificate and UUID for $hrn/$uuid\n";
	return undef;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
174
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
175
    my $slice_uuid     = $slice->uuid();
176
    my $owner_uuid     = $owner->uuid();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
177
178
179
180

    # Now tack on other stuff we need.
    push(@insert_data, "created=now()");
    push(@insert_data, "idx='$idx'");
181
182
183
    push(@insert_data, "hrn=" . DBQuoteSpecial($hrn));
    push(@insert_data, "nickname=" . DBQuoteSpecial($nickname))
	if (defined($nickname));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
184
    push(@insert_data, "uuid='$uuid'");
185
186
    push(@insert_data, "resource_uuid='$resource_uuid'");
    push(@insert_data, "resource_type='$resource_type'");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
187
188
189
    push(@insert_data, "creator_uuid='$owner_uuid'");
    push(@insert_data, "slice_uuid='$slice_uuid'");

Leigh B. Stoller's avatar
Leigh B. Stoller committed
190
191
192
193
194
195
196
    if (defined($rspec)) {
	my $rspec_string = XMLout($rspec, RootName => "rspec");
	my $safe_rspec   = DBQuoteSpecial($rspec_string);

	push(@insert_data, "rspec_string=$safe_rspec");
    }

Leigh B. Stoller's avatar
Leigh B. Stoller committed
197
    # Insert into DB.
198
199
200
    if (!DBQueryWarn("insert into geni_slivers set " .
		     join(",", @insert_data))) {
	$certificate->Delete();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
201
202
203
	return undef;
    }

Leigh B. Stoller's avatar
Leigh B. Stoller committed
204
205
206
    my $sliver = GeniSliver->Lookup($idx);
    return undef
	if (!defined($sliver));
207
208
209
210
211

    if (GeniUsage->NewSliver($sliver, $slice, $owner)) {
	print STDERR
	    "GeniSliver::Create: GeniUsage->NewSliver($sliver) failed\n";
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
212
    $sliver->{'AGGREGATE'} = undef;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
213
    $sliver->{'SLICE'}     = undef;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
214
215

    return $sliver;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
216
217
218
219
220
}
# accessors
sub field($$) { return ((! ref($_[0])) ? -1 : $_[0]->{'SLIVER'}->{$_[1]}); }
sub idx($)		{ return field($_[0], "idx"); }
sub uuid($)		{ return field($_[0], "uuid"); }
221
222
sub hrn($)		{ return field($_[0], "hrn"); }
sub nickname($)		{ return field($_[0], "nickname"); }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
223
224
225
sub slice_uuid($)	{ return field($_[0], "slice_uuid"); }
sub creator_uuid($)	{ return field($_[0], "creator_uuid"); }
sub created($)		{ return field($_[0], "created"); }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
226
sub credential_idx($)	{ return field($_[0], "credential_idx"); }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
227
sub resource_uuid($)	{ return field($_[0], "resource_uuid"); }
228
sub resource_type($)	{ return field($_[0], "resource_type"); }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
229
230
231
sub component_uuid($)	{ return field($_[0], "component_uuid"); }
sub aggregate_uuid($)	{ return field($_[0], "aggregate_uuid"); }
sub rspec_string($)     { return field($_[0], "rspec_string"); }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
232
sub status($)		{ return field($_[0], "status"); }
233
sub state($)		{ return field($_[0], "state"); }
234
235
sub cert($)		{ return $_[0]->{'CERTIFICATE'}->cert(); }
sub GetCertificate($)   { return $_[0]->{'CERTIFICATE'}; }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
236
sub rspec($)            { return $_[0]->{'RSPEC'}; }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
237
238
239
240

#
# Delete the sliver. The sliver should not be provisioned when this done.
#
241
sub Delete($$)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
242
{
243
    my ($self, $purge) = @_;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
244
245
246
247

    return -1
	if (! ref($self));

248
249
    my $idx  = $self->idx();
    my $uuid = $self->uuid();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
250

251
252
253
254
    if (GeniUsage->DestroySliver($self, $purge)) {
	print STDERR
	    "GeniSliver::Delete: GeniUsage->DestroySliver($self) failed\n";
    }
255
256
    DBQueryWarn("delete from geni_credentials where this_uuid='$uuid'")
	or return -1;
257
258
259
260
    if ($self->resource_type() ne "Node") {
	DBQueryWarn("delete from geni_certificates where uuid='$uuid'")
	    or return -1;
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
261
262
    DBQueryWarn("delete from geni_slivers where idx='$idx'")
	or return -1;
263

264
265
266
    # Delete from cache. 
    delete($slivers{$idx});
    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
267
268
269
    return 0;
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
270
271
272
273
274
275
276
277
278
279
#
# Set the aggregate for a sliver.
#
sub SetAggregate($$)
{
    my ($self, $aggregate) = @_;

    return -1
	if (! (ref($self) && ref($aggregate)));

Leigh B. Stoller's avatar
Leigh B. Stoller committed
280
281
    my $idx      = $self->idx();
    my $agg_uuid = $aggregate->uuid();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
282
283
284

    return -1
	if (!DBQueryWarn("update geni_slivers set ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
285
			 "  aggregate_uuid='$agg_uuid' ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
286
287
			 "where idx='$idx'"));
    
288
289
290
291
292
293
294
    if (!DBQueryWarn("update sliver_history set ".
		     "  aggregate_uuid='$agg_uuid' ".
		     "where idx='$idx'")) {
	print STDERR "GeniSliver::SetAggregate: ".
	    "Failed to update sliver_history for $self\n";
    }

Leigh B. Stoller's avatar
Leigh B. Stoller committed
295
    $self->{'SLIVER'}->{'aggregate_uuid'} = $agg_uuid;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
296
297
298
299
    $self->{'AGGREGATE'} = $aggregate;
    return 0;
}

300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
#
# And clear the aggregate.
#
sub ClearAggregate($$)
{
    my ($self) = @_;

    return -1
	if (! ref($self));

    my $idx      = $self->idx();

    return -1
	if (!DBQueryWarn("update geni_slivers set ".
			 "  aggregate_uuid=NULL ".
			 "where idx='$idx'"));
    
    $self->{'SLIVER'}->{'aggregate_uuid'} = undef;
    $self->{'AGGREGATE'} = undef;
    return 0;
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
322
323
324
325
326
327
328
329
330
331
332
333
#
# Get the aggregate for a sliver.
#
sub GetAggregate($)
{
    my ($self) = @_;

    return undef
	if (! ref($self));

    return $self->{'AGGREGATE'} if (defined($self->{'AGGREGATE'}));
    return undef
Leigh B. Stoller's avatar
Leigh B. Stoller committed
334
	if (!defined($self->aggregate_uuid()));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
335

Leigh B. Stoller's avatar
Leigh B. Stoller committed
336
    my $aggregate = GeniAggregate->Lookup($self->aggregate_uuid());
Leigh B. Stoller's avatar
Leigh B. Stoller committed
337
338
339
340
341
342
343
344
    if (!defined($aggregate)) {
	print STDERR "Could not get aggregate object associated with $self\n";
	return undef;
    }
    $self->{'AGGREGATE'} = $aggregate;
    return $aggregate;
}

345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
#
# Set the status for the sliver.
#
sub SetStatus($$)
{
    my ($self, $status) = @_;

    return undef
	if (! ref($self));

    my $idx = $self->idx();
    
    return -1
	if (!DBQueryWarn("update geni_slivers set ".
			 "  status='$status' ".
			 "where idx='$idx'"));
    
    $self->{'SLIVER'}->{'status'} = $status;
    return 0;
}

366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
#
# Set the state for the sliver.
#
sub SetState($$)
{
    my ($self, $state) = @_;

    return undef
	if (! ref($self));

    my $idx = $self->idx();
    
    return -1
	if (!DBQueryWarn("update geni_slivers set ".
			 "  state='$state' ".
			 "where idx='$idx'"));
    
    $self->{'SLIVER'}->{'state'} = $state;
    return 0;
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
387
388
389
390
391
392
393
394
395
396
397
398
399
#
# Get the experiment for the slice this sliver belongs to.
#
sub GetExperiment($)
{
    my ($self) = @_;

    return undef
	if (! ref($self));

    return Experiment->Lookup($self->slice_uuid());
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
#
# Get the slice for the sliver.
#
sub GetSlice($)
{
    my ($self) = @_;

    return undef
	if (! ref($self));

    return $self->{'SLICE'} if (defined($self->{'SLICE'}));

    if (!defined($self->slice_uuid())) {
	print STDERR "No slice associated with $self\n";
	return undef;
    }
    my $slice = GeniSlice->Lookup($self->slice_uuid());
    if (!defined($slice)) {
	print STDERR "Could not get slice object associated with $self\n";
	return undef;
    }
    $self->{'SLICE'} = $slice;
    return $slice;
}

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
#
# Look up a list of slivers for a locally instantiated slice. 
# Used by the CM.
#
sub SliceSlivers($$$)
{
    my ($class, $slice, $pref) = @_;

    my $slice_uuid = $slice->uuid();
    my @result = ();

    my $query_result =
	DBQueryWarn("select idx from geni_slivers ".
		    "where slice_uuid='$slice_uuid'");
    return -1
	if (!$query_result);

    while (my ($idx) = $query_result->fetchrow_array()) {
	my $sliver = GeniSliver->Lookup($idx);
	return -1
	    if (!defined($sliver));
	push(@result, $sliver);
    }
    @$pref = @result;
    return 0;
}

452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
#
# Find slivers "dependent" on this sliver, as for interfaces on nodes.
#
sub DependentSlivers($$)
{
    my ($self, $pref) = @_;

    return -1
	if (! (ref($self) && ref($pref)));
    @$pref = ();

    my $idx = $self->idx();
    my $resource_uuid = $self->resource_uuid();

    my $query_result =
	DBQueryWarn("select idx from geni_slivers ".
		    "where idx!='$idx' and resource_uuid='$resource_uuid'");
    return -1
	if (!$query_result);

    my @result = ();
    while (my ($idx) = $query_result->fetchrow_array()) {
	my $sliver = GeniSliver->Lookup($idx);
	if (!defined($sliver)) {
	    print STDERR "Could not get sliver object for $idx\n";
	    return -1;
	}
	push(@result, $sliver);
    }
    @$pref = @result;
    return 0;
}

485
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
486
487
# Create a signed credential for this sliver, issued to the provided user.
# The credential will grant all permissions for now.
488
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
489
490
491
# Should we store these credentials in the DB, recording what we hand out?
#
sub NewCredential($$)
492
{
Leigh B. Stoller's avatar
Leigh B. Stoller committed
493
    my ($self, $owner) = @_;
494

Leigh B. Stoller's avatar
Leigh B. Stoller committed
495
496
    return undef
	if (! (ref($self) && ref($owner)));
497

Leigh B. Stoller's avatar
Leigh B. Stoller committed
498
499
500
501
502
    my $credential = GeniCredential->Create($self, $owner);
    if (!defined($credential)) {
	print STDERR "Could not create credential for $self, $owner\n";
	return undef;
    }
503
504
505
    if (defined($self->nickname())) {
	$credential->AddExtension("nickname", $self->nickname());
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
506
507
508
509
510
511
    if ($credential->Sign($self->GetCertificate()) != 0) {
	print STDERR "Could not sign credential for $self, $owner\n";
	return undef;
    }
    return $credential;
}
512

513
514
515
516
517
518
519
520
521
522
523
524
525
############################################################################
#
# The server side methods are in packages which inherit from above.
#
package GeniSliver::Node;
use vars qw(@ISA);
@ISA = "GeniSliver";

use GeniDB;
use GeniComponent;
use GeniSlice;
use GeniCredential;
use GeniCertificate;
526
use GeniUtil;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
527
use Experiment;
528
use emutil;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
529
use XML::Simple;
530
531
use libdb qw(TBDB_ALLOCSTATE_RES_INIT_DIRTY TBDB_NODESTATE_SHUTDOWN
	     TBResolveNextOSID);
532

533
sub Create($$$$$$)
534
{
535
    my ($class, $slice, $user, $resource_uuid, $sliver_uuid, $rspec) = @_;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
536
537
538
539
540
    my $virtualization_type = $rspec->{'virtualization_type'};

    my $experiment = $slice->GetExperiment();
    if (!defined($experiment)) {
	print STDERR "Could not map $slice to its experiment\n";
541
	return undef;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
542
    }
543

Leigh B. Stoller's avatar
Leigh B. Stoller committed
544
545
546
547
548
549
550
551
    #
    # the node is already allocated to the sliver, but still need to enter
    # a virt_nodes entry, and possibly more virt table entries, so that the
    # node will boot properly, and is otherwise controllable.
    #
    my $node = Node->Lookup($resource_uuid);
    if (!defined($node)) {
	print STDERR "Could not map node $resource_uuid to its object\n";
552
	return undef;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
553
    }
554
555
556
557
558
559
560

    #
    # An artifact of Emulab is that for shared/remote nodes, the physical
    # node is already allocated, but not to the current experiment. An
    #
    if (! ($node->sharing_mode() ||
	   ($node->isremotenode() && $node->isvirtnode()))) {
561
562
563
564
565
566
	my $reservation = $node->Reservation();
	if (!defined($reservation)) {
	    print STDERR "$node was already released from $slice\n";
	    return undef;
	}
	if (! $reservation->SameExperiment($experiment)) {
567
	    print STDERR "$node is reserved to another, not $experiment\n";
568
569
570
	    # Signal error so we can look at what happened.
	    return undef;
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
571
    }
572
    my $hrn = "${PGENIDOMAIN}." . $node->node_id();
573
    my $nickname = $rspec->{'virtual_id'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
574
    $sliver_uuid = $node->uuid();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
575
576
577
578
579
580
    
    #
    # The resource UUID refers to the physical node, but the virtualization
    # type might require a vnode.
    # 
    if ($virtualization_type eq "emulab-vnode") {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
581
582
583
	my $vnode = $experiment->VnameToNode($nickname);
	if (!defined($vnode)) {
	    print STDERR "Could not lookup node $nickname in $experiment\n";
584
	    return undef;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
585
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
586
587
	$hrn = "${PGENIDOMAIN}." . $vnode->node_id();
	$sliver_uuid = $vnode->uuid();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
588
    }
589
    return GeniSliver->Create($slice, $user, $sliver_uuid, $resource_uuid,
590
			      "Node", $hrn, $nickname, $rspec);
591
592
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
593
594
#
# Provision a slice. We actually did this when the ticket was requested.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
595
# We fill in some virt table stuff so that tbswap will work.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
596
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
597
sub Provision($;$)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
598
{
Leigh B. Stoller's avatar
Leigh B. Stoller committed
599
    my ($self, $extraargs) = @_;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
600
601
602
603
604
605
606

    return -1
	if (! ref($self));

    #
    # the node is already allocated to the sliver, but still need to enter
    # a virt_nodes entry, and possibly more virt table entries, so that the
Leigh B. Stoller's avatar
Leigh B. Stoller committed
607
    # node will boot properly, and is otherwise controllable.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
608
609
610
611
612
613
    #
    my $experiment = Experiment->Lookup($self->slice_uuid());
    if (!defined($experiment)) {
	print STDERR "Could not map $self to its experiment\n";
	return -1;
    }
614
    my $uuid = $self->uuid();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
615
    return 0
616
617
	if (!defined($uuid));
    my $node       = Node->Lookup($uuid);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
618
    if (!defined($node)) {
619
	print STDERR "Could not map node $uuid to its object\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
620
621
	return -1;
    }
622
    my $node_id     = $node->node_id();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
623
624
    my $reservation = $node->Reservation();
    if (!defined($reservation)) {
625
	print STDERR "$node was already released from slice\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
626
627
	return -1;
    }
628
    if (! $reservation->SameExperiment($experiment)) {
629
	print STDERR "$node is reserved to another, not $experiment\n";
630
631
632
633
634
	# Signal error so we can look at what happened.
	return -1;
    }
    my $pid = $experiment->pid();
    my $eid = $experiment->eid();
635

636
637
638
639
640
641
642
    if (!$node->isremotenode() &&
	exists($self->rspec()->{'virtualization_type'}) &&
	$self->rspec()->{'virtualization_type'} eq "emulab-vnode") {
	my $pnode = Node->Lookup($node->phys_nodeid());
	if (!defined($pnode)) {
	    print STDERR "Could not get pnode object for $node\n";
	    return -1;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
643
	}
644

645
646
	# Mark
	$node->ModifyReservation({"genisliver_idx" => $self->idx()});
647

Leigh B. Stoller's avatar
Leigh B. Stoller committed
648
649
650
651
652
653
	if (exists($self->rspec()->{'virtualization_subtype'})) {
	    my $subtype = $self->rspec()->{'virtualization_subtype'};
	    
	    if (!$pnode->sharing_mode()) {
		$pnode->ModifyReservation({"genisliver_idx" => $self->idx()});
	    }
654
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
655
656
    }
    else {
657
658
659
660
661
662
663
	#
	# For a "raw" node, there is no vnode, so this is the pnode
	# we need to mark for tmcd.
	#
	if ($node->ModifyReservation({"genisliver_idx" => $self->idx()})) {
	    return -1;
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
664
665
666
667
668
669
670
671

	#
	# Terrible place to do this. 
	#
	if ($node->OSSelect("<DEFAULT>", "def_boot_osid", 0) != 0) {
	    print STDERR "Could not os_select $node to default\n";
	    return -1;
	}
672
    }
673
    $self->SetStatus("ready");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
674
675
676
677
678
679
    return 0;
}

#
# Unprovision a sliver. 
#
680
sub UnProvision($;$)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
681
{
682
    my ($self, $nophysfree) = @_;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
683
684
685

    return -1
	if (! ref($self));
686
687
    $nophysfree = 0
	if (!defined($nophysfree));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
688
689

    my $experiment = Experiment->Lookup($self->slice_uuid());
Leigh B. Stoller's avatar
Leigh B. Stoller committed
690
691
692
693
    if (!defined($experiment)) {
	print STDERR "Could not map $self to its experiment\n";
	return -1;
    }
694
    my $uuid = $self->uuid();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
695
    return 0
696
697
	if (!defined($uuid));
    my $node       = Node->Lookup($uuid);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
698
    if (!defined($node)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
699
	# Lets call this nonfatal since it might be a virtnode that 
700
	print STDERR "Could not map node $uuid to its object\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
701
	return 0;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
702
703
704
705
706
707
708
    }
    my $reservation = $node->Reservation();
    if (!defined($reservation)) {
	print STDERR "$node was already released from $self\n";
	return 0;
    }
    if ($reservation->SameExperiment($experiment)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
709
	my $node_id = $node->node_id();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
710
711
	my $pid = $experiment->pid();
	my $eid = $experiment->eid();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
712

713
	if ($node->isremotenode() && $node->isvirtnode()) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
714
	    system("$VNODESETUP -p -q -m -k $pid $eid $node_id");
715
	    if ($?) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
716
		print STDERR "$VNODESETUP -k failed on $node_id\n";
717
718
719
		return -1;
	    }
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
720
721
722
723
724
725
	elsif ($node->sharing_mode()) {
	    system("$VNODESETUP -j -q -m -k $pid $eid $node_id");
	    if ($?) {
		print STDERR "$VNODESETUP -k failed on $node_id\n";
		return -1;
	    }
726
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
727

728
729
	if (!$node->isremotenode() &&
	    $self->rspec()->{'virtualization_type'} eq "emulab-vnode") {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
730
731
732
733
734
735
	    my $pnode_id = $node->phys_nodeid();
	    my $pnode = Node->Lookup($pnode_id);
	    if (!defined($pnode)) {
		print STDERR "Could not get pnode object for $pnode_id\n";
		return -1;
	    }
736
737
738

	    #
	    # If this is the last virtnode on the physnode, release the
Leigh B. Stoller's avatar
Leigh B. Stoller committed
739
740
	    # physnode too. Unless its a shared host, in which case just
	    # deallocate the virtnode.
741
	    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
742
743
744
745
746
747
	    my @vnodes = ();
	    
	    if ($pnode->sharing_mode()) {
		$nophysfree = 1;
	    }
	    elsif ($pnode->VirtualNodes(\@vnodes) != 0) {
748
		print STDERR "Could not get vnode list for $pnode\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
749
750
		return -1;
	    }
751

752
	    if (scalar(@vnodes) > 1 || $nophysfree) {
753
		system("$NFREE -q $pid $eid $node_id");
754
755
756
		# Unincorporate the node. Bogus, needs fixing.
		$pnode->ModifyReservation({"genisliver_idx" => 0})
		    if (! ($pnode->sharing_mode() || scalar(@vnodes) > 1));
757
758
759
760
761
	    }
	    else {
		system("$NFREE -x -q $pid $eid $pnode_id");
		$pnode->Refresh();
	    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
762
763
	}
	else {
764
765
766
767
768
	    if ($nophysfree) {
		# Unincorporate the node. Bogus, needs fixing.
		$node->ModifyReservation({"genisliver_idx" => 0});
		goto skip;
	    }
769
	    system("$NFREE -q $pid $eid $node_id");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
770
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
771
772
	if ($?) {
	    print STDERR "Could not deallocate $node from $self\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
773
	    $node->Refresh();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
774
775
	    return -1;
	}
776
      skip:
Leigh B. Stoller's avatar
Leigh B. Stoller committed
777
	$node->Refresh();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
778
779
780
781
782
783
784
785
786
    }
    else {
	print STDERR "$node is reserved to another, not $self\n";
	# Signal error so we can look at what happened.
	return -1;
    }
    return 0;
}

787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
#
# Process a manifest.
#
sub ProcessManifest($$)
{
    my ($self, $manifest) = @_;

    return -1
	if (! ref($self));

    my $experiment = Experiment->Lookup($self->slice_uuid());
    if (!defined($experiment)) {
	print STDERR "Could not map $self to its experiment\n";
	return -1;
    }
    my $pid = $experiment->pid();
    my $eid = $experiment->eid();
    
    my $uuid = $self->uuid();
    return 0
	if (!defined($uuid));
    my $node       = Node->Lookup($uuid);
    if (!defined($node)) {
	print STDERR "Could not map node $uuid to its object\n";
	return -1;
    }
    my $reservation = $node->Reservation();
    if (!defined($reservation)) {
	print STDERR "$node was already released from $self\n";
	return -1;
    }
    if ($reservation->SameExperiment($experiment)) {
	#
	# Find the corresponding node in the manifest.
	#
	foreach my $ref (@{$manifest->{'node'}}) {
	    if ($ref->{'sliver_uuid'} eq $uuid) {
		# startup command.
		if (exists($ref->{'startup_command'})) {
		    my $startupcmd = $ref->{'startup_command'};
	    
		    if (! TBcheck_dbslot($startupcmd, "virt_nodes",
					 "startupcmd",
					 TBDB_CHECKDBSLOT_WARN|
					 TBDB_CHECKDBSLOT_ERROR)) {
			print STDERR "Invalid startup command '$startupcmd'\n";
			return -1;
		    }
		    $node->Update({"startupcmd" => $startupcmd});
		}
		return 0;
	    }
	}
    }
    else {
	print STDERR "$node is reserved to another, not $self\n";
	# Signal error so we can look at what happened.
	return -1;
    }
    return 0;
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
849
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
850
# Start a sliver, which means what?
Leigh B. Stoller's avatar
Leigh B. Stoller committed
851
#
852
sub Start($)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
853
854
855
856
857
858
859
860
861
862
863
{
    my ($self) = @_;

    return -1
	if (! ref($self));

    my $experiment = Experiment->Lookup($self->slice_uuid());
    if (!defined($experiment)) {
	print STDERR "Could not map $self to its experiment\n";
	return -1;
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
864
865
866
    my $pid = $experiment->pid();
    my $eid = $experiment->eid();
    
867
    my $uuid = $self->uuid();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
868
    return 0
869
870
	if (!defined($uuid));
    my $node       = Node->Lookup($uuid);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
871
    if (!defined($node)) {
872
	print STDERR "Could not map node $uuid to its object\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
873
874
875
876
877
878
879
880
	return -1;
    }
    my $reservation = $node->Reservation();
    if (!defined($reservation)) {
	print STDERR "$node was already released from $self\n";
	return -1;
    }
    if ($reservation->SameExperiment($experiment)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
881
	my $node_id = $node->node_id();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
882

Leigh B. Stoller's avatar
Leigh B. Stoller committed
883
884
885
	#
	# Reboot and wait?
	#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
886
887
888
889
890
891
892
893
	if ($node->isvirtnode() && $node->sharing_mode()) {
	    if ($node->eventstate() eq TBDB_NODESTATE_SHUTDOWN()) {
		system("$VNODESETUP -j -q -m $pid $eid $node_id");
	    }
	}
	else {
	    system("$NODEREBOOT -s $node_id");
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
894
895
	return -1
	    if ($?);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
896
897
898
899
900
    }
    else {
	print STDERR "$node is reserved to another, not $self\n";
	# Signal error so we can look at what happened.
	return -1;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
901
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
902
  done:
Leigh B. Stoller's avatar
Leigh B. Stoller committed
903
904
    return 0;
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
905

906
##########################################################################
907
#
908
909
910
911
912
913
914
915
916
package GeniSliver::Interface;
use vars qw(@ISA);
@ISA = "GeniSliver";

use GeniDB;
use GeniComponent;
use GeniSlice;
use GeniCredential;
use GeniCertificate;
917
use GeniUtil;
918
919
920

sub Create()
{
921
    my ($class, $slice, $user,
922
	$interface_uuid, $node, $linkname, $rspec) = @_;
923

924
925
926
    my $nickname = $node->node_id() . ".$linkname." .
	$rspec->{'virtual_interface_id'};
    my $hrn = "${PGENIDOMAIN}.$nickname";
927

928
929
930
931
    # Ignore the interface uuid and create a new one.
    # Temporary fix cause of shared interfaces on shared nodes.
    $interface_uuid = GeniUtil::NewUUID();

932
    return GeniSliver->Create($slice, $user, $interface_uuid,
933
934
			      $node->uuid(), "Interface",
			      $hrn, $nickname, $rspec);
935
936
937
938
939
940
}

sub Provision($)
{
    my ($self) = @_;

941
942
943
944
    #
    # This is actually implemented in GeniAggregate since currently "link"
    # is the smallest entity; you cannot operate on an individual interface.
    #
945
946
947
948
949
950
951
    return -1
	if (! ref($self));

    return 0;
}

#
952
# Unprovision a single interface from a link/lan. 
953
954
955
956
957
958
959
960
#
sub UnProvision($)
{
    my ($self) = @_;

    return -1
	if (! ref($self));

961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
    my $aggregate = $self->GetAggregate();
    if (!defined($aggregate)) {
	print STDERR "Could not find aggregate for $self\n";
	return -1;
    }

    #
    # This is terrible; we need an interface to remove ports form vlans,
    # so that we do not have to tear down the entire vlan and recreate.
    #
    if ($aggregate->UnProvision() != 0) {
	print STDERR "Could not unprovision $aggregate\n";
	return -1;
    }
    $self->ClearAggregate();
    if ($aggregate->Provision() != 0) {
	print STDERR "Could not provision $aggregate\n";
	return -1;
    }
980
981
982
983
    return 0;
}

#
984
# Start a sliver.
985
#
986
sub Start($)
987
988
989
{
    my ($self) = @_;

990
991
992
993
    #
    # This is actually implemented in GeniAggregate since currently "link"
    # is the smallest entity; you cannot operate on an individual interface.
    #
994
995
996
997
998
    return -1
	if (! ref($self));

    return 0;
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
999

Leigh B. Stoller's avatar
Leigh B. Stoller committed
1000
1001
# _Always_ make sure that this 1 is at the end of the file...
1;