create_instance.in 49.4 KB
Newer Older
1
2
#!/usr/bin/perl -w
#
3
# Copyright (c) 2008-2017 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 Date::Parse;
36
use Data::Dumper;
37
use Cwd qw(realpath);
38
39
40
41
42
43

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

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

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

# 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
#
108
$| = 1;
109
110
111

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

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

176
177
178
179
180
181
#
# Check the filename when invoked from the web interface; must be a
# file in /tmp.
#
if (getpwuid($UID) ne "nobody") {
    $this_user = User->ThisUser();
182

183
184
185
186
    if (! defined($this_user)) {
	fatal("You ($UID) do not exist!");
    }
    $localuser = 1;
187
    $maxduration = 16; # Hours.
188
189
190
191
192
193
194
}
if (!defined($this_user) || !$this_user->IsAdmin()) {
    if ($xmlfile =~ /^([-\w\.\/]+)$/) {
	$xmlfile = $1;
    }
    else {
	fatal("Bad data in pathname: $xmlfile");
195
196
    }

197
198
199
200
201
202
203
    # Use realpath to resolve any symlinks.
    my $translated = realpath($xmlfile);
    if ($translated =~ /^(\/tmp\/[-\w\.\/]+)$/) {
	$xmlfile = $1;
    }
    else {
	fatal("Bad data in translated pathname: $xmlfile");
204
205
206
    }
}

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

# 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");
}
230
231
232
233
# Guest users default to the APT cluster on the Mothership.
if ($MAINSITE && !$localuser) {
    $default_aggregate_urn = $GUEST_URN;
}
234
235

#
236
# We use the normal XMLRPC route, so need a context.
237
238
239
240
241
242
243
244
245
246
#
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.
#
247
248
249
250
$xmlparse = eval { XMLin($xmlfile,
			 VarAttr => 'name',
			 ContentKey => '-content',
			 SuppressEmpty => undef); };
251
252
253
254
255
256
fatal($@)
    if ($@);

#
# Make sure all the required arguments were provided.
#
257
foreach my $key ("username", "email", "profile", "portal") {
258
259
260
261
262
263
264
265
266
    fatal("Missing required attribute '$key'")
	if (! (exists($xmlparse->{'attribute'}->{"$key"}) &&
	       defined($xmlparse->{'attribute'}->{"$key"}) &&
	       $xmlparse->{'attribute'}->{"$key"} ne ""));
}

#
# Gather up args and sanity check.
#
267
my ($value, $user_urn, $user_uid, $user_hrn, $user_email, $project, $pid,
268
    $gid, $group, $sshkey, $profile, $profileid, $version, $rspecstr, $errmsg,
269
    $userslice_id, $portal, $script, $reporef, $repohash, $duration);
270
271
272

# This is used internally to determine which portal was used.
$portal = $xmlparse->{'attribute'}->{"portal"}->{'value'};
273

274
# User specified duration.
275
276
277
278
279
280
281
282
283
284
285
if (exists($xmlparse->{'attribute'}->{"duration"}) &&
    defined($xmlparse->{'attribute'}->{"duration"}) &&
    $xmlparse->{'attribute'}->{"duration"}->{'value'} ne "") {
    $duration = $xmlparse->{'attribute'}->{"duration"}->{'value'};
    if ($duration !~ /^\d+$/) {
	fatal("Duration is not an integer");
    }
    if ($duration < 1 || $duration > $maxduration) {
	UserError("Duration must be at least 1 hour but ".
		  "not more then $maxduration hour(s)");
    }
286
}
287
288
else {
    $duration = $maxduration; 
289
290
}

291
292
293
294
#
# 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
295
if (! TBcheck_dbslot($value, "users", "uid",
296
		     TBDB_CHECKDBSLOT_WARN|TBDB_CHECKDBSLOT_ERROR)) {
Leigh B Stoller's avatar
Leigh B Stoller committed
297
    fatal("Illegal username: $value - " . TBFieldErrorString());
298
299
300
301
302
303
304
305
306
307
308
309
}
$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;

310
311
312
313
314
315
316
317
318
319
#
# 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");
    }
320
    $userslice_id = $value;
321
322
}

323
#
324
# Profile.
325
#
326
# This is a safe lookup.
327
328
329
$value = $xmlparse->{'attribute'}->{"profile"}->{'value'};
$profile = APT_Profile->Lookup($value);
if (!defined($profile)) {
Leigh B Stoller's avatar
Leigh B Stoller committed
330
    fatal("No such profile: $value");
331
}
332
333
$profileid = $profile->profileid();
$version   = $profile->version();
334

335
#
336
# Optional rspec, as for a Parameterized Profile or a repo-based profile.
337
#
338
339
if (exists($xmlparse->{'attribute'}->{"rspec"})) {
    $rspecstr  = $xmlparse->{'attribute'}->{"rspec"}->{'value'};
340
}
341
342
else {
    $rspecstr  = $profile->CheckFirewall(!$localuser);
343
}
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
#
# Optional rspec and/or script, as for a repo-based profile.
#
if ($profile->repourl()) {
    if (exists($xmlparse->{'attribute'}->{"script"})) {
	$script = $xmlparse->{'attribute'}->{"script"}->{'value'};	

	if (! TBcheck_dbslot($script, "apt_profiles", "script",
			     TBDB_CHECKDBSLOT_WARN|TBDB_CHECKDBSLOT_ERROR)) {
	    fatal("Illegal script for repo-based profile");
	}
	if (!exists($xmlparse->{'attribute'}->{"reporef"})) {
	    fatal("Missing refspec for repository");
	}
    }
    if (exists($xmlparse->{'attribute'}->{"reporef"})) {
	if (!exists($xmlparse->{'attribute'}->{"repohash"})) {
	    fatal("Missing hash for repository");
	}
	$reporef  = $xmlparse->{'attribute'}->{"reporef"}->{'value'};
	$repohash = $xmlparse->{'attribute'}->{"repohash"}->{'value'};

	if (! TBcheck_dbslot($repohash, "apt_profiles", "repohash",
			     TBDB_CHECKDBSLOT_WARN|TBDB_CHECKDBSLOT_ERROR)) {
	    fatal("Illegal repository hash");
	}
	if (! TBcheck_dbslot($reporef, "default", "tinytext",
			     TBDB_CHECKDBSLOT_WARN|TBDB_CHECKDBSLOT_ERROR)) {
	    fatal("Illegal repository refspec");
	}
    }
375
376
377
378
379
    else {
	# Otherwise we are instantiating whatever the profile itself references.
	$reporef  = "refs/heads/master";
	$repohash = $profile->repohash();
    }
380
}
381

382
383
384
385
386
387
#
# Update rspec with site aggregate urns.
#
# SetSites will tell us if we must use stitcher.
#
my $needstitcher = 0;
388
389
390
391
my $tmp = APT_Profile::SetSites(\$rspecstr, $sitemap, $default_aggregate_urn,
				\@aggregate_urns, \$needstitcher, \$errmsg);
if ($tmp) {
    ($tmp < 0 ? fatal($errmsg) : UserError($errmsg));
392
}
393
394
395
396
397
398
399
#
# 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?");
}

400
401
# but do not override command line force.
$usestitcher = 1 if ($needstitcher);
402

403
404
#
# Look for datasets; need to verify that the datasets being referenced
405
406
# actually exists, in so far as we can check. We check permissions
# below when we generate the credentials.
407
408
#
$errmsg = "Bad dataset";
409
if (APT_Profile::CheckDatasets($rspecstr, \$errmsg)) {
410
411
412
    UserError($errmsg);
}

413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
#
# 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!");
	}
    }
434
435
    close($fh);
    unlink($keyfile);
436
}
437
438
chomp($sshkey)
    if (defined($sshkey));
439
440
441
442
443
444

#
# 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).
#
445
446
447
448
449
450
451
# 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) {
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
    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
468
    # Now this will work; without a certificate, above line would fail.
469
470
471
    if (defined($emulab_user)) {
	$geniuser = GeniUser::LocalUser->Create($emulab_user);
    }
472
473
474
475
}
else {
    $geniuser = GeniUser->Lookup($user_urn);

476
477
478
    #
    # In Utah, check for alternate SA
    #
479
    if (!defined($geniuser) && $MAINSITE) {
480
481
482
483
484
	foreach my $urn (@aggregate_urns) {
	    if ($urn ne $GUEST_URN) {
		UserError("Guests are not allowed to use cluster: $urn");
	    }
	}
485
486
	$user_urn = GeniHRN::Generate("aptlab.net", "user", $user_uid);
	$user_hrn = "aptlab.${user_uid}";
487
	$geniuser = GeniUser->LookupGuestOnly($user_urn);
488
489
    }
}
490
if (!defined($geniuser)) {
491
492
493
    if ($localuser) {
	fatal("Could not lookup local user $user_urn");
    }
494
    
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
    #
    # 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");
    }
512
513
514
515
516
517
518
519
    my $blob = {"urn"      => $user_urn,
		"hrn"      => $user_hrn,
		"email"    => $user_email,
		"showuuid" => 1};
    if ($MAINSITE) {
	$blob->{'useaptca'} = 1;
    }
    my $certificate = GeniCertificate->Create($blob);
520
521
522
523
524
525
526
527
528
529
    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
530
    # Setup browser ssh.
531
    #
532
533
534
    system("$SSHSETUP " . $geniuser->uuid());
    fatal("Could not create ssh key pair")
	if ($?);
535
536
537
538
}
my $user_uuid = $geniuser->uuid();
# So we know this user has dome something lately.
$geniuser->BumpActivity();
539

540
541
542
if ($localuser) {
    my $emulab_user = $geniuser->emulab_user();
    if ($emulab_user->IsNonLocal()) {
543
544
	#
	# A user created from a Geni certificate via geni-login. We
545
546
	# asked for the current ssh keys from the MA when they logged
	# in, but we ask again to make sure have the latest keys.
547
	#
548
	system("$UPDATEGENIUSER -s " . $emulab_user->uid());
549
	if (0) {
550
551
	    fatal("Could not update ssh keys for nonlocal user");
	}
552
553
554
555
556
557
	#
	# Check project membership, must be a member of at least one
	# valid project at the GPO portal.
	#
	system("$UPDATEGENIUSER -p " . $emulab_user->uid());
	if ($?) {
558
559
560
	    UserError("Could not get your project membership from your ".
		      "member authority. It is probably offline, please try ".
		      "again later.");
561
	}
Leigh B Stoller's avatar
Leigh B Stoller committed
562
563
	# Nonlocal users get the holding project can now join/create
	# real projects, so we get the pid passed in.
564
    }
565
    elsif (defined($sshkey) && !$emulab_user->LookupSSHKey($sshkey)) {
566
567
568
569
570
571
	#
	# 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.
	#
	
572
	#
573
574
575
576
	# 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
577
578
579
580
581
	# 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.
582
	#
583
584
585
	my ($fh, $keyfile) = tempfile(UNLINK => 0);
	print $fh $sshkey;

586
	if (system("$ADDPUBKEY -a -u $user_uid -f $keyfile")) {
587
588
589
590
591
	    fatal("Could not add new ssh pubkey");
	}
	close($fh);
	unlink($keyfile);
    }
592
593
594
595
596
597
598
599
600
601
602
603
604
605
    #
    # 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");
    }
606
607
608
609
610
611
612
613
614
615

    # 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
616
617
	fatal("No permission to create experiments in project ".
	      $project->pid());
618
619
    }
    $pid = $project->pid();
620

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

636
637
638
639
640
    # 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));
641
642
643
644
645
}
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
646
	# interface. We allow key reuse for existing users, see above.
647
648
649
650
651
	#
	$geniuser->DeleteKeys();
	$geniuser->AddKey($sshkey);
    }
    # Guest users get a holding project.
652
    $pid = $APT_HOLDINGPROJECT;
653
    $project = Project->Lookup($pid);
654
    $group = $project->GetProjectGroup();
Leigh B Stoller's avatar
Leigh B Stoller committed
655
    $gid = $group->gid();
656
657
658
    if (!defined($project)) {
	fatal("Project $pid does not exist");
    }
659
}
Leigh B Stoller's avatar
Leigh B Stoller committed
660
if (defined($profile->repourl())) {
661
662
663
664
665
666
667
668
    #
    # Make sure the repo is still accessible.
    #
    my $check = emutil::ExecQuiet("$MANAGEGITREPO check ".
				  "'" . $profile->repourl() . "'");
    if ($?) {
	UserError($check);
    }
Leigh B Stoller's avatar
Leigh B Stoller committed
669
670
671
672
673
    $tmp = APT_Profile::SetRepo(\$rspecstr, $profile->repourl(),
				$reporef, $repohash, $geniuser, \$errmsg);
    if ($tmp) {
	($tmp < 0 ? fatal($errmsg) : UserError($errmsg));
    }
674
675
}

676
677
678
#
# Now we know where to send to logs.
#
679
680
if (!$debug) {
    AddAuditInfo("cc", $project->LogsEmailAddress());
Leigh B Stoller's avatar
Leigh B Stoller committed
681
682
683
684
    if ($MAINSITE && $project->isEmulab()) {
	# Mostly people use the Cloudlab UI.
	AddAuditInfo("cc", "cloudlab-logs\@cloudlab.us");
    }
685
}
686

687
688
689
690
691
692
# Check for expired certs and speaksfor.
my $retval = APT_Geni::VerifyCredentials($geniuser, \$errmsg);
if ($retval) {
    ($retval < 0 ? fatal($errmsg) : UserError($errmsg));
}

693
694
695
# Generate the extra credentials that tells the backend this experiment
# can access the datasets.
my @dataset_credentials = ();
696
if (defined($profile)) {
697
    my $retval = CreateDatasetCreds($rspecstr, $project, $geniuser, 
698
699
700
701
				    \$errmsg, \@dataset_credentials);
    if ($retval) {
	($retval < 0 ? fatal($errmsg) : UserError($errmsg));
    }
702
703
}

704
#
705
706
707
#
# Now generate a slice registration and credential
#
708
my $safe_uid    = $user_uid; $safe_uid =~ s/_/-/;
709
710
my $slice_id    = (defined($userslice_id) ? $userslice_id :
		   $safe_uid . "-QV" . TBGetUniqueIndex('next_quickvm', 1));
711
712
713
my $slice_auth  = ($pid eq $gid ? $pid : "${pid}:${gid}");
my $slice_urn   = GeniHRN::Generate("${OURDOMAIN}:${slice_auth}",
				    "slice", $slice_id);
714
715
716
if (!defined($slice_urn)) {
    fatal("Could not generate a valid slice urn!");
}
717
my $slice_hrn   = "${PGENIDOMAIN}.${pid}.${slice_id}";
718
my $SERVER_NAME = (exists($ENV{"SERVER_NAME"}) ? $ENV{"SERVER_NAME"} : "");
719
720
721
722

#
# Make sure slice is unique. Probably retry here at some point. 
#
723
724
725
726
if (GeniSlice->Lookup($slice_hrn) || GeniSlice->Lookup($slice_urn) ||
    ($PROTOGENI_LOCALUSER &&
     (grep {$_ eq $DEFAULT_URN} @aggregate_urns) &&
     Experiment->Lookup($project->pid(), $userslice_id))) {
727
    if (defined($userslice_id)) {
728
	UserError("Experiment name already in use, please use another. If you ".
729
730
731
732
733
734
		  "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");
    }
735
}
736

737
738
739
740
741
742
743
744
745
746
747
748
749
#
# 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.
750
751
$slice = GeniSlice->Create($slice_certificate,
			   $geniuser, $sa_authority, undef, 1);
752
753
754
755
if (!defined($slice)) {
    $slice_certificate->Delete();
    fatal("Could not create new slice object for $slice_urn");
}
756
# These get quick expirations, unless it is a real user.
757
if ($slice->SetExpiration(time() + ($duration * 3600)) != 0) {
758
759
760
761
    fatal("Could not set the slice expiration for $slice_urn");
}
my $slice_uuid = $slice->uuid();

762
763
764
765
766
767
768
769
770
771
772
#
# 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.
#
773
my $alt_urn = GeniHRN::Generate("aptlab.net:${slice_auth}", "slice", $slice_id);
774
775
776
777
778
779
780
781
782
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,
783
               "keyfile"  => $privkeyfile,
784
785
786
787
788
789
	       "useaptca" => 1,
	       "showuuid" => 1};
my $alt_certificate = GeniCertificate->Create($altblob);
fatal("Could not create alt certificate")
    if (!defined($alt_certificate));

790
791
792
793
794
795
796
#
# Encrypt blocks.
#
$tmp = APT_Profile::EncryptBlocks(\$rspecstr, $alt_certificate, \$errmsg);
if ($tmp) {
    ($tmp < 0 ? fatal($errmsg) : UserError($errmsg));
}
797
798
799
800
801
802
803
804
805
806
807
808
809
810
#
# 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);
}
811

812
#
813
# Generate credentials we need.
814
#
815
my ($slice_credential, $speaksfor_credential) =
816
    APT_Geni::GenCredentials($slice, $geniuser, undef, 0);
817
818
819
if (! (defined($speaksfor_credential) &&
       defined($slice_credential))) {
    fatal("Could not generate credentials");
820
821
}

822
#
823
# Got this far, lets create a quickvm record.
824
#
825
my $quickvm_uuid = (defined($quickuuid) ? $quickuuid : NewUUID());
826
827
828
if (!defined($quickvm_uuid)) {
    fatal("Could not generate a new uuid");
}
829
my $blob = {'uuid'         => $quickvm_uuid,
830
	    'name'         => $slice_id,
831
832
833
834
835
836
837
	    'profile_id'   => $profileid,
	    'profile_version' => $version,
	    'slice_uuid'   => $slice_uuid,
	    'creator'      => $geniuser->uid(),
	    'creator_idx'  => $geniuser->idx(),
	    'creator_uuid' => $geniuser->uuid(),
	    'status'       => "created",
838
839
	    'servername'   => $SERVER_NAME,
	    'rspec'        => $rspecstr,
840
	    'cert'         => $alt_certificate->cert(),
841
	    'privkey'      => $alt_certificate->PrivKeyDelimited(),
842
};
843
844
845
846
847
if ($profile->repourl()) {
    if (defined($script)) {
	$blob->{"script"}  = $script;
    }
    $blob->{"repourl"}   = $profile->repourl();
848
849
    $blob->{"reporef"}   = $reporef;
    $blob->{"repohash"}  = $repohash;
850
}
851
852
853
if (defined($project)) {
    $blob->{"pid"}     = $project->pid();
    $blob->{"pid_idx"} = $project->pid_idx();
854
855
    $blob->{"gid"}     = $group->gid();
    $blob->{"gid_idx"} = $group->gid_idx();
856
}
857
858
859
860
861
862
863
864
865
866
867
868
#
# Create a webtask so that we can store additional information about
# the sliver while we wait.
#
$webtask = WebTask->Create($quickvm_uuid);
if (!defined($webtask)) {
    fatal("Could not create a webtask!");
}
$webtask_id = $webtask->task_id();
$webtask->AutoStore(1);
$blob->{"webtask_id"} = $webtask_id;

869
$errmsg = undef;
870
$instance = APT_Instance->Create($blob, \$errmsg);
Leigh B Stoller's avatar
Leigh B Stoller committed
871
if (!defined($instance)) {
872
    $webtask->Delete();
873
874
    fatal(defined($errmsg) ? $errmsg :
	  "Could not create instance record for $quickvm_uuid");
875
}
876

877
878
879
880
881
882
883
884
885
886
887
#
# 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");
}

888
889
890
# We use this list of references for ParRun below.
my @aggregate_list = ();
foreach my $aggregate_urn (@aggregate_urns) {
891
892
    my $aptaggregate = APT_Aggregate->Lookup($aggregate_urn);
    if (!defined($aptaggregate)) {
893
894
	$slice->Delete();
	$instance->Delete();
895
896
897
898
        UserError("$aggregate_urn is not a valid (known) aggregate");
    }
    # Check for disabled/adminonly aggregates.
    if ($aptaggregate->disabled()) {
899
900
	$slice->Delete();
	$instance->Delete();
901
902
        UserError("$aggregate_urn is currently offline, try again later");
    }
903
904
    if ($aptaggregate->adminonly() &&
        !(defined($this_user) && $this_user->IsAdmin())) {
905
906
	$slice->Delete();
	$instance->Delete();
907
908
        UserError("Only administrators may use $aggregate_urn");
    }
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
    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
924
925
# To keep stuff happy until multisite support finished.
$instance->Update({'aggregate_urn' => $aggregate_urns[0]});
926
927
# Officially used now. Even if it fails later.
$profile->BumpLastUsed();
Leigh B Stoller's avatar
Leigh B Stoller committed
928

929
930
931
932
933
934
935
936
937
938
939
940
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";
941
942
943
944
945

#
# Exit and let caller poll for status.
#
if (!$debug) {
946
    libaudit::AuditPrefork();
947
948
949
950
951
952
953
954
    my $child = fork();
    if ($child) {
	# Parent exits but avoid libaudit email.
	exit(0);
    }
    # All of the logging magic happens in here.
    libaudit::AuditFork();
}
955
# Bind the process id.
956
957
$webtask->SetProcessID($PID);

958
959
960
if ($usestitcher) {
    my $rval = RunStitcher();
    if ($rval) {
961
962
	$slice->UnLock();
	$instance->SetStatus("failed");
963
964
965
	$instance->RecordError($rval,
			       (defined($webtask->output()) ?
				$webtask->output() : ""));
966
	$webtask->Exited($rval);
967
	exit($rval);
968
    }
969
}
970
971
else {
    my $rval = CreateSlivers();
972
    #
973
    # We do not want email for most mapping errors, so look at the
974
975
976
977
    # return code to see if we want to kill the log (user will see the
    # error in the web ui). 
    #
    if ($rval) {
978
979
980
	$instance->RecordError($rval,
			       (defined($webtask->output()) ?
				$webtask->output() : ""));
981
982
	if ($rval == GENIRESPONSE_BADARGS ||
	    $rval == GENIRESPONSE_INSUFFICIENT_NODES ||
983
984
	    $rval == GENIRESPONSE_INSUFFICIENT_MEMORY ||
	    $rval == GENIRESPONSE_INSUFFICIENT_BANDWIDTH ||
985
	    $rval == GENIRESPONSE_NOSPACE ||
986
	    $rval == GENIRESPONSE_NO_MAPPING) {
987
988
989
990
991
992
	    AuditAbort()
		if (!$debug);
	}
	$webtask->Exited($rval);
	exit($rval);
    }
993
}
Leigh B Stoller's avatar
Leigh B Stoller committed
994
$instance->SetStatus("provisioned");
995
$instance->ComputeNodeCounts();
996
997

#
998
999
1000
# Now wait for the sliver to be ready, which means polling.
#
# Shorten default timeout.
1001
#
1002
Genixmlrpc->SetTimeout(60);
1003

1004
1005
1006
#
# Okay, fire off the waits for each aggregate
#
1007
my @return_codes = ();
1008
if (ParRun({"maxwaittime" => 99999, "maxchildren" => scalar(@aggregate_list)},
Leigh B Stoller's avatar
Leigh B Stoller committed
1009
1010
	    \@return_codes,
	    \&APT_Instance::Aggregate::WaitForSliver, @aggregate_list)) {
1011
1012
1013
1014
1015
    #
    # The parent caught a signal. Leave things intact so that we can
    # kill things cleanly later.
    #
    $slice->UnLock();
1016
1017
    print STDERR "Internal error in WaitForSlivers\n";
    $webtask->output("Internal error in WaitForSlivers");
1018
1019
1020
1021
    $instance->SetStatus("failed");
    $webtask->Exited(1);
    exit(-1);
}
1022
print "$slice_urn\n";
1023

1024
1025
1026
1027
1028
1029
1030
#
# If we were canceled, then none of the stuff below matters, we
# are going to do a terminate.
#
if ($instance->IsCanceled()) {
    $slice->UnLock();

1031
1032
1033
1034
    #
    # If someone gets the lock, this will fail. But the apt daemon will
    # see the canceled flag too and fire off a termination. 
    #
1035
1036
1037
1038
    system("$MANAGEINSTANCE -t $webtask_id terminate $quickvm_uuid");
    exit(0);
}

1039
1040
1041
# Count up nodes running a startup service.
my $startuprunning = 0;

1042
1043
1044
1045
1046
1047
1048
1049
1050
#
# 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();
1051
1052
1053
1054
1055
1056
    print $aggobj->aggregate_urn() . "\n";
    if ($code) {
	$failed++;
	print "WaitforSliver Failure!\n";
	if (defined($aggobj->webtask()->output())) {
	    $webtask->output($aggobj->webtask()->output());
1057
	    $webtask->Exited($aggobj->webtask()->exitcode());
1058
1059
1060
1061
1062
	    print $aggobj->webtask()->output() . "\n";
	}
	else {
	    $webtask->output("WaitforSliver Failure at " .
			     $aggobj->aggregate_urn());
1063
	    $webtask->Exited(1);
1064
	}
1065
1066
1067
	# Promote the log up to the instance so that so its easy to find.
	$instance->SetPublicURL($aggobj->public_url())
	    if (defined($aggobj->public_url()));
1068
    }
Leigh B Stoller's avatar
Leigh B Stoller committed
1069
    else {
1070
	my $sliverstatus = $aggobj->SliverStatus();
Leigh B Stoller's avatar
Leigh B Stoller committed
1071

1072
	print Dumper($sliverstatus);
Leigh B Stoller's avatar
Leigh B Stoller committed
1073

1074
	foreach my $status (values(%{ $sliverstatus })) {
Leigh B Stoller's avatar
Leigh B Stoller committed
1075
1076
	    # Startup command is still running.
	    $startuprunning++
1077
1078
		if (exists($status->{"sliver_data"}->{'execute_state'}) &&
		    $status->{"sliver_data"}->{'execute_state'} ne "exited");
Leigh B Stoller's avatar
Leigh B Stoller committed
1079
1080
	}
    }
1081
1082
    if (defined($aggobj->public_url())) {
	print $aggobj->public_url() . "\n";
1083
    }
1084
1085
    print "\n" . $aggobj->manifest() . "\n\n";
    print "------------------------------------------------------------\n\n";
1086
}
1087
$slice->UnLock();
1088

1089
if ($failed) {