create_instance.in 38.5 KB
Newer Older
1
2
#!/usr/bin/perl -w
#
3
# Copyright (c) 2008-2015 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 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', 't=s', 'a=s', 'S');
47
48
my $debug   = 0;
my $verbose = 1;
49
my $DEFAULT_URN  = "urn:publicid:IDN+apt.emulab.net+authority+cm";
50
my $xmlfile;
51
52
my $webtask;
my $webtask_id;
53
my $localuser  = 0;
54
my $usestitcher= 0;
55
my $quickuuid;
56
my $default_aggregate_urn = $DEFAULT_URN;
57
my $this_user;
58
my $xmlparse;
59
60
61
62
63
64
65
my $instance;
my $slice;
my $sitemap;
my @aggregate_urns = ();

# Debugging
my $usemydevtree  = 0;
66
67
68
69

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

#
# Configure variables
#
my $TB		  = "@prefix@";
my $TBOPS         = "@TBOPSEMAIL@";
my $TBLOGS        = "@TBLOGSEMAIL@";
my $OURDOMAIN     = "@OURDOMAIN@";
83
my $MAINSITE      = @TBMAINSITE@;
84
85
86
87
my $PGENIDOMAIN   = "@PROTOGENI_DOMAIN@";
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
93
94
95
96
97
98
99
100
101
102
103

# 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
#
$| = 1; 

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

#
# Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments.
#
132
Getopt::Long::Configure("no_ignore_case");
133
my %options = ();
134
if (! GetOptions(\%options, @optlist, "site=s%" => \$sitemap)) {
135
136
    usage();
}
137
if (defined($options{"a"})) {
138
    $default_aggregate_urn = $options{"a"};
139
}
140
141
142
143
144
145
if (defined($options{"d"})) {
    $debug = 1;
}
if (defined($options{"v"})) {
    $verbose = 1;
}
146
147
if (defined($options{"S"})) {
    $usestitcher = 1;
148
149
150
151
}
if (defined($options{"t"})) {
    $webtask_id = $options{"t"};
}
152
153
154
if (defined($options{"u"})) {
    $quickuuid = $options{"u"};
}
155
if (@ARGV < 1) {
156
157
    usage();
}
158
$xmlfile = shift(@ARGV);
159

160
161
162
163
164
165
#
# Check the filename when invoked from the web interface; must be a
# file in /tmp.
#
if (getpwuid($UID) ne "nobody") {
    $this_user = User->ThisUser();
166

167
168
169
170
171
172
173
174
175
176
177
    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");
178
179
    }

180
181
182
183
184
185
186
    # Use realpath to resolve any symlinks.
    my $translated = realpath($xmlfile);
    if ($translated =~ /^(\/tmp\/[-\w\.\/]+)$/) {
	$xmlfile = $1;
    }
    else {
	fatal("Bad data in translated pathname: $xmlfile");
187
188
189
    }
}

190
191
192
# Email record.
if (! $debug) {
    AuditStart(0, undef, LIBAUDIT_LOGTBLOGS()|LIBAUDIT_LOGONLY());
193
194
195
    #
    # Once we determine the project, we can add the appropriate log CC
    #
196
}
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213

# 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");
}

#
214
# We use the normal XMLRPC route, so need a context.
215
216
217
218
219
220
221
222
223
224
#
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.
#
225
226
227
228
$xmlparse = eval { XMLin($xmlfile,
			 VarAttr => 'name',
			 ContentKey => '-content',
			 SuppressEmpty => undef); };
229
230
231
232
233
234
fatal($@)
    if ($@);

#
# Make sure all the required arguments were provided.
#
235
foreach my $key ("username", "email", "profile") {
236
237
238
239
240
241
242
243
244
    fatal("Missing required attribute '$key'")
	if (! (exists($xmlparse->{'attribute'}->{"$key"}) &&
	       defined($xmlparse->{'attribute'}->{"$key"}) &&
	       $xmlparse->{'attribute'}->{"$key"} ne ""));
}

#
# Gather up args and sanity check.
#
245
my ($value, $user_urn, $user_uid, $user_hrn, $user_email, $project, $pid,
246
    $sshkey, $profile, $profileid, $version, $rspecstr, $errmsg, $slice_id);
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266

#
# Username and email has to be acceptable to Emulab user system.
#
$value = $xmlparse->{'attribute'}->{"username"}->{'value'};
if (! TBcheck_dbslot($value, "users", "usr_name",
		     TBDB_CHECKDBSLOT_WARN|TBDB_CHECKDBSLOT_ERROR)) {
    fatal("Illegal username: $value");
}
$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;

267
268
269
270
271
272
273
274
275
276
277
278
279
#
# 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");
    }
    $slice_id = $value;
}

280
#
281
# Profile.
282
#
283
# This is a safe lookup.
284
285
286
$value = $xmlparse->{'attribute'}->{"profile"}->{'value'};
$profile = APT_Profile->Lookup($value);
if (!defined($profile)) {
Leigh B Stoller's avatar
Leigh B Stoller committed
287
    fatal("No such profile: $value");
288
}
289
290
$profileid = $profile->profileid();
$version   = $profile->version();
291

292
#
293
# Optional rspec, as for a Parameterized Profile.
294
#
295
296
if (exists($xmlparse->{'attribute'}->{"rspec"})) {
    $rspecstr  = $xmlparse->{'attribute'}->{"rspec"}->{'value'};
297
}
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
else {
    $rspecstr  = $profile->CheckFirewall(!$localuser);
    #
    # Look for datasets; need to verify that the datasets being referenced
    # still exist and are still permissible to use, and we have to generate
    # credentials for those datasets (if not a global dataset). The tricky
    # aspect is that while a dataset and a profile have project permissions,
    # the experiment has no project association, so if the profile/dataset
    # perms are okay, then we send over a credential that tells the CM to
    # allow this experiment to use that dataset in that project. 
    #
    $errmsg = "Bad dataset";
    if (APT_Profile::CheckDatasets($rspecstr, $profile->pid(), \$errmsg)) {
	UserError($errmsg);
    }
    #
    # A temporary hack to make sure that the user does not try to run
    # an x386 image on the Cloudlab cluster (ARMs). This will eventually
    # get replaced with Jon's constraint checking code.
    #
318
    if ($profile->CheckNodeConstraints($default_aggregate_urn, \$errmsg)) {
319
320
	UserError($errmsg);
    }
321
322
}

323
324
325
#
# Update rspec with site aggregate urns.
#
326
327
328
329
330
if (keys(%{$sitemap})) {
    # SetSites will tell us if we must use stitcher.
    my $needstitcher = 0;
    
    if (APT_Profile::SetSites(\$rspecstr, $sitemap, \$needstitcher, \$errmsg)) {
331
332
	fatal($errmsg);
    }
333
334
335
336
337
    # but do not override command line force.
    $usestitcher = 1 if ($needstitcher);
}
elsif (APT_Profile::BindRspec(\$rspecstr, $default_aggregate_urn, \$errmsg)) {
    fatal($errmsg);
338
339
340
341
342
343
344
345
346
347
}
if (keys(%{$sitemap})) {
    foreach my $siteid (keys(%{$sitemap})) {
	push(@aggregate_urns, $sitemap->{$siteid})
    }
}
else {
    push(@aggregate_urns, $default_aggregate_urn);
}

348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
#
# 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!");
	}
    }
369
370
    close($fh);
    unlink($keyfile);
371
}
372
373
chomp($sshkey)
    if (defined($sshkey));
374
375
376
377
378
379

#
# 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).
#
380
381
382
383
384
385
386
# 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) {
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
    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");
    }
    # Now this will work; without a certificate, this would fail.
    if (defined($emulab_user)) {
	$geniuser = GeniUser::LocalUser->Create($emulab_user);
    }
407
408
409
410
}
else {
    $geniuser = GeniUser->Lookup($user_urn);

411
412
413
    #
    # In Utah, check for alternate SA
    #
414
    if (!defined($geniuser) && $MAINSITE) {
415
416
	$user_urn = GeniHRN::Generate("aptlab.net", "user", $user_uid);
	$user_hrn = "aptlab.${user_uid}";
417
	$geniuser = GeniUser->Lookup($user_urn, 0);
418
419
    }
}
420
if (!defined($geniuser)) {
421
422
423
    if ($localuser) {
	fatal("Could not lookup local user $user_urn");
    }
424
    
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
    #
    # 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");
    }
442
443
444
445
446
447
448
449
    my $blob = {"urn"      => $user_urn,
		"hrn"      => $user_hrn,
		"email"    => $user_email,
		"showuuid" => 1};
    if ($MAINSITE) {
	$blob->{'useaptca'} = 1;
    }
    my $certificate = GeniCertificate->Create($blob);
450
451
452
453
454
455
456
457
458
459
    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
460
    # Setup browser ssh.
461
    #
462
463
464
    system("$SSHSETUP " . $geniuser->uuid());
    fatal("Could not create ssh key pair")
	if ($?);
465
466
467
468
}
my $user_uuid = $geniuser->uuid();
# So we know this user has dome something lately.
$geniuser->BumpActivity();
469

470
471
472
if ($localuser) {
    my $emulab_user = $geniuser->emulab_user();
    if ($emulab_user->IsNonLocal()) {
473
474
	#
	# A user created from a Geni certificate via geni-login. We
475
476
	# asked for the current ssh keys from the MA when they logged
	# in, but we ask again to make sure have the latest keys.
477
	#
478
	system("$UPDATEGENIUSER -s " . $emulab_user->uid());
479
	if (0) {
480
481
	    fatal("Could not update ssh keys for nonlocal user");
	}
482
483
484
485
486
487
488
489
490
	#
	# Check project membership, must be a member of at least one
	# valid project at the GPO portal.
	#
	system("$UPDATEGENIUSER -p " . $emulab_user->uid());
	if ($?) {
	    fatal("Not a member of any projects");
	}
	
491
492
	# Nonlocal users get the holding project.
	$pid = "CloudLab";
493
    }
494
    elsif (defined($sshkey) && !$emulab_user->LookupSSHKey($sshkey)) {
495
496
497
498
499
500
	#
	# 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.
	#
	
501
	#
502
503
504
505
	# 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
506
507
508
509
510
	# 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.
511
	#
512
513
514
	my ($fh, $keyfile) = tempfile(UNLINK => 0);
	print $fh $sshkey;

515
	if (system("$ADDPUBKEY -a -u $user_uid -f $keyfile")) {
516
517
518
519
520
	    fatal("Could not add new ssh pubkey");
	}
	close($fh);
	unlink($keyfile);
    }
521
522
523
524
525
526
527
528
529
530
531
532
533
534
    #
    # 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");
    }
535
536
537
538
539
540
541
542
543
544

    # 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
545
546
	fatal("No permission to create experiments in project ".
	      $project->pid());
547
548
549
550
551
552
553
    }
    $pid = $project->pid();
}
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
554
	# interface. We allow key reuse for existing users, see above.
555
556
557
558
559
560
	#
	$geniuser->DeleteKeys();
	$geniuser->AddKey($sshkey);
    }
    # Guest users get a holding project.
    $pid = "aptguests";
561
562
563
564
    $project = Project->Lookup($pid);
    if (!defined($project)) {
	fatal("Project $pid does not exist");
    }
565
}
566
567
568
#
# Now we know where to send to logs.
#
569
570
571
if (!$debug) {
    AddAuditInfo("cc", $project->LogsEmailAddress());
}
572

Leigh B Stoller's avatar
Leigh B Stoller committed
573
# There will be "internal" keys cause we pass the flag asking for them.
574
my @sshkeys;
Leigh B Stoller's avatar
Leigh B Stoller committed
575
if ($geniuser->GetKeyBundle(\@sshkeys, 1) < 0 || !@sshkeys) {
576
577
578
    fatal("No ssh keys to use for $geniuser!");
}

579
580
581
# Generate the extra credentials that tells the backend this experiment
# can access the datasets.
my @dataset_credentials = ();
582
583
584
585
586
587
588
if (defined($profile)) {
    my $retval = CreateDatasetCreds($rspecstr,
				    $profile->pid(), $geniuser, 
				    \$errmsg, \@dataset_credentials);
    if ($retval) {
	($retval < 0 ? fatal($errmsg) : UserError($errmsg));
    }
589
590
}

591
#
592
593
594
#
# Now generate a slice registration and credential
#
595
my $safe_uid    = $user_uid; $safe_uid =~ s/_/-/;
596
597
598
if (! defined($slice_id)) {
    $slice_id   = $safe_uid . "-QV" . TBGetUniqueIndex('next_quickvm', 1);
}
599
my $slice_urn   = GeniHRN::Generate("${OURDOMAIN}:${pid}", "slice", $slice_id);
600
601
my $slice_hrn   = "${PGENIDOMAIN}.${slice_id}";
my $SERVER_NAME = (exists($ENV{"SERVER_NAME"}) ? $ENV{"SERVER_NAME"} : "");
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622

#
# Make sure slice is unique. Probably retry here at some point. 
#
if (GeniSlice->Lookup($slice_hrn) || GeniSlice->Lookup($slice_urn)) {
    fatal("Could not form a unique slice name");
}
	    
#
# 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.
623
624
$slice = GeniSlice->Create($slice_certificate,
			   $geniuser, $sa_authority, undef, 1);
625
626
627
628
if (!defined($slice)) {
    $slice_certificate->Delete();
    fatal("Could not create new slice object for $slice_urn");
}
629
630
# These get quick expirations, unless it is a real user.
if ($slice->SetExpiration(time() + (($localuser ? 16 : 3) * 3600)) != 0) {
631
632
633
634
    fatal("Could not set the slice expiration for $slice_urn");
}
my $slice_uuid = $slice->uuid();

635
#
636
# Generate credentials we need.
637
#
638
my ($slice_credential, $speaksfor_credential) =
639
    APT_Geni::GenCredentials($slice, $geniuser);
640
641
642
if (! (defined($speaksfor_credential) &&
       defined($slice_credential))) {
    fatal("Could not generate credentials");
643
644
}

645
#
646
# Got this far, lets create a quickvm record.
647
#
648
my $quickvm_uuid = (defined($quickuuid) ? $quickuuid : NewUUID());
649
650
651
if (!defined($quickvm_uuid)) {
    fatal("Could not generate a new uuid");
}
652
my $blob = {'uuid'         => $quickvm_uuid,
653
	    'name'         => $slice_id,
654
655
656
657
658
659
660
	    'profile_id'   => $profileid,
	    'profile_version' => $version,
	    'slice_uuid'   => $slice_uuid,
	    'creator'      => $geniuser->uid(),
	    'creator_idx'  => $geniuser->idx(),
	    'creator_uuid' => $geniuser->uuid(),
	    'status'       => "created",
661
662
	    'servername'   => $SERVER_NAME,
	    'rspec'        => $rspecstr,
663
664
665
666
667
};
if (defined($project)) {
    $blob->{"pid"}     = $project->pid();
    $blob->{"pid_idx"} = $project->pid_idx();
}
668
$errmsg = undef;
669
$instance = APT_Instance->Create($blob, \$errmsg);
Leigh B Stoller's avatar
Leigh B Stoller committed
670
if (!defined($instance)) {
671
672
    fatal(defined($errmsg) ? $errmsg :
	  "Could not create instance record for $quickvm_uuid");
673
}
674
675
676
677
678
679
680
681
# To keep stuff happy until multisite support finished.
if (keys(%{$sitemap})) {
    my ($temp_aggregate_urn) = values(%{$sitemap});
    $instance->Update({'aggregate_urn' => $temp_aggregate_urn});
}
else {
    $instance->Update({'aggregate_urn' => $default_aggregate_urn});
}
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700

# We use this list of references for ParRun below.
my @aggregate_list = ();
foreach my $aggregate_urn (@aggregate_urns) {
    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);
}

701
702
#
# Create a webtask so that we can store additional information about
703
# the sliver while we wait.
704
705
#
$webtask = WebTask->Create($instance->uuid());
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
if (!defined($webtask)) {
    fatal("Could not create a webtask!");
}
$webtask->AutoStore(1);

print STDERR "\n";
print STDERR "User:    $user_urn\n";
print STDERR "Email:   $user_email" . (!$localuser ? " (guest)" : "") . "\n";
if (defined($profile)) {
    print STDERR "Profile: " . $profile->name() . ":${version}\n";
}
print STDERR "Slice:   $slice_urn\n";
print STDERR "Server:  $SERVER_NAME\n";
print STDERR "Cluster: ";
print STDERR join(",", map($_->aggregate_urn(), @aggregate_list))  . "\n";
print STDERR "\n";
print STDERR "$rspecstr\n";
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737

#
# Exit and let caller poll for status.
#
if (!$debug) {
    my $child = fork();
    if ($child) {
	# Parent exits but avoid libaudit email.
	exit(0);
    }
    # Let parent exit;
    sleep(2);
    # All of the logging magic happens in here.
    libaudit::AuditFork();
}
738
# Bind the process id.
739
740
$webtask->SetProcessID($PID);

741
742
743
if ($usestitcher) {
    my $rval = RunStitcher();
    if ($rval) {
744
745
746
	$slice->UnLock();
	$instance->SetStatus("failed");
	$webtask->Exited(1);
747
	exit($rval);
748
    }
749
}
750
751
752
753
754
else {
    my $rval = CreateSlivers();
    exit($rval)
	if ($rval);
}
Leigh B Stoller's avatar
Leigh B Stoller committed
755
$instance->SetStatus("provisioned");
756
$instance->ComputeNodeCounts();
757
758

#
759
760
761
# Now wait for the sliver to be ready, which means polling.
#
# Shorten default timeout.
762
#
763
Genixmlrpc->SetTimeout(60);
764

765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
sub WaitForSliver($)
{
    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
    $cmurl =~ s/protogeni/protogeni\/stoller/ if ($usemydevtree);

    my $seconds  = 1500;
    my $interval = 15;
    my $ready    = 0;
    my $failed   = 0;
    my $public_url;
    my $repblob;

    while ($seconds > 0) {
	sleep($interval);
	$seconds -= $interval;
789
    
790
	my $response = $aggobj->SliceStatus();
791
792
793
794
795
796
797
	if (!defined($response) || !defined($response->value()) ||
	    ($response->code() != GENIRESPONSE_SUCCESS &&
	     $response->code() != GENIRESPONSE_SERVER_UNAVAILABLE &&
	     $response->code() != GENIRESPONSE_BUSY)) {
	    print STDERR "SliverStatus failed";
	    if (defined($response)) {
		print STDERR ": " . $response->output();
798
799
800
801
802
803
804
805
		if ($response->output() =~ /read timeout/) {
		    $webtask->output("Lost contact with the aggregate. " .
				     "Possibly a network failure, ".
				     "please try again later.");
		}
		else {
		    $webtask->output($response->output());
		}
806
	    }
807
808
809
	    print STDERR "\n";
	    $failed = 1;
	    last;
810
	}
811
812
813
	next
	    if ($response->code() == GENIRESPONSE_BUSY ||
		$response->code() == GENIRESPONSE_SERVER_UNAVAILABLE);
814

815
816
817
818
819
820
	$repblob = $response->value();
	#
	# Convert to something smaller, with info the web interface
	# cares about. We get this on each loop, update so the web
	# interface can show changes.
	#
821
	my $statusblob = {};
822
823
	foreach my $urn (keys(%{$repblob->{'details'}})) {
	    my $details = $repblob->{'details'}->{$urn};
824
825
826
	    my $node_id = $details->{'client_id'};
	    $statusblob->{$node_id} = $details;
	}
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
	$webtask->sliverstatus($statusblob);

	if (exists($repblob->{'public_url'})) {
	    $public_url = $repblob->{'public_url'};
	    $aggobj->SetPublicURL($public_url);
	}
	if ($repblob->{'status'} eq "ready") {
	    $ready = 1;
	    last;
	}
	elsif ($repblob->{'status'} eq "failed") {
	    $failed = 1;
	    print STDERR "*** $urn failed\n";
	    $webtask->output("Experiment setup on $urn failed");
	    last;
	}
843
    }
844
845
846
847
848
849
850
851
852
    if ($failed || !$ready) {
	$aggobj->SetStatus("failed");
	if (!$ready) {
	    # XXX Need better handling for timeout.
	    print STDERR "*** $urn timed out.\n";
	    $webtask->output("Experiment setup on $urn timed out");
	}
	$webtask->Exited(1);
	return 1;
853
    }
854
855
856
857
858
859
860
861
    $aggobj->SetStatus("ready");
    $webtask->Exited(0);
    return 0;
}

#
# Okay, fire off the waits for each aggregate
#
862
my @return_codes = ();
863
864
865
866
867
868
869
if (ParRun({"maxwaittime" => 99999, "maxchildren" => scalar(@aggregate_list)},
	    \@return_codes, \&WaitForSliver, @aggregate_list)) {
    #
    # The parent caught a signal. Leave things intact so that we can
    # kill things cleanly later.
    #
    $slice->UnLock();
870
871
    print STDERR "Internal error in WaitForSlivers\n";
    $webtask->output("Internal error in WaitForSlivers");
872
873
874
875
    $instance->SetStatus("failed");
    $webtask->Exited(1);
    exit(-1);
}
876
print "$slice_urn\n";
877
878
879
880
881
882
883
884
885
886

#
# 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();
887
888
889
890
891
892
893
894
895
896
897
898
899
    print $aggobj->aggregate_urn() . "\n";
    if ($code) {
	$failed++;
	print "WaitforSliver Failure!\n";
	if (defined($aggobj->webtask()->output())) {
	    $webtask->output($aggobj->webtask()->output());
	    print $aggobj->webtask()->output() . "\n";
	}
	else {
	    $webtask->output("WaitforSliver Failure at " .
			     $aggobj->aggregate_urn());
	}
    }
900
901
    if (defined($aggobj->public_url())) {
	print $aggobj->public_url() . "\n";
902
    }
903
904
    print "\n" . $aggobj->manifest() . "\n\n";
    print "------------------------------------------------------------\n\n";
905
}
906
$slice->UnLock();
907

908
if ($failed) {
Leigh B Stoller's avatar
Leigh B Stoller committed
909
    $instance->SetStatus("failed");
910
    $webtask->Exited(1);
911
912
913
}
else {
    $instance->SetStatus("ready");
914
    $webtask->Exited(0);
915
}
916
917
exit(0);

918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
#
# Create credentials to access datasets.
#
sub CreateDatasetCreds($$$$$)
{
    my ($xml, $pid, $user, $pmsg, $pref) = @_;
    my @credentials = ();
    
    my $rspec = GeniXML::Parse($xml);
    if (! defined($rspec)) {
	print STDERR "CreateDatasetCreds: Could not parse rspec\n";
	return -1;
    }
    foreach my $ref (GeniXML::FindNodes("n:node", $rspec)->get_nodelist()) {
	foreach my $blockref (GeniXML::FindNodesNS("n:blockstore",
						   $ref,
				   $GeniXML::EMULAB_NS)->get_nodelist()) {
	    my $leaseurn = GeniXML::GetText("persistent", $blockref);
936
937
938
939
	    if (!defined($leaseurn)) {
		# persistent is deprecated.
		$leaseurn = GeniXML::GetText("dataset", $blockref);
	    }
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958

	    #
	    # We only care about datasets here, we let the backend
	    # do the error checking on ephemeral blockstores.
	    #
	    next
		if (!defined($leaseurn));
	    
	    my ($authority, $type, $id) = GeniHRN::Parse($leaseurn);
	    #
	    # Separate project from name; this is how the rspec specifies
	    # the dataset they want, since it might be in another project
	    #
	    if ($id =~ /^([-\w]+)\/\/(.+)$/) {
		$pid = $1;
		$id  = $2;
	    }
	    my $dataset = APT_Dataset->Lookup("$pid/$id");
	    if (!defined($dataset)) {
959
960
961
962
963
		$dataset = APT_Dataset->LookupByRemoteURN($leaseurn);
		if (!defined($dataset)) {
		    $$pmsg = "Persistent dataset '$pid/$id' does not exist";
		    return 1;
		}
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
	    }
	    my $certificate = $dataset->GetCertificate();
	    if (!defined($certificate)) {
		$$pmsg = "No certificate for dataset '$pid/$id'";
		return -1;
	    }
	    my $credential =
		APT_Geni::GenCredentials($certificate, $geniuser,
					 ["blockstores"]);
	    if (!defined($credential)) {
		$$pmsg = "Could not create credential for dataset '$pid/$id'";
		return -1;
	    }
	    push(@credentials, $credential->asString());
	}
    }
    @$pref = @credentials;
    return 0;
}

984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
#
# 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
    $cmurl =~ s/protogeni/protogeni\/stoller/ if ($usemydevtree);

    #
    # 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,
				     "keys"        =>
					 [{'urn'   => $user_urn,
					   'login' => $user_uid,
					   'keys'  => \@sshkeys }],
					 "credentials" =>
					 [$slice_credential->asString(),
					  $speaksfor_credential->asString(),
					  @dataset_credentials
					 ]});

	if (!defined($response) || $response->code() != GENIRESPONSE_SUCCESS) {
	    if (defined($response) &&
		$response->code() == GENIRESPONSE_SERVER_UNAVAILABLE &&
		$tries >= 0) {
		print STDERR "Server for $urn reports too busy, ".
		    "waiting a while ...\n";
		sleep(int(rand(20)) + 10);
		$tries--;
		next;
	    }
	    if (defined($response)) {
		$webtask->output($response->output());
		$webtask->Exited($response->code());
	    }
	    else {
		$webtask->Exited(1);
	    }
	    $aggobj->SetStatus("failed");
	    
	    if (defined($response) && defined($response->logurl())) {
		$aggobj->SetPublicURL($response->logurl());
	    }
	    print STDERR "CreateSliver failed on $urn: ".
		(defined($response) ? $response->output() : "") . "\n";
	    return -1;
	}
	last;
    }
    # This will get overwritten later.
    if (defined($response) && defined($response->logurl())) {
	$aggobj->SetPublicURL($response->logurl());
    }
    my $manifest = $response->value()->[1];
    if (!defined($manifest)) {
	$webtask->Exited(1);
	$aggobj->SetStatus("failed");
	print STDERR "CreateSliver $urn: No manifest returned\n";
	return -1;
    }
    $aggobj->SetStatus("provisioned");
    $aggobj->SetManifest($manifest);
    return 0;
}

sub CreateSlivers()
{
    my ($perrmsg) = @_;

    my @return_codes = ();
    if (ParRun({"maxwaittime" => 99999,
		"maxchildren" => scalar(@aggregate_list)},
	       \@return_codes, \&CreateSliver, @aggregate_list)) {
	#
	# The parent caught a signal. Leave things intact so that we can
	# kill things cleanly later.
	#
	$slice->UnLock();
	$instance->SetStatus("failed");
	$webtask->Exited(1);
	return -1;
    }
    #
    # Check the exit codes; any failure is a total failure (for now).
    #
    foreach my $aggobj (@aggregate_list) {
	#
	# Have to refresh the sliver objects since they were updated in a fork.
	# Need the manifests for the call to ComputeNodeCounts below.
	#
	$aggobj->Refresh();
	my $code = shift(@return_codes);
	if ($code) {
	    $slice->UnLock();
	    $instance->SetStatus("failed");
	    $webtask->output($aggobj->webtask()->output())
		if (defined($aggobj->webtask()->output()));
	    $webtask->Exited(1);
	    return 1;
	}
    }
    return 0;
}

#
# Run the stitcher to allocate resources. We use this whenever we have
# links that cross aggregates
#
sub RunStitcher()
{
    my $tmpdir        = tmpnam();
    my $slicecredfile = "$tmpdir/slicecred.xml";
    my $speaksforfile = "$tmpdir/speaksforcred.xml";
1118
    my $al2scredfile  = "$tmpdir/al2scred.xml";
1119
    my $rspecfile     = "$tmpdir/rspec.xml";
1120
1121
    my $stdoutfile    = "$tmpdir/stitcher.stdout";
    my $stderrfile    = "$tmpdir/stitcher.stderr";
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
    my $failed        = 0;

    #
    # The AM API uses a different ssh key structure, just a list of strings.
    #
    @sshkeys = map { $_->{'key'} } @sshkeys;

    #
    # Hey, I think stitcher/omni has as many options as snmpit. Wow!
    #
    my $command = "$STITCHER --fileDir $tmpdir --cred $speaksforfile ".
	"--slicecredfile $slicecredfile --usercredfile $slicecredfile ".
1134
	"--al2scredfile $al2scredfile --debug ".
Leigh B Stoller's avatar
Leigh B Stoller committed
1135
1136
1137
	# We do not want these two files defaulting to user home dir.
	"--GetVersionCacheName=$tmpdir/get_version_cache.json ".
	"--AggNickCacheName=$tmpdir/agg_nick_cache ".
1138
1139
1140
1141
1142
1143
1144
	"--scsURL https://nutshell.maxgigapop.net:8443/geni/xmlrpc  ".
	"--speaksfor $user_urn -V3 allocate $slice_urn $rspecfile";

    return -1
	if (! mkdir("$tmpdir", 0755));

    print "Using $tmpdir for stitcher\n"
1145
	if ($debug || $verbose);
1146
    print "Stitcher command: $command\n"
1147
	if ($debug || $verbose);
1148
1149
1150
1151
1152

    goto bad
	if ($instance->WriteCredentials($tmpdir));

    goto bad
Leigh B Stoller's avatar
Leigh B Stoller committed
1153
1154
1155
1156
	if (system("/bin/cp -fp /usr/testbed/etc/stitcher/omni_config $tmpdir"));
    goto bad
	if (system("/bin/cp -fp /usr/testbed/etc/stitcher/agg_nick_cache ".
		   "$tmpdir/agg_nick_cache"));
1157
1158
1159
1160
1161
1162
1163
1164

    if (!open(XML, ">$rspecfile")) {
	print STDERR "Could not open $rspecfile: $!\n";
	goto bad;
    }
    print XML $rspecstr;
    close(XML);

1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
    #
    # Use a log file for the stitcher output, so we can spew it.
    # The file in the tmp dir has to exist.
    #
    system("/bin/cp /dev/null $stdoutfile");
    my $logfile = Logfile->Create($project->GetProjectGroup(), $stdoutfile);
    if (!defined($logfile)) {
	print STDERR "Could not create logfile\n";
    }
    else {
	$logfile->Open();
Leigh B Stoller's avatar
Leigh B Stoller committed
1176
	$logfile->SetPublic(1);
1177
1178
1179
	$instance->SetLogFile($logfile);
    }

1180
1181
1182
1183
    #
    # Okay, run the stitcher. Only to allocate, we will do the provisions
    # so that we can pass the ssh keys more easily.
    #
Leigh B Stoller's avatar
Leigh B Stoller committed
1184
    $instance->SetStatus("stitching");
1185
    system("cd $tmpdir; $command > $stdoutfile 2> $stderrfile");
1186
    if ($?) {
1187
	if (-s $stderrfile) {
1188
1189
	    my $stuff = `cat $stderrfile`;
	    $webtask->output($stuff);
1190
1191
1192
1193
1194
	    system("/bin/cat $stderrfile");
	}
	else {
	    $webtask->output("Stitcher failed!");
	}
1195
1196
1197
1198
1199
1200
1201
	#
	# Even if we fail, want to pick up whatever aggregates the stitcher
	# decided to use, so that we can ensure all slivers get cleaned up
	# at termination.
	#
	$failed = 1;
    }
1202
1203
1204
1205
    if (defined($logfile)) {
	$logfile->Close();
	$logfile->Store();
    }
1206
1207
1208
1209
1210
1211
1212
1213
    
    #
    # The stitcher puts the list of aggregates into a file, read that so
    # we can add any new ones to the instance. Just read the directory and
    # find it. 
    #
    my @agglist = ();
    my $agglistfile;
1214
    my $al2smanifest;
1215
1216
1217
1218
1219
1220
1221
    opendir(DIR, $tmpdir);
    my @files  = readdir(DIR);
    closedir(DIR);

    foreach my $file (@files) {
	if ($file =~ /amlist.txt$/) {
	    $agglistfile = "$tmpdir/$file";
1222
1223
1224
	}
	elsif ($file =~ /manifest-rspec-al2s/) {
	    $al2smanifest = "$tmpdir/$file";
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
	}
    }
    #
    # The stitcher will not create this file if it passes straight through
    # to omni, as it will do if no cross aggregate links.
    #
    if (defined($agglistfile)) {
	if (!open(TXT, $agglistfile)) {
	    print STDERR "Could not open $agglistfile: $!\n";
	    goto bad;
	}
	while (<TXT>) {
	    next
		if ($_ =~ /^#/);
	    if ($_ =~ /^([^,]*),(.*)$/) {
		push(@agglist, $2);
	    }
	}
	if (!@agglist) {
	    print STDERR "Stitcher did not contact any aggregates!\n";
	    goto bad;
	}
	close(TXT);
    }
    foreach my $urn (@agglist) {
	next
	    if (exists($instance->AggregateHash()->{$urn}));
	
	my $authority = GeniAuthority->Lookup($urn);
	if (!defined($authority)) {
	    $authority = GeniAuthority->CreateFromRegistry("CM", $urn);
	    if (!defined($authority)) {
		print STDERR "Could not lookup authority: $urn\n";
		goto bad;
	    }
	}
	my $aggobj = $instance->AddAggregate($urn);
	$aggobj->_authority($authority);
	push(@aggregate_list, $aggobj);
    }
    goto bad
	if ($failed);

    #
    # Pass this function to ParRun; Provision slivers and request manifests.
    #
    my $coderef = sub {
	my ($ref) = @_;
	my $aggobj = $ref;
	$aggobj->Refresh();
	my $webtask   = $aggobj->webtask();
	my $authority = $aggobj->_authority();
	my $urn       = $authority->urn();
	my $errmsg    = "Provision failed on $urn";
	$webtask->Refresh();

1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
	#
	# AL2S was done with a createsliver, so we know its ready.
	# The thing we lack is a manifest, and I cannot seem to get
	# get ListResources to work there, so just read the file. 
	#
	if ($aggobj->isAL2S()) {
	    if (!defined($al2smanifest) || ! -e $al2smanifest) {
		print STDERR "No manifest for AL2S\n";
		$aggobj->SetStatus("failed");
		$webtask->output("No manifest for AL2S");
		$webtask->Exited(-1);
		return -1;
	    }
	    my $manifest_string = "";
	    if (! open(MAN, $al2smanifest)) {
		print STDERR "Could not open $al2smanifest\n";
		$aggobj->SetStatus("failed");
		$webtask->output("Could not open manifest file");
		$webtask->Exited(-1);
		return -1;
	    }
	    while (<MAN>) {
		$manifest_string .= $_;
	    }
	    close(MAN);
	    $aggobj->SetManifest($manifest_string);
	    $aggobj->SetStatus("provisioned");
	    return 0;
	}
1310
1311
1312
1313
1314
1315
1316
1317
	print "Provisioning at $urn\n";
	if ($aggobj->Provision(\$errmsg, \@sshkeys)) {
	    $aggobj->SetStatus("failed");
	    $webtask->output($errmsg);
	    $webtask->Exited(-1);
	    print STDERR "Provision failed on $urn: $errmsg\n";
	    return -1;
	}
Leigh B Stoller's avatar
Leigh B Stoller committed
1318
	$aggobj->SetStatus("provisioned");
1319
1320
1321
1322
1323
1324
1325
1326
	print "Requesting manifest from $urn\n";
	my $manifest = $aggobj->GetManifest();
	if (!defined($manifest)) {
	    $aggobj->SetStatus("failed");
	    $webtask->output("Could not get manifest from $urn");
	    $webtask->Exited(-1);
	    return -1;
	}
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
	# Web interface wants this as soon as possible.
	$aggobj->SetManifest($manifest);
	
	print "Forcing correct slice expiration\n";
	my $response = $aggobj->Extend($slice->ExpirationGMT());
	if (!defined($response) ||
	    $response->code() != GENIRESPONSE_SUCCESS) {
	    $aggobj->SetStatus("failed");
	    $webtask->output("Renew failed on $urn");
	    $webtask->Exited(-1);
	    print STDERR "Renew failed on $urn\n";
	    return -1;
	}
1340
	print "Calling SliverStart at $urn\n";
1341
	$response = $aggobj->SliverAction(\$errmsg, "start"); 
1342
	if (! defined($response)) {
1343
1344
1345
1346
1347
1348
	    $aggobj->SetStatus("failed");
	    $webtask->output($errmsg);
	    $webtask->Exited(-1);
	    print STDERR "SliverStart failed on $urn: $errmsg\n";
	    return -1;
	}
1349
1350
	$aggobj->SetPublicURL($response->logurl())
	    if (defined($response->logurl()));
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
	return 0;
    };
    
    my @return_codes = ();
    if (ParRun({"maxwaittime" => 99999,
		"maxchildren" => scalar(@aggregate_list)},
	       \@return_codes, $coderef, @aggregate_list)) {
	#
	# The parent caught a signal. Leave things intact so that we can
	# kill things cleanly later.
	#
	goto bad;
    }
    #
    # Check the exit codes; any failure is a total failure (for now).
    #
    foreach my $aggobj (@aggregate_list) {
	#
	# Have to refresh the sliver objects since they were updated in a fork.
	#
	$aggobj->Refresh();
	my $code = shift(@return_codes);
	if ($code) {
	    $webtask->output($aggobj->webtask()->output())
		if (defined($aggobj->webtask()->output()));
	    goto bad;
	}
    }
1379
1380
    system("/bin/rm -rf $tmpdir")
	if (!$debug && defined($tmpdir) && -e $tmpdir);
1381
1382
1383
    return 0;

  bad:
1384
1385
1386
1387
1388
1389
1390
1391
    #
    # Dump the stitcher output. Ick.
    #
    if (defined($tmpdir) && -e "$tmpdir/stitcher.log") {
	print "------------- Stitcher Log ---------------\n";
	system("/bin/cat $tmpdir/stitcher.log");
	print "-----------------------------------------\n";
    }
Leigh B Stoller's avatar
Leigh B Stoller committed
1392
1393
    system("/bin/rm -rf $tmpdir")
	if (!$debug && defined($tmpdir) && -e $tmpdir);
1394
1395
1396
    return -1;
}

1397
1398
1399
sub fatal($) {
    my ($mesg) = $_[0];

1400
1401
1402
1403
    $slice->Delete()
	if (defined($slice));
    $instance->SetStatus("failed")
	if (defined($instance));
1404

1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
    print STDERR "*** $0:\n".
	         "    $mesg\n";
    exit(-1);
}
sub UserError($) {
    my($mesg) = $_[0];

    AuditAbort()
	if (!$debug);
    print $mesg;
    exit(1);
}

1418