create_instance.in 48.2 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
my $maxduration = 3; # Hours. For guests. Need to make this a site variable.
64
65
my @aggregate_urns = ();

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

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

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

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

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

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

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

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

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

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

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

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

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

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

273
274
275
276
277
278
279
280
281
282
# User specified duration.
$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)");
}

283
284
285
286
#
# 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
287
if (! TBcheck_dbslot($value, "users", "uid",
288
		     TBDB_CHECKDBSLOT_WARN|TBDB_CHECKDBSLOT_ERROR)) {
Leigh B Stoller's avatar
Leigh B Stoller committed
289
    fatal("Illegal username: $value - " . TBFieldErrorString());
290
291
292
293
294
295
296
297
298
299
300
301
}
$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;

302
303
304
305
306
307
308
309
310
311
#
# 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");
    }
312
    $userslice_id = $value;
313
314
}

315
#
316
# Profile.
317
#
318
# This is a safe lookup.
319
320
321
$value = $xmlparse->{'attribute'}->{"profile"}->{'value'};
$profile = APT_Profile->Lookup($value);
if (!defined($profile)) {
Leigh B Stoller's avatar
Leigh B Stoller committed
322
    fatal("No such profile: $value");
323
}
324
325
$profileid = $profile->profileid();
$version   = $profile->version();
326

327
#
328
# Optional rspec, as for a Parameterized Profile or a repo-based profile.
329
#
330
331
if (exists($xmlparse->{'attribute'}->{"rspec"})) {
    $rspecstr  = $xmlparse->{'attribute'}->{"rspec"}->{'value'};
332
}
333
334
else {
    $rspecstr  = $profile->CheckFirewall(!$localuser);
335
}
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
#
# 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");
	}
    }
367
368
369
370
371
    else {
	# Otherwise we are instantiating whatever the profile itself references.
	$reporef  = "refs/heads/master";
	$repohash = $profile->repohash();
    }
372
}
373

374
375
376
377
378
379
#
# Update rspec with site aggregate urns.
#
# SetSites will tell us if we must use stitcher.
#
my $needstitcher = 0;
380
381
382
383
my $tmp = APT_Profile::SetSites(\$rspecstr, $sitemap, $default_aggregate_urn,
				\@aggregate_urns, \$needstitcher, \$errmsg);
if ($tmp) {
    ($tmp < 0 ? fatal($errmsg) : UserError($errmsg));
384
}
385
386
387
388
389
390
391
#
# 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?");
}

392
393
# but do not override command line force.
$usestitcher = 1 if ($needstitcher);
394

395
396
#
# Look for datasets; need to verify that the datasets being referenced
397
398
# actually exists, in so far as we can check. We check permissions
# below when we generate the credentials.
399
400
#
$errmsg = "Bad dataset";
401
if (APT_Profile::CheckDatasets($rspecstr, \$errmsg)) {
402
403
404
    UserError($errmsg);
}

405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
#
# 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!");
	}
    }
426
427
    close($fh);
    unlink($keyfile);
428
}
429
430
chomp($sshkey)
    if (defined($sshkey));
431
432
433
434
435
436

#
# 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).
#
437
438
439
440
441
442
443
# 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) {
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
    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
460
    # Now this will work; without a certificate, above line would fail.
461
462
463
    if (defined($emulab_user)) {
	$geniuser = GeniUser::LocalUser->Create($emulab_user);
    }
464
465
466
467
}
else {
    $geniuser = GeniUser->Lookup($user_urn);

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

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

578
	if (system("$ADDPUBKEY -a -u $user_uid -f $keyfile")) {
579
580
581
582
583
	    fatal("Could not add new ssh pubkey");
	}
	close($fh);
	unlink($keyfile);
    }
584
585
586
587
588
589
590
591
592
593
594
595
596
597
    #
    # 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");
    }
598
599
600
601
602
603
604
605
606
607

    # 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
608
609
	fatal("No permission to create experiments in project ".
	      $project->pid());
610
611
    }
    $pid = $project->pid();
612

613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
    # 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();

628
629
630
631
632
    # 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));
633
634
635
636
637
}
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
638
	# interface. We allow key reuse for existing users, see above.
639
640
641
642
643
	#
	$geniuser->DeleteKeys();
	$geniuser->AddKey($sshkey);
    }
    # Guest users get a holding project.
644
    $pid = $APT_HOLDINGPROJECT;
645
    $project = Project->Lookup($pid);
646
    $group = $project->GetProjectGroup();
Leigh B Stoller's avatar
Leigh B Stoller committed
647
    $gid = $group->gid();
648
649
650
    if (!defined($project)) {
	fatal("Project $pid does not exist");
    }
651
}
Leigh B Stoller's avatar
Leigh B Stoller committed
652
if (defined($profile->repourl())) {
653
654
655
656
657
658
659
660
    #
    # 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
661
662
663
664
665
    $tmp = APT_Profile::SetRepo(\$rspecstr, $profile->repourl(),
				$reporef, $repohash, $geniuser, \$errmsg);
    if ($tmp) {
	($tmp < 0 ? fatal($errmsg) : UserError($errmsg));
    }
666
667
}

668
669
670
#
# Now we know where to send to logs.
#
671
672
if (!$debug) {
    AddAuditInfo("cc", $project->LogsEmailAddress());
Leigh B Stoller's avatar
Leigh B Stoller committed
673
674
675
676
    if ($MAINSITE && $project->isEmulab()) {
	# Mostly people use the Cloudlab UI.
	AddAuditInfo("cc", "cloudlab-logs\@cloudlab.us");
    }
677
}
678

679
680
681
682
683
684
# Check for expired certs and speaksfor.
my $retval = APT_Geni::VerifyCredentials($geniuser, \$errmsg);
if ($retval) {
    ($retval < 0 ? fatal($errmsg) : UserError($errmsg));
}

685
686
687
# Generate the extra credentials that tells the backend this experiment
# can access the datasets.
my @dataset_credentials = ();
688
if (defined($profile)) {
689
    my $retval = CreateDatasetCreds($rspecstr, $project, $geniuser, 
690
691
692
693
				    \$errmsg, \@dataset_credentials);
    if ($retval) {
	($retval < 0 ? fatal($errmsg) : UserError($errmsg));
    }
694
695
}

696
#
697
698
699
#
# Now generate a slice registration and credential
#
700
my $safe_uid    = $user_uid; $safe_uid =~ s/_/-/;
701
702
my $slice_id    = (defined($userslice_id) ? $userslice_id :
		   $safe_uid . "-QV" . TBGetUniqueIndex('next_quickvm', 1));
703
704
705
my $slice_auth  = ($pid eq $gid ? $pid : "${pid}:${gid}");
my $slice_urn   = GeniHRN::Generate("${OURDOMAIN}:${slice_auth}",
				    "slice", $slice_id);
706
my $slice_hrn   = "${PGENIDOMAIN}.${pid}.${slice_id}";
707
my $SERVER_NAME = (exists($ENV{"SERVER_NAME"}) ? $ENV{"SERVER_NAME"} : "");
708
709
710
711

#
# Make sure slice is unique. Probably retry here at some point. 
#
712
713
714
715
if (GeniSlice->Lookup($slice_hrn) || GeniSlice->Lookup($slice_urn) ||
    ($PROTOGENI_LOCALUSER &&
     (grep {$_ eq $DEFAULT_URN} @aggregate_urns) &&
     Experiment->Lookup($project->pid(), $userslice_id))) {
716
    if (defined($userslice_id)) {
717
	UserError("Experiment name already in use, please use another. If you ".
718
719
720
721
722
723
		  "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");
    }
724
}
725

726
727
728
729
730
731
732
733
734
735
736
737
738
#
# 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.
739
740
$slice = GeniSlice->Create($slice_certificate,
			   $geniuser, $sa_authority, undef, 1);
741
742
743
744
if (!defined($slice)) {
    $slice_certificate->Delete();
    fatal("Could not create new slice object for $slice_urn");
}
745
# These get quick expirations, unless it is a real user.
746
if ($slice->SetExpiration(time() + ($duration * 3600)) != 0) {
747
748
749
750
    fatal("Could not set the slice expiration for $slice_urn");
}
my $slice_uuid = $slice->uuid();

751
752
753
754
755
756
757
758
759
760
761
#
# 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.
#
762
my $alt_urn = GeniHRN::Generate("aptlab.net:${slice_auth}", "slice", $slice_id);
763
764
765
766
767
768
769
770
771
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,
772
               "keyfile"  => $privkeyfile,
773
774
775
776
777
778
	       "useaptca" => 1,
	       "showuuid" => 1};
my $alt_certificate = GeniCertificate->Create($altblob);
fatal("Could not create alt certificate")
    if (!defined($alt_certificate));

779
780
781
782
783
784
785
#
# Encrypt blocks.
#
$tmp = APT_Profile::EncryptBlocks(\$rspecstr, $alt_certificate, \$errmsg);
if ($tmp) {
    ($tmp < 0 ? fatal($errmsg) : UserError($errmsg));
}
786
787
788
789
790
791
792
793
794
795
796
797
798
799
#
# 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);
}
800

801
#
802
# Generate credentials we need.
803
#
804
my ($slice_credential, $speaksfor_credential) =
805
    APT_Geni::GenCredentials($slice, $geniuser, undef, 0);
806
807
808
if (! (defined($speaksfor_credential) &&
       defined($slice_credential))) {
    fatal("Could not generate credentials");
809
810
}

811
#
812
# Got this far, lets create a quickvm record.
813
#
814
my $quickvm_uuid = (defined($quickuuid) ? $quickuuid : NewUUID());
815
816
817
if (!defined($quickvm_uuid)) {
    fatal("Could not generate a new uuid");
}
818
my $blob = {'uuid'         => $quickvm_uuid,
819
	    'name'         => $slice_id,
820
821
822
823
824
825
826
	    'profile_id'   => $profileid,
	    'profile_version' => $version,
	    'slice_uuid'   => $slice_uuid,
	    'creator'      => $geniuser->uid(),
	    'creator_idx'  => $geniuser->idx(),
	    'creator_uuid' => $geniuser->uuid(),
	    'status'       => "created",
827
828
	    'servername'   => $SERVER_NAME,
	    'rspec'        => $rspecstr,
829
	    'cert'         => $alt_certificate->cert(),
830
	    'privkey'      => $alt_certificate->PrivKeyDelimited(),
831
};
832
833
834
835
836
if ($profile->repourl()) {
    if (defined($script)) {
	$blob->{"script"}  = $script;
    }
    $blob->{"repourl"}   = $profile->repourl();
837
838
    $blob->{"reporef"}   = $reporef;
    $blob->{"repohash"}  = $repohash;
839
}
840
841
842
if (defined($project)) {
    $blob->{"pid"}     = $project->pid();
    $blob->{"pid_idx"} = $project->pid_idx();
843
844
    $blob->{"gid"}     = $group->gid();
    $blob->{"gid_idx"} = $group->gid_idx();
845
}
846
847
848
849
850
851
852
853
854
855
856
857
#
# 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;

858
$errmsg = undef;
859
$instance = APT_Instance->Create($blob, \$errmsg);
Leigh B Stoller's avatar
Leigh B Stoller committed
860
if (!defined($instance)) {
861
    $webtask->Delete();
862
863
    fatal(defined($errmsg) ? $errmsg :
	  "Could not create instance record for $quickvm_uuid");
864
}
865

866
867
868
869
870
871
872
873
874
875
876
#
# 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");
}

877
878
879
# We use this list of references for ParRun below.
my @aggregate_list = ();
foreach my $aggregate_urn (@aggregate_urns) {
880
881
882
883
884
885
886
887
    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");
    }
888
889
    if ($aptaggregate->adminonly() &&
        !(defined($this_user) && $this_user->IsAdmin())) {
890
891
        UserError("Only administrators may use $aggregate_urn");
    }
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
    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
907
908
909
# To keep stuff happy until multisite support finished.
$instance->Update({'aggregate_urn' => $aggregate_urns[0]});

910
911
912
913
914
915
916
917
918
919
920
921
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";
922
923
924
925
926

#
# Exit and let caller poll for status.
#
if (!$debug) {
927
    libaudit::AuditPrefork();
928
929
930
931
932
933
934
935
    my $child = fork();
    if ($child) {
	# Parent exits but avoid libaudit email.
	exit(0);
    }
    # All of the logging magic happens in here.
    libaudit::AuditFork();
}
936
# Bind the process id.
937
938
$webtask->SetProcessID($PID);

939
940
941
if ($usestitcher) {
    my $rval = RunStitcher();
    if ($rval) {
942
943
	$slice->UnLock();
	$instance->SetStatus("failed");
944
945
946
	$instance->RecordError($rval,
			       (defined($webtask->output()) ?
				$webtask->output() : ""));
947
	$webtask->Exited($rval);
948
	exit($rval);
949
    }
950
}
951
952
else {
    my $rval = CreateSlivers();
953
    #
954
    # We do not want email for most mapping errors, so look at the
955
956
957
958
    # return code to see if we want to kill the log (user will see the
    # error in the web ui). 
    #
    if ($rval) {
959
960
961
	$instance->RecordError($rval,
			       (defined($webtask->output()) ?
				$webtask->output() : ""));
962
963
	if ($rval == GENIRESPONSE_BADARGS ||
	    $rval == GENIRESPONSE_INSUFFICIENT_NODES ||
964
965
966
	    $rval == GENIRESPONSE_INSUFFICIENT_MEMORY ||
	    $rval == GENIRESPONSE_INSUFFICIENT_BANDWIDTH ||
	    $rval == GENIRESPONSE_NO_MAPPING) {
967
968
969
970
971
972
	    AuditAbort()
		if (!$debug);
	}
	$webtask->Exited($rval);
	exit($rval);
    }
973
}
Leigh B Stoller's avatar
Leigh B Stoller committed
974
$instance->SetStatus("provisioned");
975
$instance->ComputeNodeCounts();
976
977

#
978
979
980
# Now wait for the sliver to be ready, which means polling.
#
# Shorten default timeout.
981
#
982
Genixmlrpc->SetTimeout(60);
983

984
985
986
#
# Okay, fire off the waits for each aggregate
#
987
my @return_codes = ();
988
if (ParRun({"maxwaittime" => 99999, "maxchildren" => scalar(@aggregate_list)},
Leigh B Stoller's avatar
Leigh B Stoller committed
989
990
	    \@return_codes,
	    \&APT_Instance::Aggregate::WaitForSliver, @aggregate_list)) {
991
992
993
994
995
    #
    # The parent caught a signal. Leave things intact so that we can
    # kill things cleanly later.
    #
    $slice->UnLock();
996
997
    print STDERR "Internal error in WaitForSlivers\n";
    $webtask->output("Internal error in WaitForSlivers");
998
999
1000
1001
    $instance->SetStatus("failed");
    $webtask->Exited(1);
    exit(-1);
}
1002
print "$slice_urn\n";
1003

1004
1005
1006
1007
1008
1009
1010
#
# If we were canceled, then none of the stuff below matters, we
# are going to do a terminate.
#
if ($instance->IsCanceled()) {
    $slice->UnLock();

1011
1012
1013
1014
    #
    # If someone gets the lock, this will fail. But the apt daemon will
    # see the canceled flag too and fire off a termination. 
    #
1015
1016
1017
1018
    system("$MANAGEINSTANCE -t $webtask_id terminate $quickvm_uuid");
    exit(0);
}

1019
1020
1021
# Count up nodes running a startup service.
my $startuprunning = 0;

1022
1023
1024
1025
1026
1027
1028
1029
1030
#
# 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();
1031
1032
1033
1034
1035
1036
    print $aggobj->aggregate_urn() . "\n";
    if ($code) {
	$failed++;
	print "WaitforSliver Failure!\n";
	if (defined($aggobj->webtask()->output())) {
	    $webtask->output($aggobj->webtask()->output());
1037
	    $webtask->Exited($aggobj->webtask()->exitcode());
1038
1039
1040
1041
1042
	    print $aggobj->webtask()->output() . "\n";
	}
	else {
	    $webtask->output("WaitforSliver Failure at " .
			     $aggobj->aggregate_urn());
1043
	    $webtask->Exited(1);
1044
	}
1045
1046
1047
	# Promote the log up to the instance so that so its easy to find.
	$instance->SetPublicURL($aggobj->public_url())
	    if (defined($aggobj->public_url()));
1048
    }
Leigh B Stoller's avatar
Leigh B Stoller committed
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
    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");
	}
    }
1061
1062
    if (defined($aggobj->public_url())) {
	print $aggobj->public_url() . "\n";
1063
    }
1064
1065
    print "\n" . $aggobj->manifest() . "\n\n";
    print "------------------------------------------------------------\n\n";
1066
}
1067
$slice->UnLock();
1068

1069
if ($failed) {
1070
1071
1072
1073
1074
1075
    if ($ignorefailures) {
        $instance->SetStatus("ready");
    }
    else {
        $instance->SetStatus("failed");
    }
1076
    # Webtask exit status set above.
1077
1078
1079
    $instance->RecordError($webtask->exitcode(),
			   (defined($webtask->output()) ?
			    $webtask->output() : ""));
1080
1081
1082
}
else {
    $instance->SetStatus("ready");
Leigh B Stoller's avatar
Leigh B Stoller committed
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095

    #
    # 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);
    }
1096
}
1097
1098
exit(0);

1099
1100
1101
1102
1103
#
# Create credentials to access datasets.
#
sub CreateDatasetCreds($$$$$)
{
1104
    my ($xml, $project, $geniuser, $pmsg, $pref) = @_;
1105
1106
1107
1108
1109
1110
1111
1112
    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()) {
1113
1114
1115
	my $manager_urn  = GetManagerId($ref);
	
	foreach my $blockref (GeniXML::FindNodesNS("n:blockstore", $ref,
1116
				   $GeniXML::EMULAB_NS)->get_nodelist()) {
1117
1118
	    my $dataset_id = GeniXML::GetText("persistent", $blockref);
	    if (!defined($dataset_id)) {
1119
		# persistent is deprecated.
1120
		$dataset_id = GeniXML::GetText("dataset", $blockref);
1121
	    }
1122
1123
1124
1125
1126
1127

	    #
	    # We only care about datasets here, we let the backend
	    # do the error checking on ephemeral blockstores.
	    #
	    next
1128
1129
1130
1131
1132
1133
		if (!defined($dataset_id));

	    my $class = GeniXML::GetText("class", $blockref);
	    if (!defined($class)) {
		$class = "remote";
	    }
1134
1135
	    # Image backed referenced by URL. No checking since the
	    # image has to be global anyway. Needs more thought.
1136
	    next
1137
1138
1139
1140
		if ($class eq "local" && $dataset_id =~ /^(http|https):/);

	    my $dataset_urn = GeniHRN->new($dataset_id);
	    my $dataset = APT_Dataset->LookupByRemoteURN($dataset_urn);
1141
	    if (!defined($dataset)) {
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
		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;
1167
1168
			}
		    }
1169
1170
1171
1172
1173
1174
1175
1176
1177
		    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);
1178
		}
1179
1180
		$$pmsg = "Dataset '$dataset_urn' does not exist";
		return 1;
1181
	    }
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
	    #
	    # 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";
1203
1204
		return -1;
	    }
1205
	    push(@credentials, $credential);
1206
1207
1208
1209
1210
1211
	}
    }
    @$pref = @credentials;
    return 0;
}

1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
#
# Create a sliver at a single aggregate. This is called from parrun