create_instance.in 47.5 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 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 $MANAGEDATASET = "$TB/bin/manage_dataset";
93
my $DEFAULT_URN   = "urn:publicid:IDN+$OURDOMAIN+authority+cm";
94
my $GUEST_URN     = "urn:publicid:IDN+apt.emulab.net+authority+cm";
95
my $PROTOGENI_LOCALUSER= @PROTOGENI_LOCALUSER@;
96
my $default_aggregate_urn = $DEFAULT_URN;
97
98
99
100
101
102
103
104

# 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
#
105
$| = 1;
106
107
108

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

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

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

180
181
182
183
184
185
186
187
188
189
190
    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");
191
192
    }

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

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

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

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

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

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

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

#
# 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
274
if (! TBcheck_dbslot($value, "users", "uid",
275
		     TBDB_CHECKDBSLOT_WARN|TBDB_CHECKDBSLOT_ERROR)) {
Leigh B Stoller's avatar
Leigh B Stoller committed
276
    fatal("Illegal username: $value - " . TBFieldErrorString());
277
278
279
280
281
282
283
284
285
286
287
288
}
$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;

289
290
291
292
293
294
295
296
297
298
#
# 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");
    }
299
    $userslice_id = $value;
300
301
}

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

314
#
315
# Optional rspec, as for a Parameterized Profile or a repo-based profile.
316
#
317
318
if (exists($xmlparse->{'attribute'}->{"rspec"})) {
    $rspecstr  = $xmlparse->{'attribute'}->{"rspec"}->{'value'};
319
}
320
321
else {
    $rspecstr  = $profile->CheckFirewall(!$localuser);
322
}
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
#
# 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");
	}
    }
354
355
356
357
358
    else {
	# Otherwise we are instantiating whatever the profile itself references.
	$reporef  = "refs/heads/master";
	$repohash = $profile->repohash();
    }
359
}
360

361
362
363
364
365
366
#
# Update rspec with site aggregate urns.
#
# SetSites will tell us if we must use stitcher.
#
my $needstitcher = 0;
367
368
369
370
my $tmp = APT_Profile::SetSites(\$rspecstr, $sitemap, $default_aggregate_urn,
				\@aggregate_urns, \$needstitcher, \$errmsg);
if ($tmp) {
    ($tmp < 0 ? fatal($errmsg) : UserError($errmsg));
371
}
372
373
374
375
376
377
378
#
# 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?");
}

379
380
# but do not override command line force.
$usestitcher = 1 if ($needstitcher);
381

382
383
#
# Look for datasets; need to verify that the datasets being referenced
384
385
# actually exists, in so far as we can check. We check permissions
# below when we generate the credentials.
386
387
#
$errmsg = "Bad dataset";
388
if (APT_Profile::CheckDatasets($rspecstr, \$errmsg)) {
389
390
391
    UserError($errmsg);
}

392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
#
# 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!");
	}
    }
413
414
    close($fh);
    unlink($keyfile);
415
}
416
417
chomp($sshkey)
    if (defined($sshkey));
418
419
420
421
422
423

#
# 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).
#
424
425
426
427
428
429
430
# 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) {
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
    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
447
    # Now this will work; without a certificate, above line would fail.
448
449
450
    if (defined($emulab_user)) {
	$geniuser = GeniUser::LocalUser->Create($emulab_user);
    }
451
452
453
454
}
else {
    $geniuser = GeniUser->Lookup($user_urn);

455
456
457
    #
    # In Utah, check for alternate SA
    #
458
    if (!defined($geniuser) && $MAINSITE) {
459
460
461
462
463
	foreach my $urn (@aggregate_urns) {
	    if ($urn ne $GUEST_URN) {
		UserError("Guests are not allowed to use cluster: $urn");
	    }
	}
464
465
	$user_urn = GeniHRN::Generate("aptlab.net", "user", $user_uid);
	$user_hrn = "aptlab.${user_uid}";
466
	$geniuser = GeniUser->LookupGuestOnly($user_urn);
467
468
    }
}
469
if (!defined($geniuser)) {
470
471
472
    if ($localuser) {
	fatal("Could not lookup local user $user_urn");
    }
473
    
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
    #
    # 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");
    }
491
492
493
494
495
496
497
498
    my $blob = {"urn"      => $user_urn,
		"hrn"      => $user_hrn,
		"email"    => $user_email,
		"showuuid" => 1};
    if ($MAINSITE) {
	$blob->{'useaptca'} = 1;
    }
    my $certificate = GeniCertificate->Create($blob);
499
500
501
502
503
504
505
506
507
508
    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
509
    # Setup browser ssh.
510
    #
511
512
513
    system("$SSHSETUP " . $geniuser->uuid());
    fatal("Could not create ssh key pair")
	if ($?);
514
515
516
517
}
my $user_uuid = $geniuser->uuid();
# So we know this user has dome something lately.
$geniuser->BumpActivity();
518

519
520
521
if ($localuser) {
    my $emulab_user = $geniuser->emulab_user();
    if ($emulab_user->IsNonLocal()) {
522
523
	#
	# A user created from a Geni certificate via geni-login. We
524
525
	# asked for the current ssh keys from the MA when they logged
	# in, but we ask again to make sure have the latest keys.
526
	#
527
	system("$UPDATEGENIUSER -s " . $emulab_user->uid());
528
	if (0) {
529
530
	    fatal("Could not update ssh keys for nonlocal user");
	}
531
532
533
534
535
536
	#
	# Check project membership, must be a member of at least one
	# valid project at the GPO portal.
	#
	system("$UPDATEGENIUSER -p " . $emulab_user->uid());
	if ($?) {
537
538
539
	    UserError("Could not get your project membership from your ".
		      "member authority. It is probably offline, please try ".
		      "again later.");
540
	}
Leigh B Stoller's avatar
Leigh B Stoller committed
541
542
	# Nonlocal users get the holding project can now join/create
	# real projects, so we get the pid passed in.
543
    }
544
    elsif (defined($sshkey) && !$emulab_user->LookupSSHKey($sshkey)) {
545
546
547
548
549
550
	#
	# 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.
	#
	
551
	#
552
553
554
555
	# 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
556
557
558
559
560
	# 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.
561
	#
562
563
564
	my ($fh, $keyfile) = tempfile(UNLINK => 0);
	print $fh $sshkey;

565
	if (system("$ADDPUBKEY -a -u $user_uid -f $keyfile")) {
566
567
568
569
570
	    fatal("Could not add new ssh pubkey");
	}
	close($fh);
	unlink($keyfile);
    }
571
572
573
574
575
576
577
578
579
580
581
582
583
584
    #
    # 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");
    }
585
586
587
588
589
590
591
592
593
594

    # 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
595
596
	fatal("No permission to create experiments in project ".
	      $project->pid());
597
598
    }
    $pid = $project->pid();
599

600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
    # 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();

615
616
617
618
619
    # 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));
620
621
622
623
624
}
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
625
	# interface. We allow key reuse for existing users, see above.
626
627
628
629
630
	#
	$geniuser->DeleteKeys();
	$geniuser->AddKey($sshkey);
    }
    # Guest users get a holding project.
631
    $pid = $APT_HOLDINGPROJECT;
632
    $project = Project->Lookup($pid);
633
    $group = $project->GetProjectGroup();
Leigh B Stoller's avatar
Leigh B Stoller committed
634
    $gid = $group->gid();
635
636
637
    if (!defined($project)) {
	fatal("Project $pid does not exist");
    }
638
}
Leigh B Stoller's avatar
Leigh B Stoller committed
639
640
641
642
643
644
if (defined($profile->repourl())) {
    $tmp = APT_Profile::SetRepo(\$rspecstr, $profile->repourl(),
				$reporef, $repohash, $geniuser, \$errmsg);
    if ($tmp) {
	($tmp < 0 ? fatal($errmsg) : UserError($errmsg));
    }
645
646
}

647
648
649
#
# Now we know where to send to logs.
#
650
651
if (!$debug) {
    AddAuditInfo("cc", $project->LogsEmailAddress());
Leigh B Stoller's avatar
Leigh B Stoller committed
652
653
654
655
    if ($MAINSITE && $project->isEmulab()) {
	# Mostly people use the Cloudlab UI.
	AddAuditInfo("cc", "cloudlab-logs\@cloudlab.us");
    }
656
}
657

658
659
660
661
662
663
# Check for expired certs and speaksfor.
my $retval = APT_Geni::VerifyCredentials($geniuser, \$errmsg);
if ($retval) {
    ($retval < 0 ? fatal($errmsg) : UserError($errmsg));
}

664
665
666
# Generate the extra credentials that tells the backend this experiment
# can access the datasets.
my @dataset_credentials = ();
667
if (defined($profile)) {
668
    my $retval = CreateDatasetCreds($rspecstr, $project, $geniuser, 
669
670
671
672
				    \$errmsg, \@dataset_credentials);
    if ($retval) {
	($retval < 0 ? fatal($errmsg) : UserError($errmsg));
    }
673
674
}

675
#
676
677
678
#
# Now generate a slice registration and credential
#
679
my $safe_uid    = $user_uid; $safe_uid =~ s/_/-/;
680
681
my $slice_id    = (defined($userslice_id) ? $userslice_id :
		   $safe_uid . "-QV" . TBGetUniqueIndex('next_quickvm', 1));
682
683
684
my $slice_auth  = ($pid eq $gid ? $pid : "${pid}:${gid}");
my $slice_urn   = GeniHRN::Generate("${OURDOMAIN}:${slice_auth}",
				    "slice", $slice_id);
685
my $slice_hrn   = "${PGENIDOMAIN}.${pid}.${slice_id}";
686
my $SERVER_NAME = (exists($ENV{"SERVER_NAME"}) ? $ENV{"SERVER_NAME"} : "");
687
688
689
690

#
# Make sure slice is unique. Probably retry here at some point. 
#
691
692
693
694
if (GeniSlice->Lookup($slice_hrn) || GeniSlice->Lookup($slice_urn) ||
    ($PROTOGENI_LOCALUSER &&
     (grep {$_ eq $DEFAULT_URN} @aggregate_urns) &&
     Experiment->Lookup($project->pid(), $userslice_id))) {
695
    if (defined($userslice_id)) {
696
	UserError("Experiment name already in use, please use another. If you ".
697
698
699
700
701
702
		  "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");
    }
703
}
704

705
706
707
708
709
710
711
712
713
714
715
716
717
#
# 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.
718
719
$slice = GeniSlice->Create($slice_certificate,
			   $geniuser, $sa_authority, undef, 1);
720
721
722
723
if (!defined($slice)) {
    $slice_certificate->Delete();
    fatal("Could not create new slice object for $slice_urn");
}
724
725
# These get quick expirations, unless it is a real user.
if ($slice->SetExpiration(time() + (($localuser ? 16 : 3) * 3600)) != 0) {
726
727
728
729
    fatal("Could not set the slice expiration for $slice_urn");
}
my $slice_uuid = $slice->uuid();

730
731
732
733
734
735
736
737
738
739
740
#
# 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.
#
741
my $alt_urn = GeniHRN::Generate("aptlab.net:${slice_auth}", "slice", $slice_id);
742
743
744
745
746
747
748
749
750
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,
751
               "keyfile"  => $privkeyfile,
752
753
754
755
756
757
	       "useaptca" => 1,
	       "showuuid" => 1};
my $alt_certificate = GeniCertificate->Create($altblob);
fatal("Could not create alt certificate")
    if (!defined($alt_certificate));

758
759
760
761
762
763
764
#
# Encrypt blocks.
#
$tmp = APT_Profile::EncryptBlocks(\$rspecstr, $alt_certificate, \$errmsg);
if ($tmp) {
    ($tmp < 0 ? fatal($errmsg) : UserError($errmsg));
}
765
766
767
768
769
770
771
772
773
774
775
776
777
778
#
# 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);
}
779

780
#
781
# Generate credentials we need.
782
#
783
my ($slice_credential, $speaksfor_credential) =
784
    APT_Geni::GenCredentials($slice, $geniuser, undef, 0);
785
786
787
if (! (defined($speaksfor_credential) &&
       defined($slice_credential))) {
    fatal("Could not generate credentials");
788
789
}

790
#
791
# Got this far, lets create a quickvm record.
792
#
793
my $quickvm_uuid = (defined($quickuuid) ? $quickuuid : NewUUID());
794
795
796
if (!defined($quickvm_uuid)) {
    fatal("Could not generate a new uuid");
}
797
my $blob = {'uuid'         => $quickvm_uuid,
798
	    'name'         => $slice_id,
799
800
801
802
803
804
805
	    'profile_id'   => $profileid,
	    'profile_version' => $version,
	    'slice_uuid'   => $slice_uuid,
	    'creator'      => $geniuser->uid(),
	    'creator_idx'  => $geniuser->idx(),
	    'creator_uuid' => $geniuser->uuid(),
	    'status'       => "created",
806
807
	    'servername'   => $SERVER_NAME,
	    'rspec'        => $rspecstr,
808
	    'cert'         => $alt_certificate->cert(),
809
	    'privkey'      => $alt_certificate->PrivKeyDelimited(),
810
};
811
812
813
814
815
if ($profile->repourl()) {
    if (defined($script)) {
	$blob->{"script"}  = $script;
    }
    $blob->{"repourl"}   = $profile->repourl();
816
817
    $blob->{"reporef"}   = $reporef;
    $blob->{"repohash"}  = $repohash;
818
}
819
820
821
if (defined($project)) {
    $blob->{"pid"}     = $project->pid();
    $blob->{"pid_idx"} = $project->pid_idx();
822
823
    $blob->{"gid"}     = $group->gid();
    $blob->{"gid_idx"} = $group->gid_idx();
824
}
825
826
827
828
829
830
831
832
833
834
835
836
#
# 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;

837
$errmsg = undef;
838
$instance = APT_Instance->Create($blob, \$errmsg);
Leigh B Stoller's avatar
Leigh B Stoller committed
839
if (!defined($instance)) {
840
    $webtask->Delete();
841
842
    fatal(defined($errmsg) ? $errmsg :
	  "Could not create instance record for $quickvm_uuid");
843
}
844

845
846
847
848
849
850
851
852
853
854
855
#
# 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");
}

856
857
858
# We use this list of references for ParRun below.
my @aggregate_list = ();
foreach my $aggregate_urn (@aggregate_urns) {
859
860
861
862
863
864
865
866
    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");
    }
867
868
    if ($aptaggregate->adminonly() &&
        !(defined($this_user) && $this_user->IsAdmin())) {
869
870
        UserError("Only administrators may use $aggregate_urn");
    }
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
    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
886
887
888
# To keep stuff happy until multisite support finished.
$instance->Update({'aggregate_urn' => $aggregate_urns[0]});

889
890
891
892
893
894
895
896
897
898
899
900
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";
901
902
903
904
905

#
# Exit and let caller poll for status.
#
if (!$debug) {
906
    libaudit::AuditPrefork();
907
908
909
910
911
912
913
914
    my $child = fork();
    if ($child) {
	# Parent exits but avoid libaudit email.
	exit(0);
    }
    # All of the logging magic happens in here.
    libaudit::AuditFork();
}
915
# Bind the process id.
916
917
$webtask->SetProcessID($PID);

918
919
920
if ($usestitcher) {
    my $rval = RunStitcher();
    if ($rval) {
921
922
	$slice->UnLock();
	$instance->SetStatus("failed");
923
924
925
	$instance->RecordError($rval,
			       (defined($webtask->output()) ?
				$webtask->output() : ""));
926
	$webtask->Exited($rval);
927
	exit($rval);
928
    }
929
}
930
931
else {
    my $rval = CreateSlivers();
932
    #
933
    # We do not want email for most mapping errors, so look at the
934
935
936
937
    # return code to see if we want to kill the log (user will see the
    # error in the web ui). 
    #
    if ($rval) {
938
939
940
	$instance->RecordError($rval,
			       (defined($webtask->output()) ?
				$webtask->output() : ""));
941
942
	if ($rval == GENIRESPONSE_BADARGS ||
	    $rval == GENIRESPONSE_INSUFFICIENT_NODES ||
943
944
945
	    $rval == GENIRESPONSE_INSUFFICIENT_MEMORY ||
	    $rval == GENIRESPONSE_INSUFFICIENT_BANDWIDTH ||
	    $rval == GENIRESPONSE_NO_MAPPING) {
946
947
948
949
950
951
	    AuditAbort()
		if (!$debug);
	}
	$webtask->Exited($rval);
	exit($rval);
    }
952
}
Leigh B Stoller's avatar
Leigh B Stoller committed
953
$instance->SetStatus("provisioned");
954
$instance->ComputeNodeCounts();
955
956

#
957
958
959
# Now wait for the sliver to be ready, which means polling.
#
# Shorten default timeout.
960
#
961
Genixmlrpc->SetTimeout(60);
962

963
964
965
#
# Okay, fire off the waits for each aggregate
#
966
my @return_codes = ();
967
if (ParRun({"maxwaittime" => 99999, "maxchildren" => scalar(@aggregate_list)},
Leigh B Stoller's avatar
Leigh B Stoller committed
968
969
	    \@return_codes,
	    \&APT_Instance::Aggregate::WaitForSliver, @aggregate_list)) {
970
971
972
973
974
    #
    # The parent caught a signal. Leave things intact so that we can
    # kill things cleanly later.
    #
    $slice->UnLock();
975
976
    print STDERR "Internal error in WaitForSlivers\n";
    $webtask->output("Internal error in WaitForSlivers");
977
978
979
980
    $instance->SetStatus("failed");
    $webtask->Exited(1);
    exit(-1);
}
981
print "$slice_urn\n";
982

983
984
985
986
987
988
989
#
# If we were canceled, then none of the stuff below matters, we
# are going to do a terminate.
#
if ($instance->IsCanceled()) {
    $slice->UnLock();

990
991
992
993
    #
    # If someone gets the lock, this will fail. But the apt daemon will
    # see the canceled flag too and fire off a termination. 
    #
994
995
996
997
    system("$MANAGEINSTANCE -t $webtask_id terminate $quickvm_uuid");
    exit(0);
}

998
999
1000
# Count up nodes running a startup service.
my $startuprunning = 0;

1001
1002
1003
1004
1005
1006
1007
1008
1009
#
# 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();
1010
1011
1012
1013
1014
1015
    print $aggobj->aggregate_urn() . "\n";
    if ($code) {
	$failed++;
	print "WaitforSliver Failure!\n";
	if (defined($aggobj->webtask()->output())) {
	    $webtask->output($aggobj->webtask()->output());
1016
	    $webtask->Exited($aggobj->webtask()->exitcode());
1017
1018
1019
1020
1021
	    print $aggobj->webtask()->output() . "\n";
	}
	else {
	    $webtask->output("WaitforSliver Failure at " .
			     $aggobj->aggregate_urn());
1022
	    $webtask->Exited(1);
1023
	}
1024
1025
1026
	# Promote the log up to the instance so that so its easy to find.
	$instance->SetPublicURL($aggobj->public_url())
	    if (defined($aggobj->public_url()));
1027
    }
Leigh B Stoller's avatar
Leigh B Stoller committed
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
    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");
	}
    }
1040
1041
    if (defined($aggobj->public_url())) {
	print $aggobj->public_url() . "\n";
1042
    }
1043
1044
    print "\n" . $aggobj->manifest() . "\n\n";
    print "------------------------------------------------------------\n\n";
1045
}
1046
$slice->UnLock();
1047

1048
if ($failed) {
1049
1050
1051
1052
1053
1054
    if ($ignorefailures) {
        $instance->SetStatus("ready");
    }
    else {
        $instance->SetStatus("failed");
    }
1055
    # Webtask exit status set above.
1056
1057
1058
    $instance->RecordError($webtask->exitcode(),
			   (defined($webtask->output()) ?
			    $webtask->output() : ""));
1059
1060
1061
}
else {
    $instance->SetStatus("ready");
Leigh B Stoller's avatar
Leigh B Stoller committed
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074

    #
    # 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);
    }
1075
}
1076
1077
exit(0);

1078
1079
1080
1081
1082
#
# Create credentials to access datasets.
#
sub CreateDatasetCreds($$$$$)
{
1083
    my ($xml, $project, $geniuser, $pmsg, $pref) = @_;
1084
1085
1086
1087
1088
1089
1090
1091
    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()) {
1092
1093
1094
	my $manager_urn  = GetManagerId($ref);
	
	foreach my $blockref (GeniXML::FindNodesNS("n:blockstore", $ref,
1095
				   $GeniXML::EMULAB_NS)->get_nodelist()) {
1096
1097
	    my $dataset_id = GeniXML::GetText("persistent", $blockref);
	    if (!defined($dataset_id)) {
1098
		# persistent is deprecated.
1099
		$dataset_id = GeniXML::GetText("dataset", $blockref);
1100
	    }
1101
1102
1103
1104
1105
1106

	    #
	    # We only care about datasets here, we let the backend
	    # do the error checking on ephemeral blockstores.
	    #
	    next
1107
1108
1109
1110
1111
1112
		if (!defined($dataset_id));

	    my $class = GeniXML::GetText("class", $blockref);
	    if (!defined($class)) {
		$class = "remote";
	    }
1113
1114
	    # Image backed referenced by URL. No checking since the
	    # image has to be global anyway. Needs more thought.
1115
	    next
1116
1117
1118
1119
		if ($class eq "local" && $dataset_id =~ /^(http|https):/);

	    my $dataset_urn = GeniHRN->new($dataset_id);
	    my $dataset = APT_Dataset->LookupByRemoteURN($dataset_urn);
1120
	    if (!defined($dataset)) {
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
		if ($dataset_urn->domain() eq $OURDOMAIN) {
		    #
		    # Local image backed dataset or lease.
		    #
		    my ($image,$lease);
		    my $pid = $dataset_urn->project();
		    my $id  = $dataset_urn->id();

		    if ($dataset_urn->type() eq "imdataset") {
			$image = Image->Lookup($pid, $id);
			if ($image && !$image->isdataset()) {
			    $$pmsg = "$dataset_urn is an image not a dataset ";
			    return 1;
			}
			#
			# Do a partial permission check here to catch
			# errors early.  The CM will do its own check
			# of course.
			#
			if (!$image->global() &&
			    $PROTOGENI_LOCALUSER && $geniuser->IsLocal() &&
			    !$image->AccessCheck($geniuser->emulab_user(),
						   TB_IMAGEID_ACCESS())) {
			    $$pmsg = "No permission to use $dataset_urn";
			    return 1;
1146
1147
			}
		    }
1148
1149
1150
1151
1152
1153
1154
1155
1156
		    else {
			$lease = Lease->Lookup($pid, $id);
		    }
		    # We cannot generate a credential for "legacy" datasets.
		    # So if it is not global, it cannot be transferred. Maybe
		    # this is okay, we will find out. We could generate a
		    # credential if we needed to.
		    next
			if ($image || $lease);
1157
		}
1158
1159
		$$pmsg = "Dataset '$dataset_urn' does not exist";
		return 1;
1160
	    }
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
	    #
	    # We do not need a credential for leases, only real users
	    # can use those, and so standard emulab permission checks
	    # are applied at the CM.
	    #
	    next
		if ($dataset->type() ne "imdataset");

	    #
	    # For image backed datasets, we need to send along a credential
	    # that allows the remote CM to securely download the dataset if
	    # it does not already have it. To do that we need to send it a
	    # credential from the CM where the dataset lives. We do that by
	    # requesting a credential, and delegating it to the target CM.
	    #
	    my $pid = $dataset->pid();
	    my $id  = $dataset->dataset_id();
	    my $cmd = "$MANAGEDATASET getcredential -a $manager_urn $pid/$id";
	    my $credential = `$cmd`;
	    if ($?) {
		$$pmsg = "Could not generate credential for $dataset_urn";
1182
1183
		return -1;
	    }
1184
	    push(@credentials, $credential);
1185
1186
1187
1188
1189
1190
	}
    }
    @$pref = @credentials;
    return 0;
}

1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
#
# 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
1208
    $cmurl = APT_Instance::devurl($cmurl);
1209

1210
1211
    Genixmlrpc->SetTimeout(900);

1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
    #
    # 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,
1225
				     "keys"        => $sshkeys,
1226
				     "credentials" =>
1227
1228
1229
					 [$slice_credential->asString(),
					  $speaksfor_credential->asString(),
					  @dataset_credentials
1230
					 ],