create_instance.in 38.7 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 :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', '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
else {
    $rspecstr  = $profile->CheckFirewall(!$localuser);
300
301
}

302
303
304
#
# Update rspec with site aggregate urns.
#
305
306
307
308
309
if (keys(%{$sitemap})) {
    # SetSites will tell us if we must use stitcher.
    my $needstitcher = 0;
    
    if (APT_Profile::SetSites(\$rspecstr, $sitemap, \$needstitcher, \$errmsg)) {
310
311
	fatal($errmsg);
    }
312
313
314
315
316
    # but do not override command line force.
    $usestitcher = 1 if ($needstitcher);
}
elsif (APT_Profile::BindRspec(\$rspecstr, $default_aggregate_urn, \$errmsg)) {
    fatal($errmsg);
317
318
319
320
321
322
323
324
325
326
}
if (keys(%{$sitemap})) {
    foreach my $siteid (keys(%{$sitemap})) {
	push(@aggregate_urns, $sitemap->{$siteid})
    }
}
else {
    push(@aggregate_urns, $default_aggregate_urn);
}

327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
#
# 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.
#
if ($profile->CheckNodeConstraints($default_aggregate_urn, \$errmsg)) {
    UserError($errmsg);
}

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

#
# 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).
#
381
382
383
384
385
386
387
# 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) {
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
    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);
    }
408
409
410
411
}
else {
    $geniuser = GeniUser->Lookup($user_urn);

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

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

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

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

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

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

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

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

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

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

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

702
703
#
# Create a webtask so that we can store additional information about
704
# the sliver while we wait.
705
706
#
$webtask = WebTask->Create($instance->uuid());
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
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";
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738

#
# 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();
}
739
# Bind the process id.
740
741
$webtask->SetProcessID($PID);

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

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

766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
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;
790
    
791
	my $response = $aggobj->SliceStatus();
792
793
794
795
796
797
798
	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();
799
800
801
802
803
804
805
806
		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());
		}
807
	    }
808
809
810
	    print STDERR "\n";
	    $failed = 1;
	    last;
811
	}
812
813
814
	next
	    if ($response->code() == GENIRESPONSE_BUSY ||
		$response->code() == GENIRESPONSE_SERVER_UNAVAILABLE);
815

816
817
818
819
820
821
	$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.
	#
822
	my $statusblob = {};
823
824
	foreach my $urn (keys(%{$repblob->{'details'}})) {
	    my $details = $repblob->{'details'}->{$urn};
825
826
827
	    my $node_id = $details->{'client_id'};
	    $statusblob->{$node_id} = $details;
	}
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
	$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;
	}
844
    }
845
846
847
848
849
850
851
852
853
    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;
854
    }
855
856
857
858
859
860
861
862
    $aggobj->SetStatus("ready");
    $webtask->Exited(0);
    return 0;
}

#
# Okay, fire off the waits for each aggregate
#
863
my @return_codes = ();
864
865
866
867
868
869
870
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();
871
872
    print STDERR "Internal error in WaitForSlivers\n";
    $webtask->output("Internal error in WaitForSlivers");
873
874
875
876
    $instance->SetStatus("failed");
    $webtask->Exited(1);
    exit(-1);
}
877
print "$slice_urn\n";
878
879
880
881
882
883
884
885
886
887

#
# 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();
888
889
890
891
892
893
894
895
896
897
898
899
900
    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());
	}
    }
901
902
    if (defined($aggobj->public_url())) {
	print $aggobj->public_url() . "\n";
903
    }
904
905
    print "\n" . $aggobj->manifest() . "\n\n";
    print "------------------------------------------------------------\n\n";
906
}
907
$slice->UnLock();
908

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

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()) {
936
937
	    my $dataset_id = GeniXML::GetText("persistent", $blockref);
	    if (!defined($dataset_id)) {
938
		# persistent is deprecated.
939
		$dataset_id = GeniXML::GetText("dataset", $blockref);
940
	    }
941
942
943
944
945
946

	    #
	    # We only care about datasets here, we let the backend
	    # do the error checking on ephemeral blockstores.
	    #
	    next
947
948
949
950
951
952
953
954
955
956
		if (!defined($dataset_id));

	    my $class = GeniXML::GetText("class", $blockref);
	    if (!defined($class)) {
		$class = "remote";
	    }
	    # Image backed. No checking since the image has to be global
	    # anyway. Needs more thought. 
	    next
		if ($class eq "local");
957
	    
958
	    my ($authority, $type, $id) = GeniHRN::Parse($dataset_id);
959
960
961
962
963
964
965
966
967
968
	    #
	    # 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)) {
969
		$dataset = APT_Dataset->LookupByRemoteURN($dataset_id);
970
971
972
973
		if (!defined($dataset)) {
		    $$pmsg = "Persistent dataset '$pid/$id' does not exist";
		    return 1;
		}
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
	    }
	    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;
}

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
1118
1119
1120
1121
1122
1123
1124
#
# 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()
{
1125
    my $tmpdir        = mktemp("/tmp/stitcher.XXXXXX");
1126
1127
    my $slicecredfile = "$tmpdir/slicecred.xml";
    my $speaksforfile = "$tmpdir/speaksforcred.xml";
1128
    my $al2scredfile  = "$tmpdir/al2scred.xml";
1129
    my $rspecfile     = "$tmpdir/rspec.xml";
1130
1131
    my $stdoutfile    = "$tmpdir/stitcher.stdout";
    my $stderrfile    = "$tmpdir/stitcher.stderr";
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
    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 ".
1144
	"--al2scredfile $al2scredfile --debug ".
Leigh B Stoller's avatar
Leigh B Stoller committed
1145
1146
1147
	# We do not want these two files defaulting to user home dir.
	"--GetVersionCacheName=$tmpdir/get_version_cache.json ".
	"--AggNickCacheName=$tmpdir/agg_nick_cache ".
1148
1149
1150
1151
1152
1153
1154
	"--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"
1155
	if ($debug || $verbose);
1156
    print "Stitcher command: $command\n"
1157
	if ($debug || $verbose);
1158
1159
1160
1161
1162

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

    goto bad
Leigh B Stoller's avatar
Leigh B Stoller committed
1163
1164
1165
1166
	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"));
1167
1168
1169
1170
1171
1172
1173
1174

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

1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
    #
    # 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
1186
	$logfile->SetPublic(1);
1187
1188
1189
	$instance->SetLogFile($logfile);
    }

1190
1191
1192
1193
    #
    # 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
1194
    $instance->SetStatus("stitching");
1195
    system("cd $tmpdir; $command > $stdoutfile 2> $stderrfile");
1196
    if ($?) {
1197
	if (-s $stderrfile) {
1198
1199
	    my $stuff = `cat $stderrfile`;
	    $webtask->output($stuff);
1200
1201
1202
1203
1204
	    system("/bin/cat $stderrfile");
	}
	else {
	    $webtask->output("Stitcher failed!");
	}
1205
1206
1207
1208
1209
1210
1211
	#
	# 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;
    }
1212
1213
1214
1215
    if (defined($logfile)) {
	$logfile->Close();
	$logfile->Store();
    }
1216
1217
1218
1219
1220
1221
1222
1223
    
    #
    # 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;
1224
    my $al2smanifest;
1225
1226
1227
1228
1229
1230
1231
    opendir(DIR, $tmpdir);
    my @files  = readdir(DIR);
    closedir(DIR);

    foreach my $file (@files) {
	if ($file =~ /amlist.txt$/) {
	    $agglistfile = "$tmpdir/$file";
1232
1233
1234
	}
	elsif ($file =~ /manifest-rspec-al2s/) {
	    $al2smanifest = "$tmpdir/$file";
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
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
	}
    }
    #
    # 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();

1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
	#
	# 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");
1318
	    print STDERR $manifest_string . "\n";
1319
1320
	    return 0;
	}
1321
1322
1323
1324
1325
1326
1327
1328
	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
1329
	$aggobj->SetStatus("provisioned");
1330
1331
1332
1333
1334
1335
1336
1337
	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;
	}
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
	# 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;
	}
1351
	print "Calling SliverStart at $urn\n";
1352
	$response = $aggobj->SliverAction(\$errmsg, "start"); 
1353
	if (! defined($response)) {
1354
1355
1356
1357
1358
1359
	    $aggobj->SetStatus("failed");
	    $webtask->output($errmsg);
	    $webtask->Exited(-1);
	    print STDERR "SliverStart failed on $urn: $errmsg\n";
	    return -1;
	}
1360
1361
	$aggobj->SetPublicURL($response->logurl())
	    if (defined($response->logurl()));
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
	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;
	}
    }
1390
1391
#    system("/bin/rm -rf $tmpdir")
#	if (!$debug && defined($tmpdir) && -e $tmpdir);
1392
1393
1394
    return 0;

  bad:
1395
1396
1397
1398
1399
1400
1401
1402
    #
    # Dump the stitcher output. Ick.
    #
    if (defined($tmpdir) && -e "$tmpdir/stitcher.log") {
	print "------------- Stitcher Log ---------------\n";
	system("/bin/cat $tmpdir/stitcher.log");
	print "-----------------------------------------\n";
    }
1403
1404
#    system("/bin/rm -rf $tmpdir")
#	if (!$debug && defined($tmpdir) && -e $tmpdir);
1405
1406
1407
    return -1;
}

1408
1409
1410
sub fatal($) {
    my ($mesg) = $_[0];

1411
1412
1413
1414
    $slice->Delete()
	if (defined($slice));
    $instance->SetStatus("failed")
	if (defined($instance));
1415

1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
    print STDERR "*** $0:\n".
	         "    $mesg\n";
    exit(-1);
}
sub UserError($) {
    my($mesg) = $_[0];

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

1429