GeniCM.pm.in 209 KB
Newer Older
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1
2
#!/usr/bin/perl -wT
#
3
# Copyright (c) 2008-2015 University of Utah and the Flux Group.
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
# 
# {{{GENIPUBLIC-LICENSE
# 
# GENI Public License
# 
# Permission is hereby granted, free of charge, to any person obtaining
# a copy of this software and/or hardware specification (the "Work") to
# deal in the Work without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense,
# and/or sell copies of the Work, and to permit persons to whom the Work
# is furnished to do so, subject to the following conditions:
# 
# The above copyright notice and this permission notice shall be
# included in all copies or substantial portions of the Work.
# 
# THE WORK IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
# OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
# HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
# WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE WORK OR THE USE OR OTHER DEALINGS
# IN THE WORK.
# 
# }}}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
29
30
31
32
33
34
35
36
37
38
39
#
package GeniCM;

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

40
41
@ISA    = qw(Exporter);
@EXPORT = qw();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
42
43
44

use GeniDB;
use Genixmlrpc;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
45
46
use GeniResponse;
use GeniTicket;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
47
use GeniCredential;
48
use GeniCertificate;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
49
use GeniSlice;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
50
use GeniAggregate;
51
use GeniAuthority;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
52
use GeniSliver;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
53
use GeniUser;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
54
use GeniRegistry;
55
use GeniUtil;
56
use GeniHRN;
57
use GeniXML;
58
use GeniStitch;
59
use GeniUsage;
60
use GeniImage;
61
use libtestbed;
62
use emutil;
63
64
use EmulabConstants;
use libEmulab;
65
use Lan;
66
use User;
67
use Experiment;
68
use NodeType;
69
use Node;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
70
71
use English;
use Data::Dumper;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
72
use XML::Simple;
73
use XML::LibXML;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
74
use Date::Parse;
75
use POSIX qw(strftime tmpnam ceil);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
76
use Time::Local;
77
use Compress::Zlib;
78
use File::Temp qw(tempfile);
79
use MIME::Base64;
80
use Digest::SHA1 qw(sha1_hex);
81
use POSIX ":sys_wait_h";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
82
83
84
85
86
87

# Configure variables
my $TB		   = "@prefix@";
my $TBOPS          = "@TBOPSEMAIL@";
my $TBAPPROVAL     = "@TBAPPROVALEMAIL@";
my $TBAUDIT   	   = "@TBAUDITEMAIL@";
88
89
my $TBBASE         = "@TBBASE@";
my $TBDOCBASE      = "@TBDOCBASE@";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
90
91
my $BOSSNODE       = "@BOSSNODE@";
my $OURDOMAIN      = "@OURDOMAIN@";
92
my $MAINSITE       = @TBMAINSITE@;
93
my $ELABINELAB     = @ELABINELAB@;
94
my $PGENIDOMAIN    = "@PROTOGENI_DOMAIN@";
95
my $PROTOUSER 	   = "elabman";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
96
my $CREATEEXPT     = "$TB/bin/batchexp";
97
my $ENDEXP         = "$TB/bin/endexp";
98
my $NFREE	   = "$TB/bin/nfree";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
99
my $AVAIL	   = "$TB/sbin/avail";
100
my $PTOPGEN	   = "$TB/libexec/ptopgen";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
101
102
my $TBSWAP	   = "$TB/bin/tbswap";
my $SWAPEXP	   = "$TB/bin/swapexp";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
103
104
my $PLABSLICE	   = "$TB/sbin/plabslicewrapper";
my $NAMEDSETUP     = "$TB/sbin/named_setup";
105
my $EXPORTS_SETUP  = "$TB/sbin/exports_setup";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
106
107
my $VNODESETUP     = "$TB/sbin/vnode_setup";
my $GENTOPOFILE    = "$TB/libexec/gentopofile";
108
my $IPASSIGN       = "$TB/libexec/ipassign_wrapper";
109
my $TARFILES_SETUP = "$TB/bin/tarfiles_setup";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
110
111
my $MAPPER         = "$TB/bin/mapper";
my $VTOPGEN        = "$TB/bin/vtopgen";
112
my $SNMPIT         = "$TB/bin/snmpit_test";
113
my $RESERVEVLANS   = "$TB/sbin/protogeni/reservevlans";
114
my $NEWGROUP       = "$TB/bin/newgroup";
115
116
my $NEWPROJECT     = "$TB/sbin/newproj";
my $MAKEPROJECT    = "$TB/sbin/mkproj";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
117
my $PRERENDER      = "$TB/libexec/vis/prerender";
118
119
my $SUDO           = "/usr/local/bin/sudo";
my $WAP            = "$TB/sbin/withadminprivs";
120
my $XMLLINT	   = "/usr/local/bin/xmllint";
121
my $ADDAUTHORITY   = "$TB/sbin/protogeni/addauthority";
122
my $EMULAB_PEMFILE = "@prefix@/etc/genicm.pem";
123
my $TARINSTALL     = "/usr/local/bin/install-tarfile";
124
my $IMAGE_SETUP    = "$TB/sbin/image_setup";
125
my $IMAGE_IMPORT   = "$TB/sbin/image_import";
126
my $SHAREVLAN      = "$TB/sbin/sharevlan";
127
my $FWNAME	   = "fw";
128
my $API_VERSION    = 1;
129
130
my $PROTOGENI_LOCALUSER   = @PROTOGENI_LOCALUSER@;
my $PROTOGENI_NONFSMOUNTS = @PROTOGENI_NONFSMOUNTS@;
131

132
133
134
135
136
# For location info.
my $default_longitude = undef;
my $default_latitude  = undef;
my $default_country   = undef;

137
138
139
140
141
142
143
144
145
146
#
# 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()
{
    return GeniResponse->Create( GENIRESPONSE_SUCCESS, $API_VERSION );
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
147
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
148
# Respond to a Resolve request. 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
149
150
151
152
153
154
#
sub Resolve($)
{
    my ($argref) = @_;
    my $uuid       = $argref->{'uuid'};
    my $cred       = $argref->{'credential'};
155
156
    my $type       = lc( $argref->{'type'} );
    my $hrn        = $argref->{'hrn'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
157
158
159
160

    if (! defined($cred)) {
	return GeniResponse->MalformedArgsResponse();
    }
161
162
163
164
    if (defined($uuid) && GeniHRN::IsValid($uuid)) {
	$hrn  = $uuid;
	$uuid = undef;
    }
165
166
167
168
169
170
171
172
173
174
175
176
    if( defined( $hrn ) && GeniHRN::IsValid( $hrn ) ) {
	my ($auth,$t,$id) = GeniHRN::Parse( $hrn );

	return GeniResponse->Create( GENIRESPONSE_ERROR, undef,
				     "Authority mismatch" )
	    if( $auth ne $OURDOMAIN );

	$type = lc( $t );
	
	$hrn = $id;	
    }
    if (! (defined($type) && ($type =~ /^(node)$/))) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
177
178
179
	return GeniResponse->MalformedArgsResponse();
    }
    # Allow lookup by uuid or hrn.
180
    if (! defined($uuid) && !defined( $hrn ) ) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
181
182
183
184
185
186
	return GeniResponse->MalformedArgsResponse();
    }
    if (defined($uuid) && !($uuid =~ /^[-\w]*$/)) {
	return GeniResponse->MalformedArgsResponse();
    }

187
    my $credential = GeniCredential::CheckCredential($cred);
188
189
190
    return $credential
	if (GeniResponse::IsResponse($credential));

191
    if ($type eq "node") {
192
	require Interface;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
193
194
195
	my $node;
	
	if (defined($uuid)) {
196
	    $node= GeniUtil::LookupNode($uuid);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
197
198
	}
	else {
199
	    $node= GeniUtil::LookupNode($hrn);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
200
	}
201
	if (! defined($node)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
202
203
204
	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED,
					undef, "Nothing here by that name");
	}
205

206
	my $rspec = GetAdvertisement(0, $node->node_id(), "0.1", undef);
207
208
209
210
	if (! defined($rspec)) {
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					"Could not start avail");
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
211
212
	
	# Return a blob.
213
	my $blob = { "hrn"          => "${PGENIDOMAIN}." . $node->node_id(),
Leigh B. Stoller's avatar
Leigh B. Stoller committed
214
		     "uuid"         => $node->uuid(),
215
		     "role"	    => $node->role(),
216
217
		     "hostname"     =>
			 GeniUtil::FindHostname($node->node_id()),
218
219
		     "physctrl"     => 
			 Interface->LookupControl( $node->phys_nodeid() )->IP(),
220
221
		     "urn"          => GeniHRN::Generate( $OURDOMAIN,
							  "node",
222
223
							  $node->node_id() ),
		     "rspec"        => $rspec
Leigh B. Stoller's avatar
Leigh B. Stoller committed
224
225
226
227
228
229
230
		   };

	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
    return GeniResponse->Create(GENIRESPONSE_UNSUPPORTED);
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
231
232
233
234
235
236
#
# Discover resources on this component, returning a resource availablity spec
#
sub DiscoverResources($)
{
    my ($argref) = @_;
237
    my $credstr   = $argref->{'credential'};
238
    my $available = $argref->{'available'} || 0;
239
    my $compress  = $argref->{'compress'} || 0;
240
    my $version   = $argref->{'rspec_version'} || undef;
241

242
    my $credential = GeniCredential::CheckCredential($credstr);
243
244
    return $credential
	if (GeniResponse::IsResponse($credential));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
245

246
247
    return DiscoverResourcesAux($available,
				$compress, $version, [$credential]);
248
249
}
# Helper function for V2.
250
sub DiscoverResourcesAux($$$$)
251
{
252
    my ($available, $compress, $version, $credentials) = @_;
253
    my $user_urn  = $ENV{'GENIRN'};
254
    $version   = "2"
255
256
257
	if (!defined($version));

    # Sanity check since this can come from client.
258
    if (! ($version eq "0.1" || $version eq "0.2" || $version eq "2"
259
260
261
	   || $version eq "3"
	   || $version eq "PG 0.1" || $version eq "PG 0.2"
	   || $version eq "PG 2")) {
262
263
264
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "Improper version request");
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
265

266
267
268
    # Oh, for $*%(s sake.  Frontier::RPC2 insists on representing a
    # Boolean as its own object type -- which Perl always interprets as
    # true, regardless of the object's value.  Undo all of that silliness.
269
270
271
272
273
274
    if (defined($available) && ref($available) eq 'Frontier::RPC2::Boolean') {
	$available = $available->value;
    }
    if (defined($compress) && ref($compress) eq 'Frontier::RPC2::Boolean') {
	$compress = $compress->value;
    }
275

Leigh B. Stoller's avatar
Leigh B. Stoller committed
276
277
278
279
    #
    # A sitevar controls whether external users can get any nodes.
    #
    my $allow_externalusers = 0;
280
    if (!GetSiteVar('protogeni/allow_externalusers', \$allow_externalusers)){
281
282
	      # Cannot get the value, say no.
	      $allow_externalusers = 0;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
283
    }
284
285
286
287
288
289
290

    # Figure out if user has a credentials that exempts him
    # from the following policy. If external users are blocked access
    # and he presents a credential that exempts him from it, 
    # then he should get access.
    my $isExempted = 0;
    foreach my $credential (@$credentials) {
291
        if (GeniXML::PolicyExists('allow_externalusers', $credential) == 1) {
292
293
294
295
296
297
        $isExempted = 1;
        last;
      }
    }

    if (!$allow_externalusers && !$isExempted) {
298
	my $user = GeniUser->Lookup($user_urn, 1);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
299
300
301
302
303
304
305
	# No record means the user is remote.
	if (!defined($user) || !$user->IsLocal()) {
	    return GeniResponse->Create(GENIRESPONSE_UNAVAILABLE, undef,
					"External users temporarily denied");
	}
    }

306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
    #
    # See if one of the credentials is a slice credential. If it is, and
    # that slice is active, pass it to ptopgen so that it includes the current
    # resources as available.
    #
    my $experiment = undef;
    foreach my $credential (@$credentials) {
	my ($auth, $type, $id) = GeniHRN::Parse($credential->target_urn());
	if ($type eq "slice") {
	    # Might not exist here yet.
	    my $slice = GeniSlice->Lookup($credential->target_urn());
	    if (defined($slice)) {
		# See if the local experiment exists yet.
		$experiment = Experiment->Lookup($slice->uuid());
	    }
	    last;
	}
    }

Leigh B. Stoller's avatar
Leigh B. Stoller committed
325
    #
326
    # Acquire the advertisement from ptopgen and compress it if requested.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
327
    #
328
    my $xml = GetAdvertisement($available, undef, $version, $experiment);
329
    if (! defined($xml)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
330
331
332
333
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Could not start avail");
    }

334
335
336
337
338
339
    if( $compress ) {
	my $coder = Frontier::RPC2->new();
	my $base64 = encode_base64( compress( $xml ) );
	$xml = $coder->base64( $base64 );	
    }

Leigh B. Stoller's avatar
Leigh B. Stoller committed
340
341
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, $xml);
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
342

343
344
345
#
# Use ptopgen in xml mode to spit back an xml file. 
#
346
sub GetAdvertisement($$$$)
347
{
348
    my ($available, $pc, $version, $experiment) = @_;
349
    my $xml = undef;
350
351
    my $gotlock = 0;
    my $filename = "/var/tmp/protogeni_resources.xml";
352

353
354
355
356
357
358
359
    $version = "0.1"
	if ($version eq "PG 0.1");
    $version = "0.2"
	if ($version eq "PG 0.2");
    $version = "2"
	if ($version eq "PG 2");

360
    my $invocation = "$PTOPGEN -x -g $version -r -f";
361
362
    if (defined($experiment)) {
	my $eid = $experiment->eid();
363
	my $pid = $experiment->pid();
364
	$invocation .= " -p $pid -e $eid";
365
    }
366
367
368
369
    $invocation .= " -a" unless $available;
    if (defined($pc)) {
	$invocation .= " -1 $pc";
    }
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
    if (!defined($pc)) {
      again:
	#
	# Grab a global script lock. This will ensure that only one ptopgen
	# runs at a time, and everyone else who comes along while that first
	# one is running, will share the same results file.
	#
	# Need to use a well known name, unless we want to share that name
	# via the DB. Lets be simple about it for now.
	#
	if ((my $locked = TBScriptLock("discover", 1)) != TBSCRIPTLOCK_OKAY()) {
	    if ($locked == TBSCRIPTLOCK_IGNORE) {
		#
		# Previous locker finished ptopgen.
		# Grab the file if it exists (small race), otherwise
		# try again from the top.
		#
		if (open(AVAIL, "$filename")) {
		    $xml = "";
		    while (<AVAIL>) {
			$xml .= $_;
		    }
		    close(AVAIL);
		    return $xml;
		}
		goto again;
	    }
	    else {
		print STDERR "Could not get ptopgen lockfile\n";
		return undef;
	    }
	}
	else {
	    #
	    # We got the lock so we get to run ptopgen.
	    #
	    $gotlock = 1;
	}
    }
409
    if (open(AVAIL, "$invocation |")) {
410
	$xml = "";
411
412
413
414
415
	while (<AVAIL>) {
	    $xml .= $_;
	}
	close(AVAIL);
    }
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
    #
    # The lock holder has to create the new version of the file for
    # anyone waiting. Need to do this atomically so that anyone still
    # reading the previous version does not get inconsistent data.
    #
    if ($gotlock) {
	my ($fh, $tempname) = tempfile(UNLINK => 0, DIR => "/var/tmp");
	if (!defined($fh)) {
	    print STDERR "Could not create temporary file: $!\n";
	    $xml = undef;
	}
	else {
	    print $fh $xml;
	    close($fh);
	    if (! rename($tempname, $filename)) {
		print STDERR "Could not rename temporary file: $!\n";
		$xml = undef;
	    }
	}
	TBScriptUnlock();
    }
437
438
439
    return $xml;
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
440
#
441
# Update a ticket with a new rspec.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
442
#
443
sub UpdateTicket($)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
444
445
{
    my ($argref) = @_;
446
447
448
449
450
451
452
453
454
455

    return GetTicket($argref, 1);
}

#
# Respond to a GetTicket request. 
#
sub GetTicket($;$)
{
    my ($argref, $isupdate) = @_;
456
    my $rspecstr   = $argref->{'rspec'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
457
    my $impotent   = $argref->{'impotent'};
458
459
    my $credstr    = $argref->{'credential'};
    my $tickstr    = $argref->{'ticket'};
460
461
462
463
464
465
466
    my $ticket;

    # Default to no update
    $isupdate = 0
	if (!defined($isupdate));
    $impotent = 0
	if (!defined($impotent));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
467

468
    if (! defined($credstr)) {
469
	return GeniResponse->MalformedArgsResponse();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
470
    }
471
    if (!defined($rspecstr)) {
472
473
	return GeniResponse->MalformedArgsResponse();
    }
474
475
476
477
    if (! ($rspecstr =~ /^[\040-\176\012\015\011]+$/)) {
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "Improper characters in rspec");
    }
478
    my $credential = GeniCredential::CheckCredential($credstr);
479
480
481
    return $credential
	if (GeniResponse::IsResponse($credential));

482
    if ($isupdate) {
483
	$ticket = CheckTicket($tickstr, $credential->target_urn());
484
485
	return $ticket
	    if (GeniResponse::IsResponse($ticket));
486
    }
487
    return GetTicketAux($credential,
488
			$rspecstr, $isupdate, $impotent, 0, 1, 0, $ticket);
489
}
490

491
sub GetTicketAux($$$$$$$$$@)
492
{
493
    my ($credential, $rspecstr, $isupdate, $impotent, $v2, $level, $usetracker,
494
	$ticket, $speaksfor, @morecreds) = @_;
495
    
496
497
498
499
500
501
    defined($credential) &&
	($credential->HasPrivilege( "pi" ) or
	 $credential->HasPrivilege( "instantiate" ) or
	 $credential->HasPrivilege( "bind" ) or
	 return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				      "Insufficient privilege" ));
502
    
503
504
    my $slice_urn = $credential->target_urn();
    my $user_urn  = $credential->owner_urn();
505
    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
506
    #
507
    # Create user from the certificate.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
508
    #
509
    my $user = CreateUserFromCertificate($credential);
510
511
    return $user
	if (GeniResponse::IsResponse($user));
512
513
514

    # Bump activity. Does not matter if request fails ...
    $user->BumpActivity();
515
    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
516
    #
517
    # Create slice from the certificate.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
518
    #
519
520
    my $slice = GeniSlice->Lookup($slice_urn);
    if (!defined($slice)) {
521
	if ($isupdate) {
522
	    print STDERR "Could not locate slice $slice_urn for Update\n";
523
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
524
525
526
					"No slice found for UpdateTicket");
	}
	$slice = CreateSliceFromCertificate($credential, $user);
527
528
	return $slice
	    if (GeniResponse::IsResponse($slice));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
529
    }
530
531
532
    $slice->SetSpeaksFor($speaksfor)
	if (defined($speaksfor));
	
533
    main::AddLogfileMetaDataFromSlice($slice);
534
    
535
    return GetTicketAuxAux($slice, $user, $rspecstr,
536
537
			   $isupdate, $impotent, $v2, $level, $usetracker,
			   $ticket, [$credential, @morecreds], $speaksfor);
538
}
539
sub GetTicketAuxAux($$$$$$$$$$$)
540
{
541
    my ($slice, $user, $rspecstr, $isupdate,
542
543
	$impotent, $v2, $level, $usetracker,
	$ticket, $credentials, $speaksfor) = @_;
544
545
546
    my $response    = undef;
    my $restorevirt = 0;	# Flag to restore virtual state
    my $restorephys = 0;	# Flag to restore physical state
547
    require OSinfo;
548
    require Image;
549
    require VirtExperiment;
550
551
552
553
554
555

    #
    # We need this below to sign the ticket.
    #
    my $authority = GeniCertificate->LoadFromFile($EMULAB_PEMFILE);
    if (!defined($authority)) {
556
	print STDERR " Could not load authority for $EMULAB_PEMFILE\n";
557
558
559
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }

560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
    #
    # Run xmllint on the rspec to catch format errors.
    #
    my ($fh, $filename) = tempfile(UNLINK => 0);
    if (!defined($fh)) {
	print STDERR "Could not create temp file for rspec\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
    print $fh $rspecstr;
    close($fh);
    my $xmlerrors = `$XMLLINT --noout $filename 2>&1`;
    unlink($filename);
    if ($?) {
	return GeniResponse->Create(GENIRESPONSE_ERROR,
				    $xmlerrors,
				    "rspec is not well formed");
    }

578
579
    my $rspec = GeniXML::Parse($rspecstr);
    if (! defined($rspec)) {
580
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
581
				    "Error Parsing rspec XML");
582
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
583

584
585
586
587
588
589
    my $rspecVersion = GeniXML::GetXmlVersion($rspec);
    if (! defined($rspecVersion)) {
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "Unknown RSpec Version");
    }

Leigh B. Stoller's avatar
Leigh B. Stoller committed
590
591
592
593
    #
    # A sitevar controls whether external users can get any nodes.
    #
    my $allow_externalusers = 0;
594
    if (!GetSiteVar('protogeni/allow_externalusers', \$allow_externalusers)){
595
596
597
598
	    # Cannot get the value, say no.
	    $allow_externalusers = 0;
    }

599
600
601
602
603
604
605
606
607
608
609
    # Image tracker.
    my $use_imagetracker;
    if (!GetSiteVar('protogeni/use_imagetracker', \$use_imagetracker)) {
	# Cannot get the value, say no.
	$use_imagetracker = 0;
    }
    # But the Portal is currently the one telling us to use the tracker
    # for specific slices.
    $use_imagetracker = 1
	if ($use_imagetracker && $usetracker);

610
611
612
613
614
615
616
617
618
619
    # Figure out if user has a credentials that exempts him
    # from the following policy. If external users are blocked access
    # and he presents a credential that exempts him from it, 
    # then he should get access.
    my $isExempted = 0;
    foreach my $credential (@$credentials) {
      if (1 == GeniXML::PolicyExists('allow_externalusers', $credential)) {
        $isExempted = 1;
        last;
      }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
620
    }
621
622
623

    if (!$allow_externalusers && !$isExempted && !$user->IsLocal()) {
	    return GeniResponse->Create(GENIRESPONSE_UNAVAILABLE, undef,
Leigh B. Stoller's avatar
Leigh B. Stoller committed
624
625
626
627
				    "External users temporarily denied");
    }
    
    #
628
    # For now all tickets expire very quickly (minutes), but once the
Leigh B. Stoller's avatar
Leigh B. Stoller committed
629
    # ticket is redeemed, it will expire according to the rspec request.
630
631
    # If nothing specified in the rspec, then it will expire when the
    # slice record expires, which was given by the expiration time of the
632
633
    # slice credential, or the local policy max_sliver_lifetime. See
    # CreateSliceFromCertificate() in this file.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
634
    #
Jonathon Duerig's avatar
Jonathon Duerig committed
635
    my $expires = GeniXML::GetExpires($rspec);
636
    if (defined($expires)) {
637
638
	if (GeniResponse::IsResponse($expires)) {
	    return $expires;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
639
	}
640
641
	# Note "checkonly" flag; we do not actually change the slice
	# until the ticket is redeemed. 
642
	my $tmp = SetSliceExpiration($slice, $expires, 1, 0, @{ $credentials });
643
644
	if (GeniResponse::IsResponse($tmp)) {
	    return $tmp;
645
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
646
    }
647
648
649
650
651
652
653

    #
    # Lock the ticket so it cannot be released.
    #
    if (defined($ticket) && $ticket->stored() && $ticket->Lock() != 0) {
	return GeniResponse->BusyResponse("ticket");
    }
654
655
656
    if (defined($ticket)) {
	$ticket->SetSlice($slice);
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
657
658
659
660
661
662
    
    #
    #
    # Lock the slice from further access.
    #
    if ($slice->Lock() != 0) {
663
664
665
	$ticket->UnLock()
	    if (defined($ticket) && $ticket->stored());
	return GeniResponse->BusyResponse("slice");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
666
    }
667
668
669
    # Shutdown slices get nothing.
    if ($slice->shutdown()) {
	$slice->UnLock();
670
671
	$ticket->UnLock()
	    if (defined($ticket) && $ticket->stored());
672
673
674
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "Slice has been shutdown");
    }
675
676
677
678
679
680
681
682
    # Ditto for expired.
    if ($slice->IsExpired()) {
	$slice->UnLock();
	$ticket->UnLock()
	    if (defined($ticket) && $ticket->stored());
	return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
				    "Slice has expired");
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
683

684
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
685
    # For now, there can be only a single toplevel aggregate per slice.
686
    # The existence of an aggregate means the slice is active here. 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
687
    #
688
    my $aggregate = GeniAggregate->SliceAggregate($slice);
689
690
691
692
693
    if (!$isupdate) {
	if (defined($aggregate)) {
	    $response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				     "Already have an aggregate for slice");
	    goto bad;
694
695
	}
    }
696
    elsif ($v2 && $level > 0 && !defined($ticket) && !defined($aggregate)) {
697
698
699
700
	print STDERR "No aggregate for $slice in version two API\n";
	$response = GeniResponse->Create(GENIRESPONSE_ERROR);
	goto bad;
    }
701

702
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
703
    # We need this now so we can form a virtual topo.
704
    #
705
706
707
708
709
710
711
712
713
714
715
    my $slice_experiment = GeniExperiment($slice, $user);
    if (GeniResponse::IsResponse($slice_experiment)) {
	$response = $slice_experiment;
	$slice_experiment = undef;
	goto bad;
    }
    my $realuser = FlipToUser($slice, $user);
    if (! (defined($realuser) && $realuser)) {
	$response = GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					 "FlipToUser Error");
	print STDERR "Error flipping to real user\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
716
717
718
719
	goto bad;
    }
    my $pid = $slice_experiment->pid();
    my $eid = $slice_experiment->eid();
720
721
722
723
724

    #
    # Mark the experiment locally as coming from the cooked interface.
    # This changes what tmcd returns to the local nodes.
    #
725
    my $generated_by = GeniXML::GetText("generated_by", $rspec);
726
727
    if (defined($generated_by) &&
	$generated_by eq "libvtop") {
728
729
730
731
	$slice_experiment->Update({"geniflags" =>
				       $Experiment::EXPT_GENIFLAGS_EXPT|
				       $Experiment::EXPT_GENIFLAGS_COOKED});
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
732
733
734
735
736
737
738
739
740
741
742
743
744
    
    #
    # Create a virt topology object. We are going to load this up as we
    # process the rspec.
    #
    my $virtexperiment = VirtExperiment->CreateNew($slice_experiment);
    if (!defined($virtexperiment)) {
	print STDERR "Could not create VirtExperiment object!\n";
	$response = GeniResponse->Create(GENIRESPONSE_ERROR);
	goto bad;
    }
    # Turn off fixnode; we will control this on the commandline.
    $virtexperiment->allowfixnode(0);
745
    $virtexperiment->multiplex_factor(10);
746

747
748
749
750
751
752
753
754
755
756
    #
    # Add global vtypes.
    #
    my $vtypes_result =
	emdb::DBQueryWarn("select * from global_vtypes");
    if (!$vtypes_result) {
	$response = GeniResponse->Create(GENIRESPONSE_ERROR);
	goto bad;
    }
    while (my $row = $vtypes_result->fetchrow_hashref()) {
757
	$virtexperiment->NewTableRow("virt_vtypes",
758
759
760
761
				     {"name"     => $row->{'vtype'},
				      "members"  => $row->{'types'},
				      "weight"   => $row->{'weight'}
				     });
762
    }
763

764
765
766
767
768
    # Need to move this someplace else; the parser adds a bunch.
    $virtexperiment->NewTableRow("virt_agents",
				 {"vnode"      => "*",
				  "vname"      => "ns",
				  "objecttype" => "6"});
769

770
771
772
    #
    # Look for toplevel address pools
    #
773
774
775
776
777
778
779
    if (Node::HaveExperimentNodes()) {
	my $address_pools = GeniXML::GetAddressPools($rspec);
	foreach my $pool (@{ $address_pools }) {
	    if (! defined($pool->{'cmurn'}) ||
		$pool->{'cmurn'} eq $ENV{'MYURN'})
	    {
		if ($pool->{'type'} ne "any") {
780
		    $response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
781
782
783
784
785
		     "Only public address pools of type any are supported");
		    goto bad;
		}
		print STDERR 'DEBUG: Adding row to virt_address_allocation';
		$virtexperiment->NewTableRow("virt_address_allocation",
786
787
788
789
					 {"pool_id" => $pool->{'client_id'},
					  "count" => $pool->{'count'},
					  "restriction" => $pool->{'type'},
					  "version" => "ipv4" });
790
	    }
791
792
793
	}
    }

794
795
796
797
798
799
800
801
802
803
804
805
    #
    # Look for toplevel elabinelab section.
    #
    my $elabinelab_settings = GeniXML::GetElabInElabSettings($rspec);
    if (defined($elabinelab_settings)) {
	$virtexperiment->elab_in_elab(1);
	if (exists($elabinelab_settings->{'singlenet'})) {
	    $virtexperiment->elabinelab_singlenet(1);
	}
	if (exists($elabinelab_settings->{'xen'})) {
	    $virtexperiment->multiplex_factor(2);
	}
806
807
808
    }
    if ($PROTOGENI_NONFSMOUNTS) {
	$virtexperiment->nonfsmounts(1);
809
810
    }

Leigh B. Stoller's avatar
Leigh B. Stoller committed
811
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
812
813
    # An rspec is a structure that requests specific nodes. If those
    # nodes are available, then reserve it. Otherwise the ticket
Leigh B. Stoller's avatar
Leigh B. Stoller committed
814
815
    # cannot be granted.
    #
816
817
818
    my %namemap  = ();
    my %colomap  = ();
    my %ifacemap = ();
Jonathon Duerig's avatar
Jonathon Duerig committed
819
    my %iface2node = ();
820
    my %vportmap = ();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
821
    my %nodemap  = ();
822
    my %bridgemap= ();
823
    my @nodeids  = ();
824
    my %lannodes = ();
825
    # For stitching, keep track of external nodes and links.
826
827
828
    my %external_nodemap  = ();
    my %external_linkmap  = ();
    my %external_vportmap = ();
829
    my %external_lanrefs  = ();
830

831
832
833
    # Always do this to avoid buildup.
    $slice_experiment->ClearBackupState();
    
834
835
836
837
838
839
840
    #
    # If this is a ticket update, we want to seed the namemap with
    # existing nodes. This is cause the rspec might refer to wildcards
    # that were already bound in a previous call. We also want to know
    # what nodes are currently reserved in case we have to release some.
    #
    if ($isupdate) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
	if ($slice_experiment->BackupVirtualState()) {
	    print STDERR "Could not backup virtual state!\n";
	    $response = GeniResponse->Create(GENIRESPONSE_ERROR);
	    goto bad;
	}
	if ($slice_experiment->RemoveVirtualState()) {
	    print STDERR "Could not remove virtual state!\n";
	    $response = GeniResponse->Create(GENIRESPONSE_ERROR);
	    goto bad;
	}
	$restorevirt = 1;

	if ($slice_experiment->BackupPhysicalState()) {
	    print STDERR "Could not backup physical state!\n";
	    $response = GeniResponse->Create(GENIRESPONSE_ERROR);
	    goto bad;
	}
858
859
860
861
862
863
864
	my $oldrspec;
	if ($v2 && defined($aggregate)) {
	    $oldrspec = $aggregate->GetManifest(0);
	}
	else {
	    $oldrspec = $ticket->rspec();
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
865
	
866
	foreach my $ref (GeniXML::FindNodes("n:node",
867
					    $oldrspec)->get_nodelist()) {
868
	    # Let remote nodes pass through.
869
	    next
870
		if (!GeniXML::IsLocalNode($ref));
871

872
873
	    # Skip lan nodes; they are fake.
	    next
874
		if (GeniXML::IsLanNode($ref));
875

876
	    my $node_nickname = GeniXML::GetVirtualId($ref);
Jonathon Duerig's avatar
Jonathon Duerig committed
877
	    my $colocate      = GeniXML::GetColocate($ref);
878
	    my $component_id  = GeniXML::GetNodeId($ref);
879
880
	    my $vnode_id      = GeniXML::GetVnodeId($ref);
	    my $node = GeniUtil::LookupNode($vnode_id);
881
882
	    if (!defined($node)) {
		$response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
883
				 "Bad resource $component_id in ticket");
884
885
		goto bad;
	    }
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
	    #
	    # Is the node a virtual node? Must be an update to an
	    # existing sliver/ticket, since we now return the node_id
	    # of the allocated virtual node, not the physical node.
	    #
	    if ($node->isvirtnode()) {
		my $pnode = Node->Lookup($node->phys_nodeid());
		if (!defined($pnode)) {
		    $response =
			GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				     "No physical resource for $component_id");
		    goto bad;
		}
		$node = $pnode;
	    }
901
902
903
904
905
	    $namemap{$node_nickname} = $node;
	    $colomap{$colocate} = $node
		if (defined($colocate));
	}
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
906

907
    print GeniXML::Serialize($rspec);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
908

909
910
    my %nodeexistsmap = ();

911
    foreach my $ref (GeniXML::FindNodes("n:node", $rspec)->get_nodelist()) {
912
	my $component_id  = GeniXML::GetNodeId($ref);
913
	my $vnode_id      = GeniXML::GetVnodeId($ref);
914
	my $manager_id    = GeniXML::GetManagerId($ref);
915
	my $node_nickname = GeniXML::GetVirtualId($ref);
Jonathon Duerig's avatar
Jonathon Duerig committed
916
917
918
919
	my $colocate      = GeniXML::GetColocate($ref);
	my $subnode_of    = GeniXML::GetSubnodeOf($ref);
	my $virtualization_type = GeniXML::GetVirtualizationType($ref);
	
920
	my $virtualization_subtype
Jonathon Duerig's avatar
Jonathon Duerig committed
921
922
                          = GeniXML::GetVirtualizationSubtype($ref);
	my $exclusive     = GeniXML::GetExclusive($ref);
923
	my $tarfiles      = GeniXML::GetTarball($ref);
924
	my $pctype;
925
	my ($osname, $osinfo);
926
	my $parent_osname;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
927
	my $node;
928
929
	my $isbridge    = 0;
	my $isfirewall  = 0;
Leigh B Stoller's avatar
Leigh B Stoller committed
930
	my $xensettings;
931
	my $fwsettings;
932
	
933
	if (exists($nodeexistsmap{lc($node_nickname)})) {
934
935
936
937
938
	    $response =
		GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				     "Duplicate node $node_nickname");
	    goto bad;
	}
939
	$nodeexistsmap{lc($node_nickname)} = 1;
940

941
942
943
944
945
	# Always populate iface2node mapping, even if we let the node
	# pass through.
	foreach my $linkref (GeniXML::FindNodes("n:interface",
						$ref)->get_nodelist()) {
	    my $virtual_id   = GeniXML::GetInterfaceId($linkref);
946
947
948
949
950
951
952
	    if (exists($iface2node{$virtual_id})) {
		$response =
		    GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					 "Duplicate interface $virtual_id on ".
					 "node $node_nickname");
		goto bad;
	    }
953
954
955
	    $iface2node{$virtual_id} = $node_nickname;
	}

956
	# Let remote nodes pass through.
957
958
959
960
	if (! GeniXML::IsLocalNode($ref)) {
	    $external_nodemap{$node_nickname} = $ref;
	    next;
	}
961

962
	#
963
964
965
966
967
	#
	# Lan nodes are fake and do not go into the virt topo. Need
	# to remember them though, for when we do the links below.
	# They are still in the returned ticket though. 
	#
968
	if (GeniXML::IsLanNode($ref)) {
969
970
971
972
	    $lannodes{$node_nickname} = $ref;
	    next;
	}

973
974
975
976
977
978
979
980
	#
	# Check for total hostname length > 63 characters. This
	# breaks a lot of clients. Do this until we have a plan
	# for dealing with it on the clients. Why 63 instead of 64?
	# Cause of a bug in the event library code, that is now fixed,
	# but will not make it out to all images for a while. 
	#
	my $fullhostname = $node_nickname . ".${eid}.${pid}.${OURDOMAIN}";
981
	if (0 && length($fullhostname) > 63) {
982
983
984
985
	    $response = GeniResponse->Create(GENIRESPONSE_TOOBIG, undef,
				     "Hostname > 63 characters: $fullhostname");
	    goto bad;
	}
986
987
988
	#
	# Check for disk_image request. Specified as a URN. 
	#
989
	my $diskref = GeniXML::GetDiskImage($ref);
990
991
	if (defined($diskref)) {
	    my $dname = GeniXML::GetText("name", $diskref);
992
	    my $url   = GeniXML::GetText("url", $diskref);
993

994
995
996
997
998
	    # url is deprecated; name can be anything.
	    if (defined($dname) && $dname =~ /^http/) {
		$url = $dname;
	    }

999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
	    if (defined($url)) {
		if (! TBcheck_dbslot($url, "virt_nodes", "osname",
				 TBDB_CHECKDBSLOT_WARN|TBDB_CHECKDBSLOT_ERROR)){
		    $response =
			GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					     "Invalid disk image url: $url");
		    goto bad;
		}
		#
		# Pass it right through; we load them later.
		# There is no osinfo, but see below. 
		#
		$osname = $url;
	    }
	    elsif (defined($dname)) {
1014
1015
1016
1017
1018
1019
1020
		if (! GeniHRN::IsValid($dname)) {
		    $response =
			GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					 "Malformed image URN: $dname");
		    goto bad;
		}
		my ($auth,$type,$id) = GeniHRN::Parse($dname);
1021
1022
		my ($ospid,$os,undef,$vers) =
		    ($id =~ m{([^/]+)//([^/]+)(//(\d+))?});		
1023
1024
1025
1026
1027
1028
		if ($type ne "image" || !defined($ospid) || !defined($os)){
		    $response =
			GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					 "Malformed image URN: $dname");
		    goto bad;
		}
1029
		$osinfo = OSinfo->Lookup($ospid, $os, $vers);
1030
		if (!defined($osinfo)) {
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
		    if ($use_imagetracker) {
			my $image = GeniImage::MapToLocalImage($dname, $pid);
			if (GeniResponse::IsError($image)) {
			    $response = $image;
			    goto bad;
			}
			$osname = ($image->IsLocal() ?
				   $image->versname() :
				   $image->metadata_url());
		    }
		    else {
			$response =
			    GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
						 "Unknown image URN: $dname");
			goto bad;
		    }
1047
		}
1048
1049
1050
1051
1052
1053
1054
1055
1056
		else {
		    #
		    # The OS must be in the current project, or it must
		    # be global (okay, shared).
		    #
		    if (! ($osinfo->shared() ||
			   $osinfo->pid() eq $slice_experiment->pid())) {
			$response =
			    GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
1057
				 "Insufficient permission to use $osinfo");
1058
1059
			goto bad;
		    }
1060
		
1061
1062
1063
1064
1065
1066
		    #
		    # This is only going to be used in raw mode. 
		    #
		    $osname  = "$ospid/$os";
		    $osname .= ":${vers}" if (defined($vers));
		}
1067
1068
1069
	    }
	}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
1070
1071
1072
	if (defined($virtualization_type)) {
	    if ($virtualization_type eq "emulab-vnode") {
		if (defined($virtualization_subtype)) {
1073
1074
		    $pctype = "pcvm";
		    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1075
1076
1077
1078
		    if ($virtualization_subtype eq "emulab-jail") {
			$osname = "FBSD-JAIL";
		    }
		    elsif ($virtualization_subtype eq "emulab-openvz") {
1079
1080
1081
1082
1083
1084
1085
1086
			# Allow caller to set the image to use, but also
			# trick to set the parent. 
			if (defined($osinfo)) {
			    if (! $osinfo->IsSubOS()) {
				$parent_osname = $osname;
				$osname = "OPENVZ-STD";
			    }
			}
1087
1088
			elsif (!defined($osname)) {
			    # Allow for url above.
1089
1090
			    $osname = "OPENVZ-STD";
			}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1091
		    }
1092
1093
		    elsif ($virtualization_subtype eq "emulab-xen" ||
			   $virtualization_subtype eq "default-vm") {
1094
1095
1096
1097
1098
			# Allow caller to set the image to use, but also
			# trick to set the parent. 
			if (defined($osinfo)) {
			    if (! $osinfo->IsSubOS()) {
				$parent_osname = $osname;
1099
				$osname = "UBUNTU12-64-STD";
1100
1101
1102
1103
			    }
			}
			elsif (!defined($osname)) {
			    # Allow for url above.
1104
			    $osname = "UBUNTU12-64-STD";
1105
			}
Leigh B Stoller's avatar
Leigh B Stoller committed
1106
1107
1108
1109
1110
1111
			#
			# Look for the knobs
			#
			if (GeniXML::HasXenSettings($ref)) {
			    $xensettings = GeniXML::GetXenSettings($ref);
			}
1112
1113
1114
			my $ptype = GeniXML::XenPtype($ref);
			$pctype = $ptype
			    if (defined($ptype));
1115
			$virtexperiment->encap_style("vlan");
1116
1117
1118
1119
1120
1121
1122

			#
			# Per-vnode firewall options.
			#
			if (GeniXML::HasFirewallSettings($ref)) {
			    $fwsettings = GeniXML::GetFirewallSettings($ref);
			}
1123
		    }
1124
1125
1126
1127
		    elsif ($virtualization_subtype eq "emulab-spp") {
			$osname = "SPPVM-FAKE";
			$pctype = "sppvm";
			# Lets force to shared node.
Jonathon Duerig's avatar
Jonathon Duerig committed
1128
			if (! GeniXML::SetExclusive($ref, 0)) {
1129
1130
1131
			    $response
				= GeniResponse->Create(GENIRESPONSE_BADARGS,
						       undef,
1132
1133
				       "Malformed rspec: ".
				       "Cannot set exclusive tag to false");
1134
1135
1136
			    goto bad;
			}
			$exclusive = 0;