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

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

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 libtestbed;
61
use emutil;
62
63
use EmulabConstants;
use libEmulab;
64
use Lan;
65
use Experiment;
66
use NodeType;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
67
68
use English;
use Data::Dumper;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
69
use XML::Simple;
70
use XML::LibXML;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
71
use Date::Parse;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
72
use POSIX qw(strftime tmpnam);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
73
use Time::Local;
74
use Compress::Zlib;
75
use File::Temp qw(tempfile);
76
use MIME::Base64;
77
use Digest::SHA1 qw(sha1_hex);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
78
79
80
81
82
83

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

#
# 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
136
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
137
# Respond to a Resolve request. 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
138
139
140
141
142
143
#
sub Resolve($)
{
    my ($argref) = @_;
    my $uuid       = $argref->{'uuid'};
    my $cred       = $argref->{'credential'};
144
145
    my $type       = lc( $argref->{'type'} );
    my $hrn        = $argref->{'hrn'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
146
147
148
149

    if (! defined($cred)) {
	return GeniResponse->MalformedArgsResponse();
    }
150
151
152
153
    if (defined($uuid) && GeniHRN::IsValid($uuid)) {
	$hrn  = $uuid;
	$uuid = undef;
    }
154
155
156
157
158
159
160
161
162
163
164
165
    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
166
167
168
	return GeniResponse->MalformedArgsResponse();
    }
    # Allow lookup by uuid or hrn.
169
    if (! defined($uuid) && !defined( $hrn ) ) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
170
171
172
173
174
175
	return GeniResponse->MalformedArgsResponse();
    }
    if (defined($uuid) && !($uuid =~ /^[-\w]*$/)) {
	return GeniResponse->MalformedArgsResponse();
    }

176
    my $credential = GeniCredential::CheckCredential($cred);
177
178
179
    return $credential
	if (GeniResponse::IsResponse($credential));

180
    if ($type eq "node") {
181
	require Interface;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
182
183
184
	my $node;
	
	if (defined($uuid)) {
185
	    $node= GeniUtil::LookupNode($uuid);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
186
187
	}
	else {
188
	    $node= GeniUtil::LookupNode($hrn);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
189
	}
190
	if (! defined($node)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
191
192
193
	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED,
					undef, "Nothing here by that name");
	}
194

195
	my $rspec = GetAdvertisement(0, $node->node_id(), "0.1", undef);
196
197
198
199
	if (! defined($rspec)) {
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					"Could not start avail");
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
200
201
	
	# Return a blob.
202
	my $blob = { "hrn"          => "${PGENIDOMAIN}." . $node->node_id(),
Leigh B. Stoller's avatar
Leigh B. Stoller committed
203
		     "uuid"         => $node->uuid(),
204
		     "role"	    => $node->role(),
205
206
		     "hostname"     =>
			 GeniUtil::FindHostname($node->node_id()),
207
208
		     "physctrl"     => 
			 Interface->LookupControl( $node->phys_nodeid() )->IP(),
209
210
		     "urn"          => GeniHRN::Generate( $OURDOMAIN,
							  "node",
211
212
							  $node->node_id() ),
		     "rspec"        => $rspec
Leigh B. Stoller's avatar
Leigh B. Stoller committed
213
214
215
216
217
218
219
		   };

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
220
221
222
223
224
225
#
# Discover resources on this component, returning a resource availablity spec
#
sub DiscoverResources($)
{
    my ($argref) = @_;
226
    my $credstr   = $argref->{'credential'};
227
    my $available = $argref->{'available'} || 0;
228
    my $compress  = $argref->{'compress'} || 0;
229
    my $version   = $argref->{'rspec_version'} || undef;
230

231
    my $credential = GeniCredential::CheckCredential($credstr);
232
233
    return $credential
	if (GeniResponse::IsResponse($credential));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
234

235
236
    return DiscoverResourcesAux($available,
				$compress, $version, [$credential]);
237
238
}
# Helper function for V2.
239
sub DiscoverResourcesAux($$$$)
240
{
241
    my ($available, $compress, $version, $credentials) = @_;
242
    my $user_urn  = $ENV{'GENIRN'};
243
    $version   = "2"
244
245
246
	if (!defined($version));

    # Sanity check since this can come from client.
247
    if (! ($version eq "0.1" || $version eq "0.2" || $version eq "2"
248
249
250
	   || $version eq "3"
	   || $version eq "PG 0.1" || $version eq "PG 0.2"
	   || $version eq "PG 2")) {
251
252
253
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "Improper version request");
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
254

255
256
257
    # 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.
258
259
260
261
262
263
    if (defined($available) && ref($available) eq 'Frontier::RPC2::Boolean') {
	$available = $available->value;
    }
    if (defined($compress) && ref($compress) eq 'Frontier::RPC2::Boolean') {
	$compress = $compress->value;
    }
264

Leigh B. Stoller's avatar
Leigh B. Stoller committed
265
266
267
268
    #
    # A sitevar controls whether external users can get any nodes.
    #
    my $allow_externalusers = 0;
269
    if (!GetSiteVar('protogeni/allow_externalusers', \$allow_externalusers)){
270
271
	      # Cannot get the value, say no.
	      $allow_externalusers = 0;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
272
    }
273
274
275
276
277
278
279

    # 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) {
280
        if (GeniXML::PolicyExists('allow_externalusers', $credential) == 1) {
281
282
283
284
285
286
        $isExempted = 1;
        last;
      }
    }

    if (!$allow_externalusers && !$isExempted) {
287
	my $user = GeniUser->Lookup($user_urn, 1);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
288
289
290
291
292
293
294
	# No record means the user is remote.
	if (!defined($user) || !$user->IsLocal()) {
	    return GeniResponse->Create(GENIRESPONSE_UNAVAILABLE, undef,
					"External users temporarily denied");
	}
    }

295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
    #
    # 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
314
    #
315
    # Acquire the advertisement from ptopgen and compress it if requested.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
316
    #
317
    my $xml = GetAdvertisement($available, undef, $version, $experiment);
318
    if (! defined($xml)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
319
320
321
322
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Could not start avail");
    }

323
324
325
326
327
328
    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
329
330
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, $xml);
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
331

332
333
334
#
# Use ptopgen in xml mode to spit back an xml file. 
#
335
sub GetAdvertisement($$$$)
336
{
337
    my ($available, $pc, $version, $experiment) = @_;
338
    my $xml = undef;
339
340
    my $gotlock = 0;
    my $filename = "/var/tmp/protogeni_resources.xml";
341

342
343
344
345
346
347
348
    $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");

349
    my $invocation = "$PTOPGEN -x -g $version -r";
350
351
352
353
    if (defined($experiment)) {
	my $eid = $experiment->eid();
	$invocation .= " -e $eid";
    }
354
355
356
357
    $invocation .= " -a" unless $available;
    if (defined($pc)) {
	$invocation .= " -1 $pc";
    }
358
359
360
361
362
363
364
365
366
367
368
369
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
    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;
	}
    }
397
    if (open(AVAIL, "$invocation |")) {
398
	$xml = "";
399
400
401
402
403
	while (<AVAIL>) {
	    $xml .= $_;
	}
	close(AVAIL);
    }
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
    #
    # 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();
    }
425
426
427
    return $xml;
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
428
#
429
# Update a ticket with a new rspec.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
430
#
431
sub UpdateTicket($)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
432
433
{
    my ($argref) = @_;
434
435
436
437
438
439
440
441
442
443

    return GetTicket($argref, 1);
}

#
# Respond to a GetTicket request. 
#
sub GetTicket($;$)
{
    my ($argref, $isupdate) = @_;
444
    my $rspecstr   = $argref->{'rspec'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
445
    my $impotent   = $argref->{'impotent'};
446
447
    my $credstr    = $argref->{'credential'};
    my $tickstr    = $argref->{'ticket'};
448
449
450
451
452
453
454
    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
455

456
    if (! defined($credstr)) {
457
	return GeniResponse->MalformedArgsResponse();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
458
    }
459
    if (!defined($rspecstr)) {
460
461
	return GeniResponse->MalformedArgsResponse();
    }
462
463
464
465
    if (! ($rspecstr =~ /^[\040-\176\012\015\011]+$/)) {
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "Improper characters in rspec");
    }
466
    my $credential = GeniCredential::CheckCredential($credstr);
467
468
469
    return $credential
	if (GeniResponse::IsResponse($credential));

470
    if ($isupdate) {
471
	$ticket = CheckTicket($tickstr, $credential->target_urn());
472
473
	return $ticket
	    if (GeniResponse::IsResponse($ticket));
474
    }
475
    return GetTicketAux($credential,
476
			$rspecstr, $isupdate, $impotent, 0, 1, $ticket);
477
}
478

479
sub GetTicketAux($$$$$$$)
480
{
481
482
    my ($credential, $rspecstr, $isupdate, $impotent, $v2, $level,
	$ticket) = @_;
483
    
484
485
486
487
488
489
    defined($credential) &&
	($credential->HasPrivilege( "pi" ) or
	 $credential->HasPrivilege( "instantiate" ) or
	 $credential->HasPrivilege( "bind" ) or
	 return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				      "Insufficient privilege" ));
490
    
491
492
    my $slice_urn = $credential->target_urn();
    my $user_urn  = $credential->owner_urn();
493
    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
494
    #
495
    # Create user from the certificate.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
496
    #
497
    my $user = CreateUserFromCertificate($credential);
498
499
    return $user
	if (GeniResponse::IsResponse($user));
500
501
502

    # Bump activity. Does not matter if request fails ...
    $user->BumpActivity();
503
    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
504
    #
505
    # Create slice from the certificate.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
506
    #
507
508
    my $slice = GeniSlice->Lookup($slice_urn);
    if (!defined($slice)) {
509
	if ($isupdate) {
510
	    print STDERR "Could not locate slice $slice_urn for Update\n";
511
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
512
513
514
					"No slice found for UpdateTicket");
	}
	$slice = CreateSliceFromCertificate($credential, $user);
515
516
	return $slice
	    if (GeniResponse::IsResponse($slice));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
517
    }
518
    main::AddLogfileMetaDataFromSlice($slice);
519
    
520
    return GetTicketAuxAux($slice, $user, $rspecstr,
521
522
			   $isupdate, $impotent, $v2, $level, $ticket,
			   [$credential]);
523
}
524
sub GetTicketAuxAux($$$$$$$$$)
525
{
526
527
    my ($slice, $user, $rspecstr, 
        $isupdate, $impotent, $v2, $level, $ticket, $credentials) = @_;
528
529
530
    my $response    = undef;
    my $restorevirt = 0;	# Flag to restore virtual state
    my $restorephys = 0;	# Flag to restore physical state
531
    require OSinfo;
532
    require Image;
533
    require VirtExperiment;
534
535
536
537
538
539

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

544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
    #
    # 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");
    }

562
563
    my $rspec = GeniXML::Parse($rspecstr);
    if (! defined($rspec)) {
564
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
565
				    "Error Parsing rspec XML");
566
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
567

568
569
570
571
572
573
    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
574
575
576
577
    #
    # A sitevar controls whether external users can get any nodes.
    #
    my $allow_externalusers = 0;
578
    if (!GetSiteVar('protogeni/allow_externalusers', \$allow_externalusers)){
579
580
581
582
583
584
585
586
587
588
589
590
591
592
	    # Cannot get the value, say no.
	    $allow_externalusers = 0;
    }

    # 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
593
    }
594
595
596

    if (!$allow_externalusers && !$isExempted && !$user->IsLocal()) {
	    return GeniResponse->Create(GENIRESPONSE_UNAVAILABLE, undef,
Leigh B. Stoller's avatar
Leigh B. Stoller committed
597
598
599
600
				    "External users temporarily denied");
    }
    
    #
601
    # For now all tickets expire very quickly (minutes), but once the
Leigh B. Stoller's avatar
Leigh B. Stoller committed
602
    # ticket is redeemed, it will expire according to the rspec request.
603
604
    # If nothing specified in the rspec, then it will expire when the
    # slice record expires, which was given by the expiration time of the
605
606
    # slice credential, or the local policy max_sliver_lifetime. See
    # CreateSliceFromCertificate() in this file.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
607
    #
Jonathon Duerig's avatar
Jonathon Duerig committed
608
    my $expires = GeniXML::GetExpires($rspec);
609
    if (defined($expires)) {
610
611
	if (GeniResponse::IsResponse($expires)) {
	    return $expires;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
612
613
	}
	# Convert to a localtime.
614
	my $when = str2time($expires);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
615
616
617
618
619
620
	if (!defined($when)) {
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					"Could not parse valid_until");
	}
	
	#
621
	# Do we need a policy limit?
Leigh B Stoller's avatar
Leigh B Stoller committed
622
623
624
625
626
	# A sitevar controls the sliver lifetime.
	#
	my $max_sliver_lifetime = 0;
	if (!GetSiteVar('protogeni/max_sliver_lifetime',
			\$max_sliver_lifetime)){
627
628
	    # Cannot get the value, default it to 90 days.
	    $max_sliver_lifetime = 90;
Leigh B Stoller's avatar
Leigh B Stoller committed
629
630
631
632
633
634
635
636
637
638
639
640
641
	}

	# Check if the user has a credential that lets him obtain slivers
	# with extended sliver lifetime. If so allow him to get sliver.
	foreach my $credential (@$credentials) {
	    my $nodes = GeniXML::FindNodesNS("//n:max_sliver_lifetime",
					     $credential->extensions(),
					     $GeniUtil::EXTENSIONS_NS);
	    if ($nodes->size > 0) {
		$max_sliver_lifetime = int($nodes->pop()->string_value);
		last;
	    }
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
642
	my $diff = $when - time();
643
644
645
646
647
648
	if ($diff < (60 * 5)) {
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					"such a short life for a sliver? ".
					"More time please.");
	}
	elsif ($diff > (3600 * 24 * $max_sliver_lifetime)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
649
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
650
651
			"expiration is greater then the maximum number ".
			"of minutes " . (60 * 24 * $max_sliver_lifetime));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
652
	}
653
654
655
656
657
658

	#
	# Must be before the slice expires.
	#
	my $slice_expires = $slice->expires();
	if (defined($slice_expires)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
659
	    $slice_expires = str2time($slice_expires);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
660
	    if ($when > $slice_expires) {
661
662
663
664
		return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "valid_until is past slice expiration");
	    }
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
665
    }
666
667
668
669
670
671
672

    #
    # Lock the ticket so it cannot be released.
    #
    if (defined($ticket) && $ticket->stored() && $ticket->Lock() != 0) {
	return GeniResponse->BusyResponse("ticket");
    }
673
674
675
    if (defined($ticket)) {
	$ticket->SetSlice($slice);
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
676
677
678
679
680
681
    
    #
    #
    # Lock the slice from further access.
    #
    if ($slice->Lock() != 0) {
682
683
684
	$ticket->UnLock()
	    if (defined($ticket) && $ticket->stored());
	return GeniResponse->BusyResponse("slice");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
685
    }
686
687
688
    # Shutdown slices get nothing.
    if ($slice->shutdown()) {
	$slice->UnLock();
689
690
	$ticket->UnLock()
	    if (defined($ticket) && $ticket->stored());
691
692
693
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "Slice has been shutdown");
    }
694
695
696
697
698
699
700
701
    # 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
702

703
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
704
    # For now, there can be only a single toplevel aggregate per slice.
705
    # The existence of an aggregate means the slice is active here. 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
706
    #
707
    my $aggregate = GeniAggregate->SliceAggregate($slice);
708
709
710
711
712
    if (!$isupdate) {
	if (defined($aggregate)) {
	    $response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				     "Already have an aggregate for slice");
	    goto bad;
713
714
	}
    }
715
716
717
718
719
    elsif ($v2 && $level && !defined($ticket) && !defined($aggregate)) {
	print STDERR "No aggregate for $slice in version two API\n";
	$response = GeniResponse->Create(GENIRESPONSE_ERROR);
	goto bad;
    }
720

721
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
722
    # We need this now so we can form a virtual topo.
723
    #
724
725
726
727
728
729
730
731
732
733
734
    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
735
736
737
738
	goto bad;
    }
    my $pid = $slice_experiment->pid();
    my $eid = $slice_experiment->eid();
739
740
741
742
743

    #
    # Mark the experiment locally as coming from the cooked interface.
    # This changes what tmcd returns to the local nodes.
    #
744
    my $generated_by = GeniXML::GetText("generated_by", $rspec);
745
746
    if (defined($generated_by) &&
	$generated_by eq "libvtop") {
747
748
749
750
	$slice_experiment->Update({"geniflags" =>
				       $Experiment::EXPT_GENIFLAGS_EXPT|
				       $Experiment::EXPT_GENIFLAGS_COOKED});
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
751
752
753
754
755
756
757
758
759
760
761
762
763
    
    #
    # 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);
764
    $virtexperiment->multiplex_factor(10);
765

766
767
768
769
770
771
772
773
774
775
    #
    # 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()) {
776
	$virtexperiment->NewTableRow("virt_vtypes",
777
778
779
780
				     {"name"     => $row->{'vtype'},
				      "members"  => $row->{'types'},
				      "weight"   => $row->{'weight'}
				     });
781
    }
782

783
784
785
786
787
    # Need to move this someplace else; the parser adds a bunch.
    $virtexperiment->NewTableRow("virt_agents",
				 {"vnode"      => "*",
				  "vname"      => "ns",
				  "objecttype" => "6"});
788

Leigh B. Stoller's avatar
Leigh B. Stoller committed
789
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
790
791
    # 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
792
793
    # cannot be granted.
    #
794
795
796
    my %namemap  = ();
    my %colomap  = ();
    my %ifacemap = ();
Jonathon Duerig's avatar
Jonathon Duerig committed
797
    my %iface2node = ();
798
    my %vportmap = ();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
799
    my %nodemap  = ();
800
    my %bridgemap= ();
801
    my @nodeids  = ();
802
    my %lannodes = ();
803
    # For stitching, keep track of external nodes and links.
804
805
806
    my %external_nodemap  = ();
    my %external_linkmap  = ();
    my %external_vportmap = ();
807

808
809
810
    # Always do this to avoid buildup.
    $slice_experiment->ClearBackupState();
    
811
812
813
814
815
816
817
    #
    # 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
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
	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;
	}
835
836
837
838
839
840
841
	my $oldrspec;
	if ($v2 && defined($aggregate)) {
	    $oldrspec = $aggregate->GetManifest(0);
	}
	else {
	    $oldrspec = $ticket->rspec();
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
842
	
843
	foreach my $ref (GeniXML::FindNodes("n:node",
844
					    $oldrspec)->get_nodelist()) {
845
	    # Let remote nodes pass through.
846
	    next
847
		if (!GeniXML::IsLocalNode($ref));
848

849
850
	    # Skip lan nodes; they are fake.
	    next
851
		if (GeniXML::IsLanNode($ref));
852

853
	    my $node_nickname = GeniXML::GetVirtualId($ref);
Jonathon Duerig's avatar
Jonathon Duerig committed
854
	    my $colocate      = GeniXML::GetColocate($ref);
855
	    my $component_id  = GeniXML::GetNodeId($ref);
856
857
	    my $vnode_id      = GeniXML::GetVnodeId($ref);
	    my $node = GeniUtil::LookupNode($vnode_id);
858
859
	    if (!defined($node)) {
		$response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
860
				 "Bad resource $component_id in ticket");
861
862
		goto bad;
	    }
863
	    #
864
	    # Check for total hostname length > 63 characters. This
865
	    # breaks a lot of clients. Do this until we have a plan
866
867
868
	    # 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. 
869
870
	    #
	    my $fullhostname = $node_nickname . ".${eid}.${pid}.${OURDOMAIN}";
871
	    if (length($fullhostname) > 63) {
872
		$response = GeniResponse->Create(GENIRESPONSE_TOOBIG, undef,
873
				 "Hostname > 63 characters: $fullhostname");
874
875
	    }
	    
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
	    #
	    # 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;
	    }
891
892
893
894
895
	    $namemap{$node_nickname} = $node;
	    $colomap{$colocate} = $node
		if (defined($colocate));
	}
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
896

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

899
900
    my %nodeexistsmap = ();

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

930
931
932
933
934
	# 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);
935
936
937
938
939
940
941
	    if (exists($iface2node{$virtual_id})) {
		$response =
		    GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					 "Duplicate interface $virtual_id on ".
					 "node $node_nickname");
		goto bad;
	    }
942
943
944
	    $iface2node{$virtual_id} = $node_nickname;
	}

945
	# Let remote nodes pass through.
946
947
948
949
	if (! GeniXML::IsLocalNode($ref)) {
	    $external_nodemap{$node_nickname} = $ref;
	    next;
	}
950

951
	#
952
953
954
955
956
	#
	# 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. 
	#
957
	if (GeniXML::IsLanNode($ref)) {
958
959
960
961
	    $lannodes{$node_nickname} = $ref;
	    next;
	}

962
963
964
	#
	# Check for disk_image request. Specified as a URN. 
	#
965
	my $diskref = GeniXML::GetDiskImage($ref);
966
967
	if (defined($diskref)) {
	    my $dname = GeniXML::GetText("name", $diskref);
968
	    my $url   = GeniXML::GetText("url", $diskref);
969

970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
	    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)) {
985
986
987
988
989
990
991
992
993
994
995
996
997
998
		if (! GeniHRN::IsValid($dname)) {
		    $response =
			GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					 "Malformed image URN: $dname");
		    goto bad;
		}
		my ($auth,$type,$id) = GeniHRN::Parse($dname);
		my ($ospid,$os) = ($id =~ m{(.*)//(.*)});
		if ($type ne "image" || !defined($ospid) || !defined($os)){
		    $response =
			GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					 "Malformed image URN: $dname");
		    goto bad;
		}
999
		$osinfo = OSinfo->Lookup($ospid, $os);
1000
		if (!defined($osinfo)) {
1001
1002
		    $response =
			GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
1003
					     "Unknown image URN: $dname");
1004
1005
		    goto bad;
		}
1006
1007
1008
1009
1010
1011
		#
		# The OS must be in the current project, or it must
		# be global (okay, shared).
		#
		if (! ($osinfo->shared() ||
		       $osinfo->pid() eq $slice_experiment->pid())) {
1012
1013
		    $response =
			GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
1014
				 "Insufficient permission to use $osinfo");
1015
1016
		    goto bad;
		}
1017
		
1018
1019
1020
		#
		# This is only going to be used in raw mode. 
		#
1021
		$osname = "$ospid/$os";
1022
1023
1024
	    }
	}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
1025
1026
1027
	if (defined($virtualization_type)) {
	    if ($virtualization_type eq "emulab-vnode") {
		if (defined($virtualization_subtype)) {
1028
1029
		    $pctype = "pcvm";
		    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1030
1031
1032
1033
		    if ($virtualization_subtype eq "emulab-jail") {
			$osname = "FBSD-JAIL";
		    }
		    elsif ($virtualization_subtype eq "emulab-openvz") {
1034
1035
1036
1037
1038
1039
1040
1041
			# 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";
			    }
			}
1042
1043
			elsif (!defined($osname)) {
			    # Allow for url above.
1044
1045
			    $osname = "OPENVZ-STD";
			}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1046
		    }
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
		    elsif ($virtualization_subtype eq "emulab-xen") {
			# 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 = "XEN-STD";
			    }
			}
			elsif (!defined($osname)) {
			    # Allow for url above.
			    $osname = "XEN-STD";
			}
Leigh B Stoller's avatar
Leigh B Stoller committed
1060
1061
1062
1063
1064
1065
			#
			# Look for the knobs
			#
			if (GeniXML::HasXenSettings($ref)) {
			    $xensettings = GeniXML::GetXenSettings($ref);
			}
1066
1067
1068
			my $ptype = GeniXML::XenPtype($ref);
			$pctype = $ptype
			    if (defined($ptype));
1069
		    }
1070
1071
1072
1073
		    elsif ($virtualization_subtype eq "emulab-spp") {
			$osname = "SPPVM-FAKE";
			$pctype = "sppvm";
			# Lets force to shared node.
Jonathon Duerig's avatar
Jonathon Duerig committed
1074
			if (! GeniXML::SetExclusive($ref, 0)) {
1075
1076
1077
			    $response
				= GeniResponse->Create(GENIRESPONSE_BADARGS,
						       undef,
1078
1079
				       "Malformed rspec: ".
				       "Cannot set exclusive tag to false");
1080
1081
1082
			    goto bad;
			}
			$exclusive = 0;
1083
1084
			# Kludge for libvtop.
			$virtexperiment->multiplex_factor(1);
1085
			$virtexperiment->encap_style("vlan");
1086
		    }
1087
1088
1089
1090
1091
1092
		    elsif ($virtualization_subtype eq "emulab-bbg") {
			$osname = "BBGENIVM-FAKE";
			$pctype = "bbgenivm";
			# Lets force to shared node.
			GeniXML::SetExclusive($ref, 0);
			$exclusive = 0;
1093
			$virtexperiment->multiplex_factor(5);
1094
1095
			$virtexperiment->encap_style("vlan");
		    }
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
		    elsif ($virtualization_subtype eq "emulab-connect") {
			$osname = "GENERICDEV-VM";
			$pctype = "interconnect-vm";
			# Lets force to shared node.
			GeniXML::SetExclusive($ref, 0);
			$exclusive = 0;
			# Kludge for libvtop.
			$virtexperiment->multiplex_factor(5);
			$virtexperiment->encap_style("vlan");
		    }
1106
1107
		    elsif ($virtualization_subtype eq "raw"
			   || $virtualization_subtype eq "raw-pc") {
1108
1109
1110
			$pctype = undef;
			goto raw;
		    }
1111
1112
1113
1114
		    elsif ($virtualization_subtype eq "delay") {
			$isbridge = 1;
			$pctype   = undef;
		    }
1115
1116
1117
1118
1119
1120
		    elsif ($virtualization_subtype eq "firewall") {
			$isfirewall = 1;
			$osname     = "FW-IPFW2";
			$pctype     = "pc";
			goto raw;
		    }
1121
1122
1123
1124
1125
1126
1127
1128
		    else {
			$response
			    = GeniResponse->Create(GENIRESPONSE_BADARGS,
						   undef,
				       "Malformed rspec: ".
				       "Unknown virtualization_subtype");
			goto bad;
		    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1129
1130
1131
1132
1133
1134
1135
1136
		}
		else {
		    goto raw;
		}
	    }
	    else {
	      raw:
		# Lets force to exclusive real node.
Jonathon Duerig's avatar
Jonathon Duerig committed
1137
		if (! GeniXML::SetExclusive($ref, 1)) {
1138
1139
		    $response = GeniResponse->Create(GENIRESPONSE_BADARGS,
						     undef,
1140
			"Malformed rspec: Cannot set exclusive tag to true");
1141
1142
1143
		    goto bad;
		}
		$exclusive = 1;
1144
1145
1146
1147
1148
		my $subtype = "raw-pc";
		if (GeniXML::IsVersion0($ref)) {
		    $subtype = "raw";
		}
		if (! GeniXML::SetVirtualizationSubtype($ref, $subtype)) {
1149
1150
		    $response = GeniResponse->Create(GENIRESPONSE_BADARGS,
						     undef,
1151
			"Malformed rspec: Cannot set virtualization_type to raw");
1152
1153
		    goto bad;
		}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1154
1155
1156
1157
	    }
	}
	else {
	    $response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
1158
				     "Must provide a virtualization_type");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1159
1160
1161
	    goto bad;

	}
1162
1163
1164
1165
1166
1167
	if (!defined($node_nickname)) {
	    $response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				     "Must provide a virtual_id for nodes");
	    goto bad;
	}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
1168
	#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1169
	# Allow wildcarding.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1170
	#
1171
	if (!defined($component_id) || $component_id eq "*") {
1172
1173
1174
1175
1176
	    if (defined($colocate) && exists($colomap{$colocate})) {
		$node = $colomap{$colocate};
	    }
	    elsif ($isupdate && exists($namemap{$node_nickname})) {
		$node = $namemap{$node_nickname};
1177
	    }