GeniCM.pm.in 266 KB
Newer Older
Leigh Stoller's avatar
Leigh Stoller committed
1 2
#!/usr/bin/perl -wT
#
3
# Copyright (c) 2008-2018 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 Stoller's avatar
Leigh 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 Stoller's avatar
Leigh Stoller committed
42 43 44

use GeniDB;
use Genixmlrpc;
Leigh Stoller's avatar
Leigh Stoller committed
45 46
use GeniResponse;
use GeniTicket;
Leigh Stoller's avatar
Leigh Stoller committed
47
use GeniCredential;
48
use GeniCertificate;
Leigh Stoller's avatar
Leigh Stoller committed
49
use GeniSlice;
Leigh Stoller's avatar
Leigh Stoller committed
50
use GeniAggregate;
51
use GeniAuthority;
Leigh Stoller's avatar
Leigh Stoller committed
52
use GeniSliver;
Leigh Stoller's avatar
Leigh Stoller committed
53
use GeniUser;
Leigh Stoller's avatar
Leigh 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
use EmulabConstants;
64
use EmulabFeatures;
65
use libEmulab;
66
use Lan;
67
use User;
68
use Experiment;
69
use NodeType;
70
use Node;
Leigh Stoller's avatar
Leigh Stoller committed
71 72
use English;
use Data::Dumper;
Leigh Stoller's avatar
Leigh Stoller committed
73
use XML::Simple;
74
use XML::LibXML;
Leigh Stoller's avatar
Leigh Stoller committed
75
use Date::Parse;
76
use POSIX qw(strftime ceil :sys_wait_h);
Leigh Stoller's avatar
Leigh Stoller committed
77
use Time::Local;
78
use Compress::Zlib;
79
use File::Temp qw(tempfile tmpnam);
80
use MIME::Base64;
81
use Digest::SHA1 qw(sha1_hex);
82
use POSIX ":sys_wait_h";
83
use Errno qw(:POSIX);
Leigh Stoller's avatar
Leigh Stoller committed
84 85 86 87 88 89

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

136 137 138 139 140
# For location info.
my $default_longitude = undef;
my $default_latitude  = undef;
my $default_country   = undef;

141 142 143 144 145 146 147 148 149
sub DebugTimeStamp($)
{
    my ($message)  = @_;

    if (1) {
	print STDERR "TIMESTAMP: " . TBTimeStamp() . " $message\n";
    }
}

150 151 152 153 154 155 156 157 158 159
#
# 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 Stoller's avatar
Leigh Stoller committed
160
#
Leigh Stoller's avatar
Leigh Stoller committed
161
# Respond to a Resolve request. 
Leigh Stoller's avatar
Leigh Stoller committed
162 163 164 165 166 167
#
sub Resolve($)
{
    my ($argref) = @_;
    my $uuid       = $argref->{'uuid'};
    my $cred       = $argref->{'credential'};
168 169
    my $type       = lc( $argref->{'type'} );
    my $hrn        = $argref->{'hrn'};
Leigh Stoller's avatar
Leigh Stoller committed
170 171 172 173

    if (! defined($cred)) {
	return GeniResponse->MalformedArgsResponse();
    }
174 175 176 177
    if (defined($uuid) && GeniHRN::IsValid($uuid)) {
	$hrn  = $uuid;
	$uuid = undef;
    }
178 179 180 181 182 183 184 185 186 187 188 189
    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 Stoller's avatar
Leigh Stoller committed
190 191 192
	return GeniResponse->MalformedArgsResponse();
    }
    # Allow lookup by uuid or hrn.
193
    if (! defined($uuid) && !defined( $hrn ) ) {
Leigh Stoller's avatar
Leigh Stoller committed
194 195 196 197 198 199
	return GeniResponse->MalformedArgsResponse();
    }
    if (defined($uuid) && !($uuid =~ /^[-\w]*$/)) {
	return GeniResponse->MalformedArgsResponse();
    }

200
    my $credential = GeniCredential::CheckCredential($cred);
201 202 203
    return $credential
	if (GeniResponse::IsResponse($credential));

204
    if ($type eq "node") {
205
	require Interface;
Leigh Stoller's avatar
Leigh Stoller committed
206 207 208
	my $node;
	
	if (defined($uuid)) {
209
	    $node= GeniUtil::LookupNode($uuid);
Leigh Stoller's avatar
Leigh Stoller committed
210 211
	}
	else {
212
	    $node= GeniUtil::LookupNode($hrn);
Leigh Stoller's avatar
Leigh Stoller committed
213
	}
214
	if (! defined($node)) {
Leigh Stoller's avatar
Leigh Stoller committed
215 216 217
	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED,
					undef, "Nothing here by that name");
	}
218

219
	my $rspec = GetAdvertisement(0, $node->node_id(), "0.1", undef);
220 221 222 223
	if (! defined($rspec)) {
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					"Could not start avail");
	}
Leigh Stoller's avatar
Leigh Stoller committed
224 225
	
	# Return a blob.
226
	my $blob = { "hrn"          => "${PGENIDOMAIN}." . $node->node_id(),
Leigh Stoller's avatar
Leigh Stoller committed
227
		     "uuid"         => $node->uuid(),
228
		     "role"	    => $node->role(),
229 230
		     "hostname"     =>
			 GeniUtil::FindHostname($node->node_id()),
231 232
		     "physctrl"     => 
			 Interface->LookupControl( $node->phys_nodeid() )->IP(),
233 234
		     "urn"          => GeniHRN::Generate( $OURDOMAIN,
							  "node",
235 236
							  $node->node_id() ),
		     "rspec"        => $rspec
Leigh Stoller's avatar
Leigh Stoller committed
237 238 239 240 241 242 243
		   };

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

Leigh Stoller's avatar
Leigh Stoller committed
244 245 246 247 248 249
#
# Discover resources on this component, returning a resource availablity spec
#
sub DiscoverResources($)
{
    my ($argref) = @_;
250
    my $credstr   = $argref->{'credential'};
251
    my $available = $argref->{'available'} || 0;
252
    my $compress  = $argref->{'compress'} || 0;
253
    my $version   = $argref->{'rspec_version'} || undef;
254

255
    my $credential = GeniCredential::CheckCredential($credstr);
256 257
    return $credential
	if (GeniResponse::IsResponse($credential));
Leigh Stoller's avatar
Leigh Stoller committed
258

259 260
    return DiscoverResourcesAux($available,
				$compress, $version, [$credential]);
261 262
}
# Helper function for V2.
263
sub DiscoverResourcesAux($$$$)
264
{
265
    my ($available, $compress, $version, $credentials) = @_;
266
    my $user_urn  = $ENV{'GENIRN'};
267
    $version   = "2"
268 269 270
	if (!defined($version));

    # Sanity check since this can come from client.
271
    if (! ($version eq "0.1" || $version eq "0.2" || $version eq "2"
272 273 274
	   || $version eq "3"
	   || $version eq "PG 0.1" || $version eq "PG 0.2"
	   || $version eq "PG 2")) {
275 276 277
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "Improper version request");
    }
Leigh Stoller's avatar
Leigh Stoller committed
278

279 280 281
    # 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.
282 283 284 285 286 287
    if (defined($available) && ref($available) eq 'Frontier::RPC2::Boolean') {
	$available = $available->value;
    }
    if (defined($compress) && ref($compress) eq 'Frontier::RPC2::Boolean') {
	$compress = $compress->value;
    }
288

Leigh Stoller's avatar
Leigh Stoller committed
289 290 291 292
    #
    # A sitevar controls whether external users can get any nodes.
    #
    my $allow_externalusers = 0;
293
    if (!GetSiteVar('protogeni/allow_externalusers', \$allow_externalusers)){
294 295
	      # Cannot get the value, say no.
	      $allow_externalusers = 0;
Leigh Stoller's avatar
Leigh Stoller committed
296
    }
297 298 299 300 301 302 303

    # 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) {
304
        if (GeniXML::PolicyExists('allow_externalusers', $credential) == 1) {
305 306 307 308 309 310
        $isExempted = 1;
        last;
      }
    }

    if (!$allow_externalusers && !$isExempted) {
311
	my $user = GeniUser->Lookup($user_urn, 1);
Leigh Stoller's avatar
Leigh Stoller committed
312 313 314 315 316 317 318
	# No record means the user is remote.
	if (!defined($user) || !$user->IsLocal()) {
	    return GeniResponse->Create(GENIRESPONSE_UNAVAILABLE, undef,
					"External users temporarily denied");
	}
    }

319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337
    #
    # 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 Stoller's avatar
Leigh Stoller committed
338
    #
339
    # Acquire the advertisement from ptopgen and compress it if requested.
Leigh Stoller's avatar
Leigh Stoller committed
340
    #
341
    my $xml = GetAdvertisement($available, undef, $version, $experiment);
342
    if (! defined($xml)) {
Leigh Stoller's avatar
Leigh Stoller committed
343 344 345 346
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Could not start avail");
    }

347 348 349 350 351 352
    if( $compress ) {
	my $coder = Frontier::RPC2->new();
	my $base64 = encode_base64( compress( $xml ) );
	$xml = $coder->base64( $base64 );	
    }

Leigh Stoller's avatar
Leigh Stoller committed
353 354
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, $xml);
}
Leigh Stoller's avatar
Leigh Stoller committed
355

356 357 358
#
# Use ptopgen in xml mode to spit back an xml file. 
#
359
sub GetAdvertisement($$$$)
360
{
361
    my ($available, $pc, $version, $experiment) = @_;
362
    my $xml = undef;
363 364
    my $gotlock = 0;
    my $filename = "/var/tmp/protogeni_resources.xml";
365

366 367 368 369 370 371 372
    $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");

373
    my $invocation = "$PTOPGEN -x -g $version -r -f";
374 375
    if (defined($experiment)) {
	my $eid = $experiment->eid();
376
	my $pid = $experiment->pid();
377
	$invocation .= " -p $pid -e $eid";
378
    }
379 380 381 382
    $invocation .= " -a" unless $available;
    if (defined($pc)) {
	$invocation .= " -1 $pc";
    }
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 409 410 411 412 413 414 415 416 417 418 419 420 421
    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;
	}
    }
422
    if (open(AVAIL, "$invocation |")) {
423
	$xml = "";
424 425 426 427 428
	while (<AVAIL>) {
	    $xml .= $_;
	}
	close(AVAIL);
    }
429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449
    #
    # 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();
    }
450 451 452
    return $xml;
}

Leigh Stoller's avatar
Leigh Stoller committed
453
#
454
# Update a ticket with a new rspec.
Leigh Stoller's avatar
Leigh Stoller committed
455
#
456
sub UpdateTicket($)
Leigh Stoller's avatar
Leigh Stoller committed
457 458
{
    my ($argref) = @_;
459 460 461 462 463 464 465 466 467 468

    return GetTicket($argref, 1);
}

#
# Respond to a GetTicket request. 
#
sub GetTicket($;$)
{
    my ($argref, $isupdate) = @_;
469
    my $rspecstr   = $argref->{'rspec'};
Leigh Stoller's avatar
Leigh Stoller committed
470
    my $impotent   = $argref->{'impotent'};
471 472
    my $credstr    = $argref->{'credential'};
    my $tickstr    = $argref->{'ticket'};
473 474 475 476 477 478 479
    my $ticket;

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

481
    if (! defined($credstr)) {
482
	return GeniResponse->MalformedArgsResponse();
Leigh Stoller's avatar
Leigh Stoller committed
483
    }
484
    if (!defined($rspecstr)) {
485 486
	return GeniResponse->MalformedArgsResponse();
    }
487 488 489 490
    if (! ($rspecstr =~ /^[\040-\176\012\015\011]+$/)) {
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "Improper characters in rspec");
    }
491
    my $credential = GeniCredential::CheckCredential($credstr);
492 493 494
    return $credential
	if (GeniResponse::IsResponse($credential));

495
    if ($isupdate) {
496 497
	$ticket = CheckTicket($tickstr,
			      $credential->target_urn());
498 499
	return $ticket
	    if (GeniResponse::IsResponse($ticket));
500
    }
501 502 503 504 505 506 507 508 509 510
    return GetTicketAux({"credential" => $credential,
			 "rspecstr"   => $rspecstr.
			 "isupdate"   => $isupdate,
			 "impotent"   => $impotent,
			 "v2"         => 0,
			 "level"      => 1,
			 "usetracker" => 0,
			 "ticket"     => $ticket,
			 "speaksfor"  => undef,
			 "morecreds"  => [],
511 512
			 "async"      => 0,
			 "slice"      => undef});
513
}
514

515
sub GetTicketAux($)
516
{
517 518 519 520 521 522 523 524 525 526 527 528
    my ($argref) = @_;
    my $credential = $argref->{"credential"};
    my $rspecstr   = $argref->{"rspecstr"};
    my $isupdate   = $argref->{"isupdate"};
    my $impotent   = $argref->{"impotent"};
    my $v2         = $argref->{"v2"};
    my $level      = $argref->{"level"};
    my $usetracker = $argref->{"usetracker"};
    my $ticket     = $argref->{"ticket"};
    my $speaksfor  = $argref->{"speaksfor"};
    my $morecreds  = $argref->{"morecreds"};
    my $async      = $argref->{"async"};
529 530
    my $slice      = $argref->{"slice"};
    my $nolock     = (defined($slice) ? 1 : 0);
531

532 533 534 535 536 537
    defined($credential) &&
	($credential->HasPrivilege( "pi" ) or
	 $credential->HasPrivilege( "instantiate" ) or
	 $credential->HasPrivilege( "bind" ) or
	 return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				      "Insufficient privilege" ));
538
    
539 540
    my $slice_urn = $credential->target_urn();
    my $user_urn  = $credential->owner_urn();
541
    
Leigh Stoller's avatar
Leigh Stoller committed
542
    #
543
    # Create user from the certificate.
Leigh Stoller's avatar
Leigh Stoller committed
544
    #
545
    my $user = CreateUserFromCertificate($credential);
546 547
    return $user
	if (GeniResponse::IsResponse($user));
548 549 550

    # Bump activity. Does not matter if request fails ...
    $user->BumpActivity();
551
    
Leigh Stoller's avatar
Leigh Stoller committed
552
    #
553
    # Create slice from the certificate.
Leigh Stoller's avatar
Leigh Stoller committed
554
    #
555
    if (!defined($slice)) {
556 557 558 559 560 561 562 563 564 565
	$slice = GeniSlice->Lookup($slice_urn);
	if (!defined($slice)) {
	    if ($isupdate) {
		print STDERR "Could not locate slice $slice_urn for Update\n";
		return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					    "No slice found for UpdateTicket");
	    }
	    $slice = CreateSliceFromCertificate($credential, $user);
	    return $slice
		if (GeniResponse::IsResponse($slice));
566
	}
567
	main::AddLogfileMetaDataFromSlice($slice);
Leigh Stoller's avatar
Leigh Stoller committed
568
    }
569 570
    $slice->SetSpeaksFor($speaksfor)
	if (defined($speaksfor));
571

572 573 574 575 576 577 578 579 580 581 582
    return GetTicketAuxAux({"slice"      => $slice,
			    "user"       => $user,
			    "rspecstr"   => $rspecstr,
			    "isupdate"   => $isupdate,
			    "impotent"   => $impotent,
			    "v2"         => $v2,
			    "level"      => $level,
			    "usetracker" => $usetracker,
			    "ticket"     => $ticket,
			    "credentials"=> [$credential, @$morecreds],
			    "speaksfor"  => $speaksfor,
583 584 585 586
			    "morecreds"  => [],
			    "async"      => $async,
			    # Leave locked if passing the slice around.
			    "nolock"     => $nolock});
587
}
588 589

sub GetTicketAuxAux($)
590
{
591 592 593 594 595 596 597 598 599 600 601 602 603
    my ($argref) = @_;
    my $slice       = $argref->{"slice"};
    my $user        = $argref->{"user"};
    my $rspecstr    = $argref->{"rspecstr"};
    my $isupdate    = $argref->{"isupdate"};
    my $impotent    = $argref->{"impotent"};
    my $v2          = $argref->{"v2"};
    my $level       = $argref->{"level"};
    my $usetracker  = $argref->{"usetracker"};
    my $ticket      = $argref->{"ticket"};
    my $credentials = $argref->{"credentials"};
    my $speaksfor   = $argref->{"speaksfor"};
    my $async       = $argref->{"async"};
604
    my $nolock      = $argref->{"nolock"} || 0;
605 606 607
    my $response    = undef;
    my $restorevirt = 0;	# Flag to restore virtual state
    my $restorephys = 0;	# Flag to restore physical state
608
    require OSImage;
609
    require VirtExperiment;
610 611 612 613 614 615

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

620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637
    #
    # 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");
    }

638 639
    my $rspec = GeniXML::Parse($rspecstr);
    if (! defined($rspec)) {
640
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
641
				    "Error Parsing rspec XML");
642
    }
Leigh Stoller's avatar
Leigh Stoller committed
643

644 645 646 647 648 649
    my $rspecVersion = GeniXML::GetXmlVersion($rspec);
    if (! defined($rspecVersion)) {
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "Unknown RSpec Version");
    }

650 651 652 653 654 655 656 657 658
    # Quick check for no nodes or links. It actually happens and the mapper
    # is not happy with a virtual topo that has no nodes or links.
    my @nodelist = GeniXML::FindNodes("n:node", $rspec)->get_nodelist();
    my @linklist = GeniXML::FindNodes("n:link", $rspec)->get_nodelist();
    if (! (@nodelist || @linklist)) {
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "No nodes or links in your topology");
    }

Leigh Stoller's avatar
Leigh Stoller committed
659 660 661 662
    #
    # A sitevar controls whether external users can get any nodes.
    #
    my $allow_externalusers = 0;
663
    if (!GetSiteVar('protogeni/allow_externalusers', \$allow_externalusers)){
664 665 666 667
	    # Cannot get the value, say no.
	    $allow_externalusers = 0;
    }

668 669 670 671 672 673 674 675 676 677 678
    # 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);

679 680 681 682
    #
    # Watch for sites that do not support openflow, we want to fail early.
    #
    my $no_openflow = 0;
683
    my $ignore_openflow = 0;
684 685 686 687
    if (!GetSiteVar('general/no_openflow', \$no_openflow)){
	# Cannot get the value, say no.
	$no_openflow = 1;
    }
688 689 690 691
    if ($no_openflow =~ /ignore/) {
	$no_openflow = 1;
	$ignore_openflow = 1;
    }
692

693 694 695 696 697 698 699 700 701 702
    # 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 Stoller's avatar
Leigh Stoller committed
703
    }
704 705

    if (!$allow_externalusers && !$isExempted && !$user->IsLocal()) {
706 707 708
	$response = GeniResponse->Create(GENIRESPONSE_UNAVAILABLE, undef,
					 "External users temporarily denied");
	goto bad;
Leigh Stoller's avatar
Leigh Stoller committed
709 710 711
    }
    
    #
712
    # For now all tickets expire very quickly (minutes), but once the
Leigh Stoller's avatar
Leigh Stoller committed
713
    # ticket is redeemed, it will expire according to the rspec request.
714 715
    # If nothing specified in the rspec, then it will expire when the
    # slice record expires, which was given by the expiration time of the
716
    # slice credential, or the local policy max_sliver_lifetime. 
Leigh Stoller's avatar
Leigh Stoller committed
717
    #
718
    my $expires = GeniXML::GetExpires($rspec);
719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737
    if (defined($expires) && GeniResponse::IsResponse($expires)) {
	$response = $expires;
	goto bad;
    }
    #
    # We no longer allow changing the expiration during an update call.
    # Too much hassle cause of the reservation system and the fact that
    # an abnormal exit can leave the slice with the new expiration. The
    # problem with the reservation system is that we have to change the
    # expiration so that admission control will check all of the resources
    # based on the new expiration. Before the reservation system, we did
    # not need to change the slice expiration until later in redeem ticket,
    # thus ensuring that if the ticket was not redeemed, the resources
    # would be released.
    #
    if ($isupdate) {
	if (SliceExpirationChanged($slice, $expires, @{$credentials})) {
	    return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
			"Not allowed to change expiration when updating");
738
	}
Leigh Stoller's avatar
Leigh Stoller committed
739
    }
740 741 742 743 744 745 746

    #
    # Lock the ticket so it cannot be released.
    #
    if (defined($ticket) && $ticket->stored() && $ticket->Lock() != 0) {
	return GeniResponse->BusyResponse("ticket");
    }
747 748 749
    if (defined($ticket)) {
	$ticket->SetSlice($slice);
    }
Leigh Stoller's avatar
Leigh Stoller committed
750 751 752 753 754
    
    #
    #
    # Lock the slice from further access.
    #
755
    if (!$nolock && $slice->Lock() != 0) {
756 757 758
	$ticket->UnLock()
	    if (defined($ticket) && $ticket->stored());
	return GeniResponse->BusyResponse("slice");
Leigh Stoller's avatar
Leigh Stoller committed
759
    }
760 761
    # Shutdown slices get nothing.
    if ($slice->shutdown()) {
762
	$slice->UnLock() if (!$nolock);
763 764
	$ticket->UnLock()
	    if (defined($ticket) && $ticket->stored());
765 766 767
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "Slice has been shutdown");
    }
768 769
    # Ditto for expired.
    if ($slice->IsExpired()) {
770
	$slice->UnLock() if (!$nolock);
771 772 773 774 775
	$ticket->UnLock()
	    if (defined($ticket) && $ticket->stored());
	return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
				    "Slice has expired");
    }
Leigh Stoller's avatar
Leigh Stoller committed
776

777 778 779 780
    #
    # Gotto goto bad below this point!
    #
    
781
    #
Leigh Stoller's avatar
Leigh Stoller committed
782
    # For now, there can be only a single toplevel aggregate per slice.
783
    # The existence of an aggregate means the slice is active here. 
Leigh Stoller's avatar
Leigh Stoller committed
784
    #
785
    my $aggregate = GeniAggregate->SliceAggregate($slice);
786 787 788 789 790
    if (!$isupdate) {
	if (defined($aggregate)) {
	    $response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				     "Already have an aggregate for slice");
	    goto bad;
791 792
	}
    }
793
    elsif ($v2 && $level > 0 && !defined($ticket) && !defined($aggregate)) {
794 795 796 797
	print STDERR "No aggregate for $slice in version two API\n";
	$response = GeniResponse->Create(GENIRESPONSE_ERROR);
	goto bad;
    }
798

799
    #
Leigh Stoller's avatar
Leigh Stoller committed
800
    # We need this now so we can form a virtual topo.
801
    #
802 803 804 805 806 807
    my $slice_experiment = GeniExperiment($slice, $user);
    if (GeniResponse::IsResponse($slice_experiment)) {
	$response = $slice_experiment;
	$slice_experiment = undef;
	goto bad;
    }
808 809 810
    my $pid = $slice_experiment->pid();
    my $eid = $slice_experiment->eid();

811
    #
812 813 814 815
    # Set the slice expiration. First off, this does a policy check on the
    # desired expiration. Since this is a new slice, there are no resources
    # allocated and so the reservation system check will succeed. The
    # experiment expiration will also be set, for admission control.
816
    #
817 818
    # See above, we no longer allow expiration to change during update,
    # so skip when doing an update.
819
    #
820 821
    if (!$isupdate) {
	$response =
822
	    SetSliceExpiration($slice, $expires, 0, 1, 0, @{$credentials});
823 824
	goto bad
	    if (GeniResponse::IsResponse($response));
825
    }
826
    
827 828 829 830 831
    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 Stoller's avatar
Leigh Stoller committed
832 833
	goto bad;
    }
834 835 836 837 838

    #
    # Mark the experiment locally as coming from the cooked interface.
    # This changes what tmcd returns to the local nodes.
    #
839
    my $generated_by = GeniXML::GetText("generated_by", $rspec);
840 841
    if (defined($generated_by) &&
	$generated_by eq "libvtop") {
842 843 844 845
	$slice_experiment->Update({"geniflags" =>
				       $Experiment::EXPT_GENIFLAGS_EXPT|
				       $Experiment::EXPT_GENIFLAGS_COOKED});
    }
Leigh Stoller's avatar
Leigh Stoller committed
846 847 848 849 850 851 852 853 854 855 856 857 858
    
    #
    # 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);
859 860 861 862

    #
    # Allow user to control the multiplex factor. Note that ptopgen
    # will not allow the mfactor to be more then what we set as the
863 864 865 866 867 868 869 870 871 872 873 874 875 876
    # max for the node, but in general we set it low here. Also note
    # that to support Emulab Classic NS file conversion, zero means to
    # not change it.
    #
    my $mfactor = GeniXML::MultiplexFactor($rspec);
    if (defined($mfactor)) {
	if ($mfactor != 0) {
	    $virtexperiment->multiplex_factor($mfactor);
	}
    }
    else {
	# Odd geni default dating back to the beginning of time.
	$virtexperiment->multiplex_factor(10);
    }
877 878 879 880 881
    #
    # The packing strategy is sorta independent; the user can specify either
    # pack or balance (load balance).
    #
    my $packing_option = GeniXML::PackingStrategy($rspec);
882

883 884 885 886 887
    #
    # Global root keys disable.
    #
    my $disablerootkeys = GeniXML::DisableRootKey($rspec);

888 889 890 891 892 893 894
    #
    # Allow caller to turn off vlan creation. 
    #
    if (GeniXML::SkipVlans($rspec)) {
	$virtexperiment->skipvlans(1);
    }

895
    #
896
    # User can turn off routing.
897
    #
898 899 900 901 902 903 904 905 906 907 908 909
    my $routertype = GeniXML::RoutingStyle($rspec);
    if (!defined($routertype)) {
	$routertype = "static-ddijk";
    }
    elsif ($routertype eq "static") {
	$routertype = "static-ddijk";
    }
    elsif ($routertype ne "none") {
	$response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					 "Bad routing style: $routertype");
	goto bad;
    }
910
    
911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936
    #
    # User can set the delay image. 
    #
    if (defined(GeniXML::DelayImage($rspec))) {
	my $delayurn = GeniXML::DelayImage($rspec);
	
	if (!GeniHRN::IsValid($delayurn)) {
	    $response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					     "Invalid URN: $delayurn");
	    goto bad;
	}
	my $hrn = GeniHRN->new($delayurn);
	my (undef,$ospid,$os,$vers) = $hrn->ParseImage();
	if ($hrn->type() ne "image" || !defined($ospid) || !defined($os)) {
	    $response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					     "Malformed image URN: $delayurn");
	    goto bad;
	}
	my $delayname = $os;
	$delayname = "${ospid}/" . $delayname
	    if (defined($ospid));
	$delayname .= ":${vers}"
	    if (defined($vers));
	
	$virtexperiment->delay_osname($delayname);
    }
937

938 939 940 941 942 943 944 945 946 947
    #
    # 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()) {
948
	$virtexperiment->NewTableRow("virt_vtypes",
949 950 951 952
				     {"name"     => $row->{'vtype'},
				      "members"  => $row->{'types'},
				      "weight"   => $row->{'weight'}
				     });
953
    }
954

955 956 957 958 959
    # Need to move this someplace else; the parser adds a bunch.
    $virtexperiment->NewTableRow("virt_agents",
				 {"vnode"      => "*",
				  "vname"      => "ns",
				  "objecttype" => "6"});
960 961 962 963
    $virtexperiment->NewTableRow("virt_agents",
				 {"vnode"      => "*",
				  "vname"      => "linktest",
				  "objecttype" => "7"});
964

965 966 967
    #
    # Look for toplevel address pools
    #
968 969 970 971 972 973 974
    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") {
975
		    $response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
976 977 978 979 980
		     "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",
981 982 983 984
					 {"pool_id" => $pool->{'client_id'},
					  "count" => $pool->{'count'},
					  "restriction" => $pool->{'type'},
					  "version" => "ipv4" });
985
	    }
986 987 988
	}
    }

989 990 991 992 993 994 995 996 997 998 999 1000
    #
    # 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);
	}
1001
    }
1002 1003 1004 1005
    #
    # Note that we set the mounts to "genidefault" when we create the
    # container experiment. So this overrides.
    #
1006 1007
    if ($PROTOGENI_NONFSMOUNTS) {
	$virtexperiment->nonfsmounts(1);
1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024
	# This is the new way of doing things.
	$virtexperiment->nfsmounts("none");
    }
    elsif (GeniXML::FromEmulabPortal($rspec) && $PROTOGENI_LOCALUSER) {
	#
	# By not setting, we get standard emulab mounts which include
	# /users. Not sure if I want to explictly set this.
	#
	# But we do not let anyone do this, at the moment only the local
	# SA can do that, which means the authority that contacted us
	# must be our SA. Not even users from our SA can specify this.
	#
	my $hrn = GeniHRN->new($ENV{"GENIURN"});
	if (defined($hrn) &&
	    $hrn->domain() eq $OURDOMAIN && $hrn->IsSA()) {
	    $virtexperiment->nfsmounts("emulabdefault");
	}
1025
    }
1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036
    # Record this info for local email about these slices.
    my ($portal_tag,$portal_url) = GeniXML::GetPortal($rspec);
    if (defined($portal_tag) && $portal_tag ne "" &&
	$portal_tag =~ /^([-\w]+)$/) {
	$slice->SetPortalTag($portal_tag);
    }
    if (defined($portal_url) && $portal_url ne "" &&
	TBcheck_dbslot($portal_url, "default", "tinytext",
		       TBDB_CHECKDBSLOT_WARN|TBDB_CHECKDBSLOT_ERROR)) {
	$slice->SetPortalURL($portal_url);
    }
1037

Leigh Stoller's avatar
Leigh Stoller committed
1038
    #
Leigh Stoller's avatar
Leigh Stoller committed
1039 1040
    # An rspec is a structure that requests specific nodes. If those
    # nodes are available, then reserve it. Otherwise the ticket
Leigh Stoller's avatar
Leigh Stoller committed
1041 1042
    # cannot be granted.
    #
1043 1044 1045
    my %namemap  = ();
    my %colomap  = ();
    my %ifacemap = ();
1046
    my %iface2node = ();
1047
    my %vportmap = ();
Leigh Stoller's avatar
Leigh Stoller committed
1048
    my %nodemap  = ();
1049
    my %bridgemap= ();
1050
    my @nodeids  = ();
1051
    my %lannodes = ();
1052
    my %allnodes = ();
1053
    my %bsnames  = ();
1054
    my %prognames= ();
1055 1056
    # Extra nodes (like XEN vhosts).
    my %internal_nodemap  = ();
1057
    # For stitching, keep track of external nodes and links.
1058 1059 1060
    my %external_nodemap  = ();
    my %external_linkmap  = ();
    my %external_vportmap = ();
1061
    my %external_lanrefs  = ();
Leigh Stoller's avatar
Leigh Stoller committed
1062
    my $routable_ip_count = 0;
1063
    my $sync_server = ($isupdate ? $slice_experiment->sync_server() : undef);
1064 1065 1066
    # Recall any Docker image/Dockerfile URLs we've already checked.
    my %checked_docker_extimages = ();
    my %checked_dockerfile_urls  = ();
1067

1068 1069
    # Always do this to avoid buildup.
    $slice_experiment->ClearBackupState();
1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094

    #
    # Find all the node client ids, so we can support binding VMs to other
    # nodes in the topology. We could enforce that the rspec has to put
    # those nodes first, but that would be annoying to users. And me.
    #
    foreach my $ref (GeniXML::FindNodes("n:node", $rspec)->get_nodelist()) {
	# Let remote nodes pass through.
	next
	    if (!GeniXML::IsLocalNode($ref));

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

	my $node_nickname = GeniXML::GetVirtualId($ref);

	# Might as well do a duplicate check while we are here.
	if (exists($allnodes{lc($node_nickname)})) {
	    $response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					     "Duplicate node $node_nickname");
	    goto bad;
	}
	$allnodes{lc($node_nickname)} = 1;
    }
1095
    
1096 1097 1098 1099 1100 1101 1102
    #
    # 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 Stoller's avatar
Leigh Stoller committed
1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119
	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;
	}
1120 1121 1122 1123 1124 1125 1126
	my $oldrspec;
	if ($v2 && defined($aggregate)) {
	    $oldrspec = $aggregate->GetManifest(0);
	}
	else {
	    $oldrspec = $ticket->rspec();
	}
Leigh Stoller's avatar
Leigh Stoller committed
1127
	
1128
	foreach my $ref (GeniXML::FindNodes("n:node",
1129
					    $oldrspec)->get_nodelist()) {
1130
	    # Let remote nodes pass through.
1131
	    next
1132
		if (!GeniXML::IsLocalNode($ref));
1133

1134 1135
	    # Skip lan nodes; they are fake.
	    next
1136
		if (GeniXML::IsLanNode($ref));
1137

1138
	    my $node_nickname = GeniXML::GetVirtualId($ref);
1139
	    my $colocate      = GeniXML::GetColocate($ref);
1140
	    my $component_id  = GeniXML::GetNodeId($ref);
1141 1142
	    my $vnode_id      = GeniXML::GetVnodeId($ref);
	    my $node = GeniUtil::LookupNode($vnode_id);
1143 1144
	    if (!defined($node)) {
		$response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
1145
				 "Bad resource $component_id in ticket");
1146 1147
		goto bad;
	    }
1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162
	    #
	    # 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;
	    }
1163 1164 1165 1166 1167
	    $namemap{$node_nickname} = $node;
	    $colomap{$colocate} = $node
		if (defined($colocate));
	}
    }
Leigh Stoller's avatar
Leigh Stoller committed
1168

1169
    print GeniXML::Serialize($rspec);
Leigh Stoller's avatar
Leigh Stoller committed
1170

1171 1172
    DebugTimeStamp("Processing nodes");

1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194
    # Prepass to setup a mapping of vhost to vnode.  We use this in the
    # next pass.
    my %instantiateOnHosts = ();
    foreach my $ref (GeniXML::FindNodes("n:node", $rspec)->get_nodelist()) {
	my $node_nickname = GeniXML::GetVirtualId($ref);
	my $instantiate_on= GeniXML::GetInstantiateOn($ref);

	# Skip nodes that don't have an instantiate_on relation.
	next if (!defined($instantiate_on) || $instantiate_on eq '');

	# Let remote nodes pass through.
	next if (! GeniXML::IsLocalNode($ref));

	# Lan nodes are fake and do not go into the virt topo.
	next if (GeniXML::IsLanNode($ref));

	if (!exists($instantiateOnHosts{$instantiate_on})) {
	    $instantiateOnHosts{$instantiate_on} = [];
	}
	push(@{$instantiateOnHosts{$instantiate_on}},$node_nickname);
    }

1195
    foreach my $ref (GeniXML::FindNodes("n:node", $rspec)->get_nodelist()) {
1196
	my $component_id  = GeniXML::GetNodeId($ref);
1197
	my $vnode_id      = GeniXML::GetVnodeId($ref);
1198
	my $manager_id    = GeniXML::GetManagerId($ref);
1199
	my $node_nickname = GeniXML::GetVirtualId($ref);
1200 1201
	my $colocate      = GeniXML::GetColocate($ref);
	my $subnode_of    = GeniXML::GetSubnodeOf($ref);
1202
	my $instantiate_on= GeniXML::GetInstantiateOn($ref);
1203 1204
	my $virtualization_type = GeniXML::GetVirtualizationType($ref);
	
1205
	my $virtualization_subtype
1206 1207
                          = GeniXML::GetVirtualizationSubtype($ref);
	my $exclusive     = GeniXML::GetExclusive($ref);
1208
	my $tarfiles      = GeniXML::GetTarball($ref);
1209
	my $pctype;
1210
	my ($osname, $osinfo);
1211
	my $parent_osname;
Leigh Stoller's avatar
Leigh Stoller committed
1212
	my $node;
1213 1214
	my $isbridge    = 0;
	my $isfirewall  = 0;
1215
	my $isvhost     = 0;
Leigh Stoller's avatar
Leigh Stoller committed
1216
	my $xensettings;
1217
	my $dockersettings;
1218
	my $fwsettings;
1219
	
1220 1221 1222 1223 1224
	# 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);
1225 1226 1227 1228 1229 1230 1231
	    if (exists($iface2node{$virtual_id})) {
		$response =
		    GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					 "Duplicate interface $virtual_id on ".
					 "node $node_nickname");
		goto bad;
	    }
1232 1233 1234
	    $iface2node{$virtual_id} = $node_nickname;
	}

1235
	# Let remote nodes pass through.
1236 1237 1238 1239
	if (! GeniXML::IsLocalNode($ref)) {
	    $external_nodemap{$node_nickname} = $ref;
	    next;
	}
1240

1241
	#
1242 1243 1244 1245 1246
	#
	# 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. 
	#
1247
	if (GeniXML::IsLanNode($ref)) {
1248 1249 1250 1251
	    $lannodes{$node_nickname} = $ref;
	    next;
	}

1252 1253 1254 1255 1256 1257 1258 1259
	#
	# 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}";
1260
	if (0 && length($fullhostname) > 63) {
1261 1262 1263 1264
	    $response = GeniResponse->Create(GENIRESPONSE_TOOBIG, undef,
				     "Hostname > 63 characters: $fullhostname");
	    goto bad;
	}
1265 1266 1267 1268 1269 1270

	# Check to see if this node is hosting other nodes.
	if (exists($instantiateOnHosts{$node_nickname})) {
	    $isvhost = 1;
	}

1271 1272 1273
	#
	# Check for disk_image request. Specified as a URN. 
	#
1274
	my $diskref = GeniXML::GetDiskImage($ref);
1275 1276
	if (defined($diskref)) {
	    my $dname = GeniXML::GetText("name", $diskref);
1277
	    my $url   = GeniXML::GetText("url", $diskref);
1278

1279 1280 1281 1282 1283
	    # url is deprecated; name can be anything.
	    if (defined($dname) && $dname =~ /^http/) {
		$url = $dname;
	    }

1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298
	    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)) {
1299 1300 1301 1302 1303 1304 1305
		if (! GeniHRN::IsValid($dname)) {
		    $response =
			GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					 "Malformed image URN: $dname");
		    goto bad;
		}
		my ($auth,$type,$id) = GeniHRN::Parse($dname);
1306 1307
		my ($ospid,$os,undef,$vers) =
		    ($id =~ m{([^/]+)//([^/]+)(//(\d+))?});		
1308 1309 1310 1311 1312 1313
		if ($type ne "image" || !defined($ospid) || !defined($os)){
		    $response =
			GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					 "Malformed image URN: $dname");
		    goto bad;
		}
1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338
		# See if we have any version of this image.
		$osinfo = OSImage->Lookup($ospid, $os);
		#
		# If we do and the request was for a specific version of
		# the image and this image was imported, then the version
		# number probably refers to the version at the origin. We
		# want to use the hash to resolve it instead, down in
		# MapToLocalImage.
		# 
		if (defined($osinfo) && defined($vers)) {
		    if ($osinfo->IsLocal()) {
			$osinfo = OSImage->Lookup($ospid, $os, $vers);
			if (!defined($osinfo)) {
			    $response =
				GeniResponse->Create(GENIRESPONSE_BADARGS,
						     undef,
						     "Unknown image URN: ".
						     "$dname");
			    goto bad;
			}
		    }
		    else {
			$osinfo = undef;
		    }
		}
1339
		if (!defined($osinfo)) {
1340 1341 1342
		    if ($use_imagetracker) {
			my $image = GeniImage::MapToLocalImage($dname, $pid);
			if (GeniResponse::IsError($image)) {
1343 1344 1345
			    #
			    # Map SEARCHFAILED to BADARGS on this path.
			    #
1346
			    $response = $image;
1347 1348 1349 1350 1351 1352
			    if ($response->{'code'} ==
				GENIRESPONSE_SEARCHFAILED) {
				$response->{'code'} = GENIRESPONSE_BADARGS;
				$response->{'output'} = "Could not lookup ".
				    "image at the image server: $dname";
			    }
1353 1354
			    goto bad;
			}
1355 1356 1357 1358 1359 1360 1361 1362
			if ($image->IsLocal() || $image->IsSystemImage()) {
			    # No need for image_setup to look at it.
			    # System images are never auto imported.
			    $osname = $image->versname();
			}
			else {
			    $osname = $image->metadata_url();
			}
1363 1364 1365 1366 1367 1368 1369
		    }
		    else {
			$response =
			    GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
						 "Unknown image URN: $dname");
			goto bad;
		    }
1370
		}
1371 1372 1373
		else {
		    #
		    # The OS must be in the current project, or it must
1374
		    # be global.
1375
		    #
1376
		    if (! ($osinfo->global() ||
1377
			   $osinfo->pid() eq $slice_experiment->pid())) {
1378
			if ($PROTOGENI_LOCALUSER && $user->IsLocal()) {
1379
			    my $image = OSImage->Lookup($ospid,$os,$vers);
1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397
			    if (!defined($image)) {
				$response =
				    GeniResponse->Create(GENIRESPONSE_BADARGS,
							 undef,
							 "No image: $dname");
				goto bad;
			    }
			    goto noperm
				if (!$image->AccessCheck($user->emulab_user(),
							 TB_IMAGEID_READINFO));
			}
			else {
			  noperm:
			    $response =
				GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				 "Insufficient permission to use $dname");
			    goto bad;			
			}
1398 1399 1400 1401 1402 1403 1404
		    }
		    #
		    # This is only going to be used in raw mode. 
		    #
		    $osname  = "$ospid/$os";
		    $osname .= ":${vers}" if (defined($vers));
		}
1405 1406 1407
	    }
	}

Leigh Stoller's avatar
Leigh Stoller committed
1408 1409 1410
	if (defined($virtualization_type)) {
	    if ($virtualization_type eq "emulab-vnode") {
		if (defined($virtualization_subtype)) {
1411 1412
		    $pctype = "pcvm";
		    
Leigh Stoller's avatar
Leigh Stoller committed
1413 1414 1415 1416
		    if ($virtualization_subtype eq "emulab-jail") {
			$osname = "FBSD-JAIL";
		    }
		    elsif ($virtualization_subtype eq "emulab-openvz") {
1417 1418 1419 1420 1421 1422 1423 1424
			# 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";
			    }
			}
1425 1426
			elsif (!defined($osname)) {
			    # Allow for url above.
1427 1428
			    $osname = "OPENVZ-STD";
			}
Leigh Stoller's avatar
Leigh Stoller committed
1429
		    }
1430 1431
		    elsif ($virtualization_subtype eq "emulab-xen" ||
			   $virtualization_subtype eq "default-vm") {
1432 1433 1434 1435 1436
			# Allow caller to set the image to use, but also
			# trick to set the parent. 
			if (defined($osinfo)) {
			    if (! $osinfo->IsSubOS()) {
				$parent_osname = $osname;
1437
				$osname = "UBUNTU14-64-STD";
1438 1439
			    }
			}
1440
			# If not set, we will pick up the default_image below.
Leigh Stoller's avatar
Leigh Stoller committed
1441 1442 1443 1444 1445 1446
			#
			# Look for the knobs
			#
			if (GeniXML::HasXenSettings($ref)) {
			    $xensettings = GeniXML::GetXenSettings($ref);
			}
1447 1448 1449
			my $ptype = GeniXML::XenPtype($ref);
			$pctype = $ptype
			    if (defined($ptype));
1450
			$virtexperiment->encap_style("vlan");
1451 1452 1453 1454 1455 1456 1457

			#
			# Per-vnode firewall options.
			#
			if (GeniXML::HasFirewallSettings($ref)) {
			    $fwsettings = GeniXML::GetFirewallSettings($ref);
			}
1458
		    }
1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502
		    elsif ($virtualization_subtype eq "emulab-docker") {
			# 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 = "DOCKER-EXT";
			    }
			}
			elsif (!defined($osname)) {
			    # Allow for Docker image url via node attribute.
			    $osname = "DOCKER-EXT";
			}
			# If not set, we will pick up the default_image below.
			#
			# Look for the knobs
			#
			if (GeniXML::HasDockerSettings($ref)) {
			    $dockersettings = GeniXML::GetDockerSettings($ref);
			}
			# If they want an external image (or we
			# defaulted to one), but one isn't set, set a
			# good default.
			if ($osname eq 'DOCKER-EXT') {
			    if (!defined($dockersettings)) {
				$dockersettings = {};
			    }
			    if (!exists($dockersettings->{'extimage'})
				&& !exists($dockersettings->{'dockerfile'})) {
				$dockersettings->{'extimage'} = "ubuntu:16.04";
			    }
			}
			my $ptype = GeniXML::DockerPtype($ref);
			$pctype = $ptype
			    if (defined($ptype));
			$virtexperiment->encap_style("vlan");

			#
			# Per-vnode firewall options.
			#
			if (GeniXML::HasFirewallSettings($ref)) {
			    $fwsettings = GeniXML::GetFirewallSettings($ref);
			}
		    }
1503 1504 1505 1506
		    elsif ($virtualization_subtype eq "emulab-spp") {
			$osname = "SPPVM-FAKE";
			$pctype = "sppvm";
			# Lets force to shared node.
1507
			if (! GeniXML::SetExclusive($ref, 0)) {
1508 1509 1510
			    $response
				= GeniResponse->Create(GENIRESPONSE_BADARGS,
						       undef,
1511 1512
				       "Malformed rspec: ".
				       "Cannot set exclusive tag to false");
1513 1514 1515
			    goto bad;
			}
			$exclusive = 0;
1516 1517
			# Kludge for libvtop.
			$virtexperiment->multiplex_factor(1);
1518
			$virtexperiment->encap_style("vlan");
1519
		    }
1520 1521 1522 1523 1524 1525
		    elsif ($virtualization_subtype eq "emulab-bbg") {
			$osname = "BBGENIVM-FAKE";
			$pctype = "bbgenivm";
			# Lets force to shared node.
			GeniXML::SetExclusive($ref, 0);
			$exclusive = 0;
1526
			$virtexperiment->multiplex_factor(5);
1527 1528
			$virtexperiment->encap_style("vlan");
		    }
1529 1530 1531 1532
		    elsif ($virtualization_subtype eq "emulab-blockstore") {
			$osname = "BLOCKSTORE-VM";
			$pctype = "blockstore";
		    }
1533 1534 1535 1536 1537 1538 1539 1540 1541 1542
		    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");
		    }
1543 1544
		    elsif ($virtualization_subtype eq "raw"
			   || $virtualization_subtype eq "raw-pc") {
1545 1546 1547
			$pctype = undef;
			goto raw;
		    }