All new accounts created on Gitlab now require administrator approval. If you invite any collaborators, please let Flux staff know so they can approve the accounts.

create_instance.in 44.6 KB
Newer Older
1 2
#!/usr/bin/perl -w
#
Leigh B Stoller's avatar
Leigh B Stoller committed
3
# Copyright (c) 2008-2016 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 29 30 31
# 
# {{{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.
# 
# }}}
#
use strict;
use English;
32
use Getopt::Long;
33
use XML::Simple;
34
use File::Temp qw(tempfile :mktemp tmpnam :POSIX);
35
use Data::Dumper;
36
use Cwd qw(realpath);
37 38 39 40 41 42

#
# Create a quick VM.
# 
sub usage()
{
43
    print "Usage: quickvm [-u uuid] [--site site:1=aggregate ...] <xmlfile>\n";
44 45
    exit(1);
}
46
my @optlist = ('d', 'v', 'u=s', 'a=s', 'S', 'k=s', 'i');
47 48
my $debug   = 0;
my $verbose = 1;
49
my $ignorefailures = 0;
50
my $xmlfile;
51
my $webtask;
Leigh B Stoller's avatar
Leigh B Stoller committed
52
my $webtask_id;
53
my $localuser  = 0;
54
my $usestitcher= 0;
55
my $quickuuid;
56
my $this_user;
57
my $xmlparse;
58
my $instance;
59
my $privkeyfile;
60 61
my $slice;
my $sitemap;
62
my $usetracker = 0;
63 64
my @aggregate_urns = ();

65 66 67
# Protos
sub fatal($);
sub UserError($);
68
sub SnapShot($$$);
69
sub CreateDatasetCreds($$$$$);
70 71
sub CreateSlivers();
sub RunStitcher();
72 73 74 75 76 77 78 79

#
# Configure variables
#
my $TB		  = "@prefix@";
my $TBOPS         = "@TBOPSEMAIL@";
my $TBLOGS        = "@TBLOGSEMAIL@";
my $OURDOMAIN     = "@OURDOMAIN@";
80
my $MAINSITE      = @TBMAINSITE@;
81
my $PGENIDOMAIN   = "@PROTOGENI_DOMAIN@";
82
my $PROTOGENI_URL = "@PROTOGENI_URL@";
83 84 85
my $SACERT	  = "$TB/etc/genisa.pem";
my $CMCERT	  = "$TB/etc/genicm.pem";
my $SSHKEYGEN     = "/usr/bin/ssh-keygen";
86
my $SSHSETUP      = "$TB/sbin/aptssh-setup";
87
my $ADDPUBKEY     = "$TB/sbin/addpubkey";
88
my $UPDATEGENIUSER= "$TB/sbin/protogeni/updategeniuser";
89
my $STITCHER      = "$TB/gcf/src/stitcher.py";
90
my $OPENSSL       = "/usr/bin/openssl";
Leigh B Stoller's avatar
Leigh B Stoller committed
91
my $MANAGEINSTANCE= "$TB/bin/manage_instance";
92
my $DEFAULT_URN   = "urn:publicid:IDN+$OURDOMAIN+authority+cm";
93
my $GUEST_URN     = "urn:publicid:IDN+apt.emulab.net+authority+cm";
94
my $default_aggregate_urn = $DEFAULT_URN;
95 96 97 98 99 100 101 102

# un-taint path
$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin:/usr/site/bin';
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

#
# Turn off line buffering on output
#
103
$| = 1;
104 105 106

# Load the Testbed support stuff.
use lib "@prefix@/lib";
107
use EmulabConstants;
108 109
use libtestbed;
use libaudit;
Leigh B Stoller's avatar
Leigh B Stoller committed
110
use APT_Profile;
Leigh B Stoller's avatar
Leigh B Stoller committed
111
use APT_Instance;
112
use APT_Geni;
113
use APT_Dataset;
114
use APT_Aggregate;
115
use User;
116
use Project;
117
use Group;
118 119
use OSinfo;
use emutil;
120
use libEmulab;
121 122 123 124 125 126 127 128 129
use GeniDB;
use GeniUser;
use GeniCertificate;
use GeniCredential;
use GeniSlice;
use GeniAuthority;
use GeniHRN;
use Genixmlrpc;
use GeniResponse;
130
use GeniXML;
131
use WebTask;
132
use Logfile;
133
use EmulabFeatures;
134 135 136 137 138

#
# Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments.
#
139
Getopt::Long::Configure("no_ignore_case");
140
my %options = ();
141
if (! GetOptions(\%options, @optlist, "site=s%" => \$sitemap)) {
142 143
    usage();
}
144
if (defined($options{"a"})) {
145
    $default_aggregate_urn = $options{"a"};
146
}
147 148 149
if (defined($options{"k"})) {
    $privkeyfile = $options{"k"};
}
150 151 152
if (defined($options{"d"})) {
    $debug = 1;
}
153 154 155
if (defined($options{"i"})) {
    $ignorefailures = 1;
}
156 157 158
if (defined($options{"v"})) {
    $verbose = 1;
}
159 160
if (defined($options{"S"})) {
    $usestitcher = 1;
161
}
162 163 164
if (defined($options{"u"})) {
    $quickuuid = $options{"u"};
}
165
if (@ARGV < 1) {
166 167
    usage();
}
168
$xmlfile = shift(@ARGV);
169

170 171 172 173 174 175
#
# Check the filename when invoked from the web interface; must be a
# file in /tmp.
#
if (getpwuid($UID) ne "nobody") {
    $this_user = User->ThisUser();
176

177 178 179 180 181 182 183 184 185 186 187
    if (! defined($this_user)) {
	fatal("You ($UID) do not exist!");
    }
    $localuser = 1;
}
if (!defined($this_user) || !$this_user->IsAdmin()) {
    if ($xmlfile =~ /^([-\w\.\/]+)$/) {
	$xmlfile = $1;
    }
    else {
	fatal("Bad data in pathname: $xmlfile");
188 189
    }

190 191 192 193 194 195 196
    # Use realpath to resolve any symlinks.
    my $translated = realpath($xmlfile);
    if ($translated =~ /^(\/tmp\/[-\w\.\/]+)$/) {
	$xmlfile = $1;
    }
    else {
	fatal("Bad data in translated pathname: $xmlfile");
197 198 199
    }
}

200 201
# Email record.
if (! $debug) {
Leigh B Stoller's avatar
Leigh B Stoller committed
202 203
    my $opts = LIBAUDIT_LOGTBLOGS()|LIBAUDIT_LOGONLY();
    AuditStart(0, undef, $opts);
204 205 206
    #
    # Once we determine the project, we can add the appropriate log CC
    #
207
}
208 209 210 211 212 213 214 215 216 217 218 219 220 221 222

# Connect to the SA DB.
DBConnect(GENISA_DBNAME());

#
# Load the SA cert to act as caller context.
#
my $sa_certificate = GeniCertificate->LoadFromFile($SACERT);
if (!defined($sa_certificate)) {
    fatal("Could not load certificate from $SACERT\n");
}
my $sa_authority = GeniAuthority->Lookup($sa_certificate->urn());
if (!defined($sa_authority)) {
    fatal("Could not load SA authority object");
}
223 224 225 226
# Guest users default to the APT cluster on the Mothership.
if ($MAINSITE && !$localuser) {
    $default_aggregate_urn = $GUEST_URN;
}
227 228

#
229
# We use the normal XMLRPC route, so need a context.
230 231 232 233 234 235 236 237 238 239
#
my $context = Genixmlrpc->Context($sa_certificate);
if (!defined($context)) {
    fatal("Could not create context to talk to CM");
}
Genixmlrpc->SetContext($context);

#
# Must wrap the parser in eval since it exits on error.
#
240 241 242 243
$xmlparse = eval { XMLin($xmlfile,
			 VarAttr => 'name',
			 ContentKey => '-content',
			 SuppressEmpty => undef); };
244 245 246 247 248 249
fatal($@)
    if ($@);

#
# Make sure all the required arguments were provided.
#
250
foreach my $key ("username", "email", "profile", "portal") {
251 252 253 254 255 256 257 258 259
    fatal("Missing required attribute '$key'")
	if (! (exists($xmlparse->{'attribute'}->{"$key"}) &&
	       defined($xmlparse->{'attribute'}->{"$key"}) &&
	       $xmlparse->{'attribute'}->{"$key"} ne ""));
}

#
# Gather up args and sanity check.
#
260
my ($value, $user_urn, $user_uid, $user_hrn, $user_email, $project, $pid,
261
    $gid, $group, $sshkey, $profile, $profileid, $version, $rspecstr, $errmsg,
262 263 264 265
    $userslice_id, $portal);

# This is used internally to determine which portal was used.
$portal = $xmlparse->{'attribute'}->{"portal"}->{'value'};
266 267 268 269 270

#
# Username and email has to be acceptable to Emulab user system.
#
$value = $xmlparse->{'attribute'}->{"username"}->{'value'};
Leigh B Stoller's avatar
Leigh B Stoller committed
271
if (! TBcheck_dbslot($value, "users", "uid",
272
		     TBDB_CHECKDBSLOT_WARN|TBDB_CHECKDBSLOT_ERROR)) {
Leigh B Stoller's avatar
Leigh B Stoller committed
273
    fatal("Illegal username: $value - " . TBFieldErrorString());
274 275 276 277 278 279 280 281 282 283 284 285
}
$user_uid = $value;
$user_urn = GeniHRN::Generate("$OURDOMAIN", "user", $user_uid);
$user_hrn = "${PGENIDOMAIN}.${user_uid}";

$value = $xmlparse->{'attribute'}->{"email"}->{'value'};
if (! TBcheck_dbslot($value, "users", "usr_email",
		     TBDB_CHECKDBSLOT_WARN|TBDB_CHECKDBSLOT_ERROR)) {
    fatal("Illegal email address: $value");
}
$user_email = $value;

286 287 288 289 290 291 292 293 294 295
#
# The instance name is optional, we will make one up if not supplied.
#
if (exists($xmlparse->{'attribute'}->{"instance_name"}) &&
    $xmlparse->{'attribute'}->{"instance_name"}->{'value'} ne "") {
    $value = $xmlparse->{'attribute'}->{"instance_name"}->{'value'};
    if (! TBcheck_dbslot($value, "experiments", "eid",
			 TBDB_CHECKDBSLOT_WARN|TBDB_CHECKDBSLOT_ERROR)) {
	fatal("Illegal instance name: $value");
    }
296
    $userslice_id = $value;
297 298
}

299
#
300
# Profile.
301
#
302
# This is a safe lookup.
303 304 305
$value = $xmlparse->{'attribute'}->{"profile"}->{'value'};
$profile = APT_Profile->Lookup($value);
if (!defined($profile)) {
Leigh B Stoller's avatar
Leigh B Stoller committed
306
    fatal("No such profile: $value");
307
}
308 309
$profileid = $profile->profileid();
$version   = $profile->version();
310

311
#
312
# Optional rspec, as for a Parameterized Profile.
313
#
314 315
if (exists($xmlparse->{'attribute'}->{"rspec"})) {
    $rspecstr  = $xmlparse->{'attribute'}->{"rspec"}->{'value'};
316
}
317 318
else {
    $rspecstr  = $profile->CheckFirewall(!$localuser);
319 320
}

321 322 323 324 325 326
#
# Update rspec with site aggregate urns.
#
# SetSites will tell us if we must use stitcher.
#
my $needstitcher = 0;
327 328 329 330
my $tmp = APT_Profile::SetSites(\$rspecstr, $sitemap, $default_aggregate_urn,
				\@aggregate_urns, \$needstitcher, \$errmsg);
if ($tmp) {
    ($tmp < 0 ? fatal($errmsg) : UserError($errmsg));
331
}
332 333 334 335 336 337 338
#
# Yep, this can happen when users do not put any nodes in their rspec.
#
if (!@aggregate_urns) {
    UserError("There are no nodes in your experiment, syntax error?");
}

339 340
# but do not override command line force.
$usestitcher = 1 if ($needstitcher);
341

342 343 344 345 346 347 348 349 350 351 352 353 354 355
#
# Look for datasets; need to verify that the datasets being referenced
# still exist and are still permissible to use, and we have to generate
# credentials for those datasets (if not a global dataset). The tricky
# aspect is that while a dataset and a profile have project permissions,
# the experiment has no project association, so if the profile/dataset
# perms are okay, then we send over a credential that tells the CM to
# allow this experiment to use that dataset in that project. 
#
$errmsg = "Bad dataset";
if (APT_Profile::CheckDatasets($rspecstr, $profile->pid(), \$errmsg)) {
    UserError($errmsg);
}

356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376
#
# Use ssh-keygen to see if the key is valid and convertable. We first
# try to get the fingerprint, which will tells us if its already in
# openssh format. If not, try to convert it.
#
if (exists($xmlparse->{'attribute'}->{"sshkey"}) &&
    defined($xmlparse->{'attribute'}->{"sshkey"}) &&
    $xmlparse->{'attribute'}->{"sshkey"} ne "") {
    $sshkey = $xmlparse->{'attribute'}->{"sshkey"}->{'value'};
    my ($fh, $keyfile) = tempfile(UNLINK => 0);
    print $fh $sshkey;

    if (system("$SSHKEYGEN -l -f $keyfile >/dev/null 2>/dev/null")) {
	if (! open(KEYGEN, "$SSHKEYGEN -i -f $keyfile 2>/dev/null |")) {
	    fatal("Could not start ssh-keygen");
	}
	$sshkey = <KEYGEN>;
	if (!close(KEYGEN)) {
	    UserError("Could not parse ssh key!");
	}
    }
377 378
    close($fh);
    unlink($keyfile);
379
}
380 381
chomp($sshkey)
    if (defined($sshkey));
382 383 384 385 386 387

#
# See if the GeniUser exists. Create if not, but that means we
# have to create an ssl certificate (which the user will never see)
# so that we can operate on behalf of the user (via speaksfor).
#
388 389 390 391 392 393 394
# Note that we want to check for the user local account ahead of
# SA account, to bypass their guest account that might still be
# in the table.
#
my $geniuser;

if ($localuser) {
395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410
    my $emulab_user = User->Lookup($user_uid);
    
    #
    # Hmm, users with real accounts who never used Geni, but now want
    # to use APT/Cloud, have no encrypted SSL certificate. Rather then
    # force them through the web ui (and have to explain it), create one
    # for them using a random passphrase. The user will not know the
    # passphrase, but for most users it will not matter.
    #
    # This is also going to catch expired certificates, we will regenerate
    # them using the existing passphrase.
    #
    if ($emulab_user->HasValidEncryptedCert() == 0 &&
	$emulab_user->GenEncryptedCert()) {
	fatal("Could not (re)generate encrypted certificate");
    }
Leigh B Stoller's avatar
Leigh B Stoller committed
411
    # Now this will work; without a certificate, above line would fail.
412 413 414
    if (defined($emulab_user)) {
	$geniuser = GeniUser::LocalUser->Create($emulab_user);
    }
415 416 417 418
}
else {
    $geniuser = GeniUser->Lookup($user_urn);

419 420 421
    #
    # In Utah, check for alternate SA
    #
422
    if (!defined($geniuser) && $MAINSITE) {
423 424 425 426 427
	foreach my $urn (@aggregate_urns) {
	    if ($urn ne $GUEST_URN) {
		UserError("Guests are not allowed to use cluster: $urn");
	    }
	}
428 429
	$user_urn = GeniHRN::Generate("aptlab.net", "user", $user_uid);
	$user_hrn = "aptlab.${user_uid}";
430
	$geniuser = GeniUser->LookupGuestOnly($user_urn);
431 432
    }
}
433
if (!defined($geniuser)) {
434 435 436
    if ($localuser) {
	fatal("Could not lookup local user $user_urn");
    }
437
    
438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454
    #
    # Do not allow overlap with local users.
    #
    if (User->Lookup($user_uid)) {
	fatal("User $user_uid exists in the local user table");
    }

    print "Geni user does not exist; creating one ...\n"
	if ($debug);

    #
    # Want to remember the auth token we emailed for later.
    #
    my $auth_token = $xmlparse->{'attribute'}->{"auth_token"}->{'value'};
    if ($auth_token !~ /^[\w]+$/) {
	fatal("Bad auth token: $auth_token");
    }
455 456 457 458 459 460 461 462
    my $blob = {"urn"      => $user_urn,
		"hrn"      => $user_hrn,
		"email"    => $user_email,
		"showuuid" => 1};
    if ($MAINSITE) {
	$blob->{'useaptca'} = 1;
    }
    my $certificate = GeniCertificate->Create($blob);
463 464 465 466 467 468 469 470 471 472
    fatal("Could not create certificate")
	if (!defined($certificate));

    $geniuser = GeniUser->Create($certificate, $sa_authority);
    fatal("Could not create new geni user")
	if (!defined($geniuser));

    $geniuser->SetAuthToken($auth_token);

    #
Leigh B Stoller's avatar
Leigh B Stoller committed
473
    # Setup browser ssh.
474
    #
475 476 477
    system("$SSHSETUP " . $geniuser->uuid());
    fatal("Could not create ssh key pair")
	if ($?);
478 479 480 481
}
my $user_uuid = $geniuser->uuid();
# So we know this user has dome something lately.
$geniuser->BumpActivity();
482

483 484 485
if ($localuser) {
    my $emulab_user = $geniuser->emulab_user();
    if ($emulab_user->IsNonLocal()) {
486 487
	#
	# A user created from a Geni certificate via geni-login. We
488 489
	# asked for the current ssh keys from the MA when they logged
	# in, but we ask again to make sure have the latest keys.
490
	#
491
	system("$UPDATEGENIUSER -s " . $emulab_user->uid());
492
	if (0) {
493 494
	    fatal("Could not update ssh keys for nonlocal user");
	}
495 496 497 498 499 500
	#
	# Check project membership, must be a member of at least one
	# valid project at the GPO portal.
	#
	system("$UPDATEGENIUSER -p " . $emulab_user->uid());
	if ($?) {
501 502 503
	    UserError("Could not get your project membership from your ".
		      "member authority. It is probably offline, please try ".
		      "again later.");
504
	}
Leigh B Stoller's avatar
Leigh B Stoller committed
505 506
	# Nonlocal users get the holding project can now join/create
	# real projects, so we get the pid passed in.
507
    }
508
    elsif (defined($sshkey) && !$emulab_user->LookupSSHKey($sshkey)) {
509 510 511 512 513 514
	#
	# XXX This is deprecated; we no longer show the ssh box to
	#     real users. Remove when we are satisfied with new
	#     ssh key management page.
	#
	
515
	#
516 517 518 519
	# A local user. We mark keys that come through this path
	# with the isaptkey flag (-a to addpubkey) so that we know
	# which key in the DB it is. The reason for this is that the
	# user might be a classic emulab user, but is now using the
520 521 522 523 524
	# APT/Cloud UI. The key provided in the web interface will
	# replace this key.
	#
	# XXX This is in flux, we now allow APT users to manage all
	# their keys via the web interface.
525
	#
526 527 528
	my ($fh, $keyfile) = tempfile(UNLINK => 0);
	print $fh $sshkey;

529
	if (system("$ADDPUBKEY -a -u $user_uid -f $keyfile")) {
530 531 532 533 534
	    fatal("Could not add new ssh pubkey");
	}
	close($fh);
	unlink($keyfile);
    }
535 536 537 538 539 540 541 542 543 544 545 546 547 548
    #
    # Hmm, users with real accounts who never used Geni, but now want
    # to use APT/Cloud, have no encrypted SSL certificate. Rather then
    # force them through the web ui (and have to explain it), create one
    # for them using a random passphrase. The user will not know the
    # passphrase, but for most users it will not matter.
    #
    # This is also going to catch expired certificates, we will regenerate
    # them using the existing passphrase.
    #
    if ($emulab_user->HasValidEncryptedCert() == 0 &&
	$emulab_user->GenEncryptedCert()) {
	fatal("Could not (re)generate encrypted certificate");
    }
549 550 551 552 553 554 555 556 557 558

    # Local users are required to select a project.
    if (! exists($xmlparse->{'attribute'}->{"pid"})) {
	fatal("No project provided for new instance");
    }
    $project = Project->Lookup($xmlparse->{'attribute'}->{"pid"}->{"value"});
    if (!defined($project)) {
	fatal("Project provided does not exist");
    }
    if (!$project->AccessCheck($emulab_user, TB_PROJECT_CREATEEXPT)) {
Mike Hibler's avatar
Mike Hibler committed
559 560
	fatal("No permission to create experiments in project ".
	      $project->pid());
561 562
    }
    $pid = $project->pid();
563

564 565 566 567 568 569 570 571 572 573 574 575 576 577 578
    # Option subgroup.
    if (exists($xmlparse->{'attribute'}->{"gid"}) &&
	$xmlparse->{'attribute'}->{"gid"}->{"value"} ne "" &&
	$xmlparse->{'attribute'}->{"gid"}->{"value"} ne $pid) {
	my $val = $xmlparse->{'attribute'}->{"gid"}->{"value"};
	$group = $project->LookupGroup($val);
	if (!defined($group)) {
	    fatal("Group $val does not exist in project $pid");
	}
    }
    else {
	$group = $project->GetProjectGroup();
    }
    $gid = $group->gid();

579 580 581 582 583
    # Use of the Image Tracker is a Portal directive at the moment.
    $usetracker = 1
	if (GetSiteVar("protogeni/use_imagetracker") &&	
	    EmulabFeatures->FeatureEnabled("APT_UseImageTracker",
					   $emulab_user, $project));
584 585 586 587 588
}
elsif (!$localuser) {
    if (defined($sshkey)) {    #
	# Guest user; remember key. For now we accept only one key. We store
	# it simply so we can display it again for the user in the web
589
	# interface. We allow key reuse for existing users, see above.
590 591 592 593 594
	#
	$geniuser->DeleteKeys();
	$geniuser->AddKey($sshkey);
    }
    # Guest users get a holding project.
595
    $pid = $APT_HOLDINGPROJECT;
596
    $project = Project->Lookup($pid);
597
    $group = $project->GetProjectGroup();
598 599 600
    if (!defined($project)) {
	fatal("Project $pid does not exist");
    }
601
}
602 603 604
#
# Now we know where to send to logs.
#
605 606
if (!$debug) {
    AddAuditInfo("cc", $project->LogsEmailAddress());
Leigh B Stoller's avatar
Leigh B Stoller committed
607 608 609 610
    if ($MAINSITE && $project->isEmulab()) {
	# Mostly people use the Cloudlab UI.
	AddAuditInfo("cc", "cloudlab-logs\@cloudlab.us");
    }
611
}
612

613 614 615
# Generate the extra credentials that tells the backend this experiment
# can access the datasets.
my @dataset_credentials = ();
616 617 618 619 620 621 622
if (defined($profile)) {
    my $retval = CreateDatasetCreds($rspecstr,
				    $profile->pid(), $geniuser, 
				    \$errmsg, \@dataset_credentials);
    if ($retval) {
	($retval < 0 ? fatal($errmsg) : UserError($errmsg));
    }
623 624
}

625
#
626 627 628
#
# Now generate a slice registration and credential
#
629
my $safe_uid    = $user_uid; $safe_uid =~ s/_/-/;
630 631
my $slice_id    = (defined($userslice_id) ? $userslice_id :
		   $safe_uid . "-QV" . TBGetUniqueIndex('next_quickvm', 1));
632 633 634
my $slice_auth  = ($pid eq $gid ? $pid : "${pid}:${gid}");
my $slice_urn   = GeniHRN::Generate("${OURDOMAIN}:${slice_auth}",
				    "slice", $slice_id);
635
my $slice_hrn   = "${PGENIDOMAIN}.${pid}.${slice_id}";
636
my $SERVER_NAME = (exists($ENV{"SERVER_NAME"}) ? $ENV{"SERVER_NAME"} : "");
637 638 639 640 641

#
# Make sure slice is unique. Probably retry here at some point. 
#
if (GeniSlice->Lookup($slice_hrn) || GeniSlice->Lookup($slice_urn)) {
642 643 644 645 646 647 648 649
    if (defined($userslice_id)) {
	UserError("Slice name already in use, please use another. If you ".
		  "just terminated an experiment with this name, it takes a ".
		  "minute or two for the name to become available again.");
    }
    else {
	fatal("Could not form a unique slice name");
    }
650
}
651

652 653 654 655 656 657 658 659 660 661 662 663 664
#
# Generate a certificate for this new slice.
#
my $slice_certificate =
    GeniCertificate->Create({'urn'  => $slice_urn,
			     'hrn'  => $slice_hrn,
			     'showuuid' => 1,
			     'email'=> $user_email});

if (!defined($slice_certificate)) {
    fatal("Could not generate certificate for $slice_urn");
}
# Slice is created as locked.
665 666
$slice = GeniSlice->Create($slice_certificate,
			   $geniuser, $sa_authority, undef, 1);
667 668 669 670
if (!defined($slice)) {
    $slice_certificate->Delete();
    fatal("Could not create new slice object for $slice_urn");
}
671 672
# These get quick expirations, unless it is a real user.
if ($slice->SetExpiration(time() + (($localuser ? 16 : 3) * 3600)) != 0) {
673 674 675 676
    fatal("Could not set the slice expiration for $slice_urn");
}
my $slice_uuid = $slice->uuid();

677 678 679 680 681 682 683 684 685 686 687
#
# Generate a new ssl key/cert to be used to derive an ssh key pair
# or whatever else is needed. This is sent along as an option when the
# sliver is created (or provisioned, when stitching).
#
# This is going to be a real geni certificate, albeit a slice
# certificate in the alternate CA domain, that can be used at the
# "portal" XMLRPC interface. The key is unencrypted and put on the
# nodes, hence the alternate CA, and the XMLRPC server will not allow
# this certificate to do anything, except at the portal RPC server.
#
688
my $alt_urn = GeniHRN::Generate("aptlab.net:${slice_auth}", "slice", $slice_id);
689 690 691 692 693 694 695 696 697
my $alt_hrn = "aptlab.${pid}.${slice_id}";
my $alt_url = "$PROTOGENI_URL/portal";

my $altblob = {"urn"      => $alt_urn,
	       "hrn"      => $alt_hrn,
	       "url"      => $alt_url,
	       "uuid"     => $slice_uuid,
	       "email"    => $user_email,
	       "nostore"  => 1,
698
               "keyfile"  => $privkeyfile,
699 700 701 702 703 704
	       "useaptca" => 1,
	       "showuuid" => 1};
my $alt_certificate = GeniCertificate->Create($altblob);
fatal("Could not create alt certificate")
    if (!defined($alt_certificate));

705 706 707 708 709 710 711
#
# Encrypt blocks.
#
$tmp = APT_Profile::EncryptBlocks(\$rspecstr, $alt_certificate, \$errmsg);
if ($tmp) {
    ($tmp < 0 ? fatal($errmsg) : UserError($errmsg));
}
712 713 714 715 716 717 718 719 720 721 722 723 724 725
#
# Tell the CM to do normal NFS mounts if this is the "Emulab" portal
# making the request. The CM is of course free to ignore this.
#
# XXX Need to handle this differently if we use the stitcher.
#
if ($portal ne "emulab") {
    if (APT_Profile::ClearPortalTag(\$rspecstr, $errmsg)) {
        fatal($errmsg);
    }
}
elsif (APT_Profile::AddPortalTag(\$rspecstr, $portal, $errmsg)) {
    fatal($errmsg);
}
726

727
#
728
# Generate credentials we need.
729
#
730
my ($slice_credential, $speaksfor_credential) =
731
    APT_Geni::GenCredentials($slice, $geniuser, undef, 0);
732 733 734
if (! (defined($speaksfor_credential) &&
       defined($slice_credential))) {
    fatal("Could not generate credentials");
735 736
}

737
#
738
# Got this far, lets create a quickvm record.
739
#
740
my $quickvm_uuid = (defined($quickuuid) ? $quickuuid : NewUUID());
741 742 743
if (!defined($quickvm_uuid)) {
    fatal("Could not generate a new uuid");
}
744
my $blob = {'uuid'         => $quickvm_uuid,
745
	    'name'         => $slice_id,
746 747 748 749 750 751 752
	    'profile_id'   => $profileid,
	    'profile_version' => $version,
	    'slice_uuid'   => $slice_uuid,
	    'creator'      => $geniuser->uid(),
	    'creator_idx'  => $geniuser->idx(),
	    'creator_uuid' => $geniuser->uuid(),
	    'status'       => "created",
753 754
	    'servername'   => $SERVER_NAME,
	    'rspec'        => $rspecstr,
755
	    'cert'         => $alt_certificate->cert(),
756
	    'privkey'      => $alt_certificate->PrivKeyDelimited(),
757 758 759 760
};
if (defined($project)) {
    $blob->{"pid"}     = $project->pid();
    $blob->{"pid_idx"} = $project->pid_idx();
761 762
    $blob->{"gid"}     = $group->gid();
    $blob->{"gid_idx"} = $group->gid_idx();
763
}
764
$errmsg = undef;
765
$instance = APT_Instance->Create($blob, \$errmsg);
Leigh B Stoller's avatar
Leigh B Stoller committed
766
if (!defined($instance)) {
767 768
    fatal(defined($errmsg) ? $errmsg :
	  "Could not create instance record for $quickvm_uuid");
769
}
770

771 772 773 774 775 776 777 778 779 780 781
#
# Get the set of keys (accounts) that need to be sent along. We build
# them in CM format, but convert to AM format later if needed.
#
my $sshkeys;
if ($instance->GetSSHKeys(\$sshkeys) < 0 || !@{$sshkeys}) {
    $slice->Delete();
    $instance->Delete();
    fatal("Error constructing ssh key list");
}

782 783 784
# We use this list of references for ParRun below.
my @aggregate_list = ();
foreach my $aggregate_urn (@aggregate_urns) {
785 786 787 788 789 790 791 792
    my $aptaggregate = APT_Aggregate->Lookup($aggregate_urn);
    if (!defined($aptaggregate)) {
        UserError("$aggregate_urn is not a valid (known) aggregate");
    }
    # Check for disabled/adminonly aggregates.
    if ($aptaggregate->disabled()) {
        UserError("$aggregate_urn is currently offline, try again later");
    }
793 794
    if ($aptaggregate->adminonly() &&
        !(defined($this_user) && $this_user->IsAdmin())) {
795 796
        UserError("Only administrators may use $aggregate_urn");
    }
797 798 799 800 801 802 803 804 805 806 807 808 809 810 811
    my $authority = GeniAuthority->Lookup($aggregate_urn);
    if (!defined($authority)) {
	$authority = GeniAuthority->CreateFromRegistry("cm", $aggregate_urn);
	if (!defined($authority)) {    
	    fatal("Could not load CM authority object for $aggregate_urn");
	}
    }
    my $aggobj = $instance->AddAggregate($aggregate_urn);
    if (!defined($aggobj)) {
	fatal("Could not create aggregate object for $aggregate_urn");
    }
    $aggobj->_authority($authority);
    push(@aggregate_list, $aggobj);
}

Leigh B Stoller's avatar
Leigh B Stoller committed
812 813 814
# To keep stuff happy until multisite support finished.
$instance->Update({'aggregate_urn' => $aggregate_urns[0]});

815 816
#
# Create a webtask so that we can store additional information about
817
# the sliver while we wait.
818 819
#
$webtask = WebTask->Create($instance->uuid());
820 821 822
if (!defined($webtask)) {
    fatal("Could not create a webtask!");
}
Leigh B Stoller's avatar
Leigh B Stoller committed
823
$webtask_id = $webtask->task_id();
824 825 826 827 828 829 830 831 832 833 834 835 836 837
$webtask->AutoStore(1);

print STDERR "\n";
print STDERR "User:    $user_urn\n";
print STDERR "Email:   $user_email" . (!$localuser ? " (guest)" : "") . "\n";
if (defined($profile)) {
    print STDERR "Profile: " . $profile->name() . ":${version}\n";
}
print STDERR "Slice:   $slice_urn\n";
print STDERR "Server:  $SERVER_NAME\n";
print STDERR "Cluster: ";
print STDERR join(",", map($_->aggregate_urn(), @aggregate_list))  . "\n";
print STDERR "\n";
print STDERR "$rspecstr\n";
838 839 840 841 842

#
# Exit and let caller poll for status.
#
if (!$debug) {
843
    libaudit::AuditPrefork();
844 845 846 847 848 849 850 851
    my $child = fork();
    if ($child) {
	# Parent exits but avoid libaudit email.
	exit(0);
    }
    # All of the logging magic happens in here.
    libaudit::AuditFork();
}
852
# Bind the process id.
853 854
$webtask->SetProcessID($PID);

855 856 857
if ($usestitcher) {
    my $rval = RunStitcher();
    if ($rval) {
858 859
	$slice->UnLock();
	$instance->SetStatus("failed");
860 861 862
	$instance->RecordError($rval,
			       (defined($webtask->output()) ?
				$webtask->output() : ""));
863
	$webtask->Exited($rval);
864
	exit($rval);
865
    }
866
}
867 868
else {
    my $rval = CreateSlivers();
869
    #
870
    # We do not want email for most mapping errors, so look at the
871 872 873 874
    # return code to see if we want to kill the log (user will see the
    # error in the web ui). 
    #
    if ($rval) {
875 876 877
	$instance->RecordError($rval,
			       (defined($webtask->output()) ?
				$webtask->output() : ""));
878 879
	if ($rval == GENIRESPONSE_BADARGS ||
	    $rval == GENIRESPONSE_INSUFFICIENT_NODES ||
880 881 882
	    $rval == GENIRESPONSE_INSUFFICIENT_MEMORY ||
	    $rval == GENIRESPONSE_INSUFFICIENT_BANDWIDTH ||
	    $rval == GENIRESPONSE_NO_MAPPING) {
883 884 885 886 887 888
	    AuditAbort()
		if (!$debug);
	}
	$webtask->Exited($rval);
	exit($rval);
    }
889
}
Leigh B Stoller's avatar
Leigh B Stoller committed
890
$instance->SetStatus("provisioned");
891
$instance->ComputeNodeCounts();
892 893

#
894 895 896
# Now wait for the sliver to be ready, which means polling.
#
# Shorten default timeout.
897
#
898
Genixmlrpc->SetTimeout(60);
899

900 901 902
#
# Okay, fire off the waits for each aggregate
#
903
my @return_codes = ();
904
if (ParRun({"maxwaittime" => 99999, "maxchildren" => scalar(@aggregate_list)},
Leigh B Stoller's avatar
Leigh B Stoller committed
905 906
	    \@return_codes,
	    \&APT_Instance::Aggregate::WaitForSliver, @aggregate_list)) {
907 908 909 910 911
    #
    # The parent caught a signal. Leave things intact so that we can
    # kill things cleanly later.
    #
    $slice->UnLock();
912 913
    print STDERR "Internal error in WaitForSlivers\n";
    $webtask->output("Internal error in WaitForSlivers");
914 915 916 917
    $instance->SetStatus("failed");
    $webtask->Exited(1);
    exit(-1);
}
918
print "$slice_urn\n";
919

920 921 922 923 924 925 926 927 928 929 930 931
#
# If we were canceled, then none of the stuff below matters, we
# are going to do a terminate.
#
if ($instance->IsCanceled()) {
    $instance->SetStatus("canceled");
    $slice->UnLock();

    system("$MANAGEINSTANCE -t $webtask_id terminate $quickvm_uuid");
    exit(0);
}

932 933 934
# Count up nodes running a startup service.
my $startuprunning = 0;

935 936 937 938 939 940 941 942 943
#
# Check the exit codes; any failure is a total failure (for now).
#
my $failed = 0;
foreach my $aggobj (@aggregate_list) {
    my $code = shift(@return_codes);

    # Updated in a forked child, must refresh. 
    $aggobj->Refresh();
944 945 946 947 948 949
    print $aggobj->aggregate_urn() . "\n";
    if ($code) {
	$failed++;
	print "WaitforSliver Failure!\n";
	if (defined($aggobj->webtask()->output())) {
	    $webtask->output($aggobj->webtask()->output());
950
	    $webtask->Exited($aggobj->webtask()->exitcode());
951 952 953 954 955
	    print $aggobj->webtask()->output() . "\n";
	}
	else {
	    $webtask->output("WaitforSliver Failure at " .
			     $aggobj->aggregate_urn());
956
	    $webtask->Exited(1);
957
	}
958 959 960
	# Promote the log up to the instance so that so its easy to find.
	$instance->SetPublicURL($aggobj->public_url())
	    if (defined($aggobj->public_url()));
961
    }
Leigh B Stoller's avatar
Leigh B Stoller committed
962 963 964 965 966 967 968 969 970 971 972 973
    else {
	my $statusblob = $aggobj->webtask()->sliverstatus();

	print Dumper($statusblob);

	foreach my $details (values(%{ $statusblob })) {
	    # Startup command is still running.
	    $startuprunning++
		if (exists($details->{'execute_state'}) &&
		    $details->{'execute_state'} ne "exited");
	}
    }
974 975
    if (defined($aggobj->public_url())) {
	print $aggobj->public_url() . "\n";
976
    }
977 978
    print "\n" . $aggobj->manifest() . "\n\n";
    print "------------------------------------------------------------\n\n";
979
}
980
$slice->UnLock();
981

982
if ($failed) {
983 984 985 986 987 988
    if ($ignorefailures) {
        $instance->SetStatus("ready");
    }
    else {
        $instance->SetStatus("failed");
    }
989
    # Webtask exit status set above.
990 991 992
    $instance->RecordError($webtask->exitcode(),
			   (defined($webtask->output()) ?
			    $webtask->output() : ""));
993 994 995
}
else {
    $instance->SetStatus("ready");
Leigh B Stoller's avatar
Leigh B Stoller committed
996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008

    #
    # If there are still execute services running, lets keep polling
    # using the monitor.
    #
    if ($startuprunning) {
	print "$MANAGEINSTANCE -t $webtask_id monitor $quickvm_uuid -w\n";
	
	system("$MANAGEINSTANCE -t $webtask_id monitor $quickvm_uuid -w")
    }
    else {
	$webtask->Exited(0);
    }
1009
}
1010 1011
exit(0);

1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028
#
# Create credentials to access datasets.
#
sub CreateDatasetCreds($$$$$)
{
    my ($xml, $pid, $user, $pmsg, $pref) = @_;
    my @credentials = ();
    
    my $rspec = GeniXML::Parse($xml);
    if (! defined($rspec)) {
	print STDERR "CreateDatasetCreds: Could not parse rspec\n";
	return -1;
    }
    foreach my $ref (GeniXML::FindNodes("n:node", $rspec)->get_nodelist()) {
	foreach my $blockref (GeniXML::FindNodesNS("n:blockstore",
						   $ref,
				   $GeniXML::EMULAB_NS)->get_nodelist()) {
1029 1030
	    my $dataset_id = GeniXML::GetText("persistent", $blockref);
	    if (!defined($dataset_id)) {
1031
		# persistent is deprecated.
1032
		$dataset_id = GeniXML::GetText("dataset", $blockref);
1033
	    }
1034 1035 1036 1037 1038 1039

	    #
	    # We only care about datasets here, we let the backend
	    # do the error checking on ephemeral blockstores.
	    #
	    next
1040 1041 1042 1043 1044 1045 1046 1047 1048 1049
		if (!defined($dataset_id));

	    my $class = GeniXML::GetText("class", $blockref);
	    if (!defined($class)) {
		$class = "remote";
	    }
	    # Image backed. No checking since the image has to be global
	    # anyway. Needs more thought. 
	    next
		if ($class eq "local");
1050
	    
1051
	    my ($authority, $type, $id) = GeniHRN::Parse($dataset_id);
1052
	    my ($dataset_domain) = split(":", $authority);
1053 1054 1055 1056 1057 1058 1059 1060 1061 1062
	    #
	    # Separate project from name; this is how the rspec specifies
	    # the dataset they want, since it might be in another project
	    #
	    if ($id =~ /^([-\w]+)\/\/(.+)$/) {
		$pid = $1;
		$id  = $2;
	    }
	    my $dataset = APT_Dataset->Lookup("$pid/$id");
	    if (!defined($dataset)) {
1063
		$dataset = APT_Dataset->LookupByRemoteURN($dataset_id);
1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075
		if (!defined($dataset)) {
		    # If it is for a local dataset, see if it plain lease
		    # created via the classic interface or command line.
		    # The backend can find those.
		    if ($dataset_domain eq $OURDOMAIN) {
			$dataset = Lease->Lookup($pid, $id);
			if (defined($dataset)) {
			    # No need for a credential.
			    next;
			}
		    }
		}
1076 1077 1078 1079
		if (!defined($dataset)) {
		    $$pmsg = "Persistent dataset '$pid/$id' does not exist";
		    return 1;
		}
1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099
	    }
	    my $certificate = $dataset->GetCertificate();
	    if (!defined($certificate)) {
		$$pmsg = "No certificate for dataset '$pid/$id'";
		return -1;
	    }
	    my $credential =
		APT_Geni::GenCredentials($certificate, $geniuser,
					 ["blockstores"]);
	    if (!defined($credential)) {
		$$pmsg = "Could not create credential for dataset '$pid/$id'";
		return -1;
	    }
	    push(@credentials, $credential->asString());
	}
    }
    @$pref = @credentials;
    return 0;
}

1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116
#
# Create a sliver at a single aggregate. This is called from parrun
# so it needs to return success or failure, we lookup the results
# in the DB.
#
sub CreateSliver($)
{
    my ($ref) = @_;
    my $aggobj = $ref;
    $aggobj->Refresh();
    my $webtask   = $aggobj->webtask();
    my $authority = $aggobj->_authority();
    my $cmurl     = $authority->url();
    my $urn       = $authority->urn();
    $webtask->Refresh();

    # Debugging
1117
    $cmurl = APT_Instance::devurl($cmurl);
1118

1119 1120
    Genixmlrpc->SetTimeout(900);

1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133
    #
    # This creates the sliver and starts it. We have to watch for the
    # server being too busy.
    #
    my $tries = 15;
    my $response;

    while (1) {
	$response =
	    Genixmlrpc::CallMethod($cmurl, undef,
				   "CreateSliver",
				   { "slice_urn"   => $slice_urn,
				     "rspec"       => $rspecstr,
1134
				     "keys"        => $sshkeys,
1135
				     "credentials" =>
Leigh B Stoller's avatar