All new accounts created on Gitlab now require administrator approval. If you invite any collaborators, please let Flux staff know so they can approve the accounts.

create_instance.in 18.9 KB
Newer Older
1 2
#!/usr/bin/perl -w
#
Leigh B Stoller's avatar
Leigh B Stoller committed
3
# Copyright (c) 2008-2014 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 32 33
# 
# {{{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;
use Getopt::Std;
use XML::Simple;
34
use File::Temp qw(tempfile :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] [-a aggregate] <xmlfile>\n";
44 45
    exit(1);
}
46
my $optlist = "dvu:a:t:f";
47 48
my $debug   = 0;
my $verbose = 1;
49 50
my $utahddc = 1;
my $DDCURN  = "urn:publicid:IDN+utahddc.geniracks.net+authority+cm";
51
my $xmlfile;
52 53 54
my $webtask;
my $webtask_id;
my $foreground = 0;
55
my $localuser  = 0;
56
my $quickuuid;
57
my $aggregate;
58
my $this_user;
59 60 61 62

# Protos
sub fatal($);
sub UserError($);
63
sub SnapShot($$$);
64
sub GenCredentials($$$$);
65 66 67 68 69 70 71 72

#
# Configure variables
#
my $TB		  = "@prefix@";
my $TBOPS         = "@TBOPSEMAIL@";
my $TBLOGS        = "@TBLOGSEMAIL@";
my $OURDOMAIN     = "@OURDOMAIN@";
73
my $MAINSITE      = @TBMAINSITE@;
74 75 76 77
my $PGENIDOMAIN   = "@PROTOGENI_DOMAIN@";
my $SACERT	  = "$TB/etc/genisa.pem";
my $CMCERT	  = "$TB/etc/genicm.pem";
my $SSHKEYGEN     = "/usr/bin/ssh-keygen";
78
my $SSHSETUP      = "$TB/sbin/aptssh-setup";
79
my $ADDPUBKEY     = "$TB/sbin/addpubkey";
80
my $UPDATEGENIUSER= "$TB/sbin/protogeni/updategeniuser";
81 82 83 84 85 86 87 88 89 90 91 92 93 94

# 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";
use libtestbed;
use libaudit;
Leigh B Stoller's avatar
Leigh B Stoller committed
95
use APT_Profile;
Leigh B Stoller's avatar
Leigh B Stoller committed
96
use APT_Instance;
97
use APT_Geni;
98 99 100 101 102 103 104 105 106 107 108 109
use User;
use OSinfo;
use emutil;
use GeniDB;
use GeniUser;
use GeniCertificate;
use GeniCredential;
use GeniSlice;
use GeniAuthority;
use GeniHRN;
use Genixmlrpc;
use GeniResponse;
110
use GeniXML;
111
use WebTask;
112 113 114 115 116 117 118 119 120

#
# Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments.
#
my %options = ();
if (! getopts($optlist, \%options)) {
    usage();
}
121 122 123
if (defined($options{"a"})) {
    $aggregate = $options{"a"};
}
124 125 126 127 128 129
if (defined($options{"d"})) {
    $debug = 1;
}
if (defined($options{"v"})) {
    $verbose = 1;
}
130 131 132 133 134 135
if (defined($options{"f"})) {
    $foreground = 1;
}
if (defined($options{"t"})) {
    $webtask_id = $options{"t"};
}
136 137 138
if (defined($options{"u"})) {
    $quickuuid = $options{"u"};
}
139
if (@ARGV < 1) {
140 141
    usage();
}
142
$xmlfile = shift(@ARGV);
143

144 145 146 147 148 149
#
# Check the filename when invoked from the web interface; must be a
# file in /tmp.
#
if (getpwuid($UID) ne "nobody") {
    $this_user = User->ThisUser();
150

151 152 153 154 155 156 157 158 159 160 161
    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");
162 163
    }

164 165 166 167 168 169 170
    # Use realpath to resolve any symlinks.
    my $translated = realpath($xmlfile);
    if ($translated =~ /^(\/tmp\/[-\w\.\/]+)$/) {
	$xmlfile = $1;
    }
    else {
	fatal("Bad data in translated pathname: $xmlfile");
171 172 173
    }
}

174 175 176
# Email record.
if (! $debug) {
    AuditStart(0, undef, LIBAUDIT_LOGTBLOGS()|LIBAUDIT_LOGONLY());
177
    AddAuditInfo("cc", "aptnet-logs\@flux.utah.edu");
178
}
179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205

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

#
# We want to contact our local CM to create the sliver.
# We use the normal XMLRPC route.
#
my $context = Genixmlrpc->Context($sa_certificate);
if (!defined($context)) {
    fatal("Could not create context to talk to CM");
}
Genixmlrpc->SetContext($context);

#
206
# Load the CM authority, since that is who we talk to.
207
#
208 209
my $CMURN;

210 211 212 213
if (defined($aggregate)) {
    $CMURN = $aggregate;
}
elsif ($utahddc) {
214
    $CMURN = $DDCURN;
215
}
216 217 218 219 220 221 222 223
else {
    my $cm_certificate = GeniCertificate->LoadFromFile($CMCERT);
    if (!defined($cm_certificate)) {
	fatal("Could not load certificate from $CMCERT\n");
    }
    $CMURN = $cm_certificate->urn();
}
my $cm_authority = GeniAuthority->Lookup($CMURN);
224
if (!defined($cm_authority)) {
225 226 227 228
    $cm_authority = GeniAuthority->CreateFromRegistry("cm", $CMURN);
    if (!defined($cm_authority)) {    
	fatal("Could not load CM authority object");
    }
229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245
}

#
# Must wrap the parser in eval since it exits on error.
#
my $xmlparse = eval { XMLin($xmlfile,
			    VarAttr => 'name',
			    ContentKey => '-content',
			    SuppressEmpty => undef); };
fatal($@)
    if ($@);
print STDERR Dumper($xmlparse)
    if ($debug || $verbose);

#
# Make sure all the required arguments were provided.
#
246
foreach my $key ("username", "email", "profile") {
247 248 249 250 251 252 253 254 255
    fatal("Missing required attribute '$key'")
	if (! (exists($xmlparse->{'attribute'}->{"$key"}) &&
	       defined($xmlparse->{'attribute'}->{"$key"}) &&
	       $xmlparse->{'attribute'}->{"$key"} ne ""));
}

#
# Gather up args and sanity check.
#
256 257
my ($value, $user_urn, $user_uid, $user_hrn, $user_email,
    $sshkey, $profile, $version);
258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280

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

#
# Not many choices; see if it exists.
#
Leigh B Stoller's avatar
Leigh B Stoller committed
281
$value = $xmlparse->{'attribute'}->{"profile"}->{'value'};
282
# This is a safe lookup.
Leigh B Stoller's avatar
Leigh B Stoller committed
283 284
my $profile_object = APT_Profile->Lookup($value);
if (!defined($profile_object)) {
Leigh B Stoller's avatar
Leigh B Stoller committed
285
    fatal("No such profile: $value");
286
}
287
my $rspecstr = $profile_object->CheckFirewall(!$localuser);
288 289
$profile = $profile_object->profileid();
$version = $profile_object->version();
290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311

#
# 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!");
	}
    }
312 313
    close($fh);
    unlink($keyfile);
314
}
315 316
chomp($sshkey)
    if (defined($sshkey));
317 318 319 320 321 322

#
# 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).
#
323 324 325 326 327 328 329
# 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) {
330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349
    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);
    }
350 351 352 353
}
else {
    $geniuser = GeniUser->Lookup($user_urn);

354 355 356
    #
    # In Utah, check for alternate SA
    #
357
    if (!defined($geniuser) && $MAINSITE) {
358 359
	$user_urn = GeniHRN::Generate("aptlab.net", "user", $user_uid);
	$user_hrn = "aptlab.${user_uid}";
360
	$geniuser = GeniUser->Lookup($user_urn, 0);
361 362
    }
}
363
if (!defined($geniuser)) {
364 365 366
    if ($localuser) {
	fatal("Could not lookup local user $user_urn");
    }
367
    
368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384
    #
    # 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");
    }
385 386 387 388 389 390 391 392
    my $blob = {"urn"      => $user_urn,
		"hrn"      => $user_hrn,
		"email"    => $user_email,
		"showuuid" => 1};
    if ($MAINSITE) {
	$blob->{'useaptca'} = 1;
    }
    my $certificate = GeniCertificate->Create($blob);
393 394 395 396 397 398 399 400 401 402
    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
403
    # Setup browser ssh.
404
    #
405 406 407
    system("$SSHSETUP " . $geniuser->uuid());
    fatal("Could not create ssh key pair")
	if ($?);
408 409 410 411
}
my $user_uuid = $geniuser->uuid();
# So we know this user has dome something lately.
$geniuser->BumpActivity();
412

413 414 415
if ($localuser) {
    my $emulab_user = $geniuser->emulab_user();
    if ($emulab_user->IsNonLocal()) {
416 417 418 419 420
	#
	# A user created from a Geni certificate via geni-login. We
	# ask for the current ssh keys from the MA. They are stored
	# into the DB by the update script.
	#
421
	system("$UPDATEGENIUSER -s " . $emulab_user->uid());
422
	if (0) {
423 424 425
	    fatal("Could not update ssh keys for nonlocal user");
	}
    }
426 427
    elsif (!$emulab_user->isEmulab() && defined($sshkey) &&
	   !$emulab_user->LookupSSHKey($sshkey)) {
428 429 430 431 432 433
	#
	# A local user created via the APT/Cloud interface. Rather then
	# edit keys via the old web UI, they can change their one key
	# by putting a new one in the web form. If the gave us a new one,
	# insert it after deleting the old one. 
	#
434 435 436 437 438 439 440 441 442 443
	$emulab_user->DeleteSSHKeys();
	my ($fh, $keyfile) = tempfile(UNLINK => 0);
	print $fh $sshkey;

	if (system("$ADDPUBKEY -u $user_uid -f $keyfile")) {
	    fatal("Could not add new ssh pubkey");
	}
	close($fh);
	unlink($keyfile);
    }
444 445 446 447 448 449 450 451 452 453 454 455 456 457
    #
    # 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");
    }
458 459 460
}
elsif (!$localuser && defined($sshkey)) {
    #
461 462
    # 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 interface.
463 464
    # We allow key reuse for existing users, see above.
    #
465 466 467
    $geniuser->DeleteKeys();
    $geniuser->AddKey($sshkey);
}
Leigh B Stoller's avatar
Leigh B Stoller committed
468
# There will be "internal" keys cause we pass the flag asking for them.
469
my @sshkeys;
Leigh B Stoller's avatar
Leigh B Stoller committed
470
if ($geniuser->GetKeyBundle(\@sshkeys, 1) < 0 || !@sshkeys) {
471 472 473 474 475 476
    fatal("No ssh keys to use for $geniuser!");
}

#
# Now generate a slice registration and credential
#
477 478
my $safe_uid    = $user_uid; $safe_uid =~ s/_/-/;
my $slice_id    = $safe_uid . "-QV" . TBGetUniqueIndex('next_quickvm', 1);
479 480 481
my $slice_urn   = GeniHRN::Generate($OURDOMAIN, "slice", $slice_id);
my $slice_hrn   = "${PGENIDOMAIN}.${slice_id}";
my $SERVER_NAME = (exists($ENV{"SERVER_NAME"}) ? $ENV{"SERVER_NAME"} : "");
482

483 484
print STDERR "\n";
print STDERR "$user_urn\n";
Leigh B Stoller's avatar
Leigh B Stoller committed
485
print STDERR "$slice_urn\n";
486
print STDERR "$SERVER_NAME\n";
Leigh B Stoller's avatar
Leigh B Stoller committed
487
print STDERR "\n";
488 489
print STDERR "$rspecstr\n";

490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515
#
# 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.
my $slice = GeniSlice->Create($slice_certificate,
			      $geniuser, $sa_authority, undef, 1);
if (!defined($slice)) {
    $slice_certificate->Delete();
    fatal("Could not create new slice object for $slice_urn");
}
516 517
# These get quick expirations, unless it is a real user.
if ($slice->SetExpiration(time() + (($localuser ? 16 : 3) * 3600)) != 0) {
518 519 520 521 522
    $slice->Delete();
    fatal("Could not set the slice expiration for $slice_urn");
}
my $slice_uuid = $slice->uuid();

523
#
524
# Generate credentials we need.
525
#
526
my ($slice_credential, $speaksfor_credential) =
527
    APT_Geni::GenCredentials($slice, $geniuser);
528 529
if (! (defined($speaksfor_credential) &&
       defined($slice_credential))) {
530
    $slice->Delete();
531
    fatal("Could not generate credentials");
532 533
}

534
#
535
# Got this far, lets create a quickvm record.
536
#
537
my $quickvm_uuid = (defined($quickuuid) ? $quickuuid : NewUUID());
538 539 540
if (!defined($quickvm_uuid)) {
    fatal("Could not generate a new uuid");
}
Leigh B Stoller's avatar
Leigh B Stoller committed
541
my $instance = APT_Instance->Create({'uuid'         => $quickvm_uuid,
542 543
				     'profile_id'   => $profile,
				     'profile_version' => $version,
Leigh B Stoller's avatar
Leigh B Stoller committed
544 545 546 547
				     'slice_uuid'   => $slice_uuid,
				     'creator'      => $geniuser->uid(),
				     'creator_idx'  => $geniuser->idx(),
				     'creator_uuid' => $geniuser->uuid(),
548
				     'aggregate_urn'=> $CMURN,
549 550
				     'status'       => "created",
				     'servername'   => $SERVER_NAME});
Leigh B Stoller's avatar
Leigh B Stoller committed
551
if (!defined($instance)) {
552
    $slice->Delete();
Leigh B Stoller's avatar
Leigh B Stoller committed
553
    fatal("Could not create instance record for $quickvm_uuid");
554
}
555 556 557 558 559 560 561
#
# Create a webtask so that we can store additional information about
# the sliver while we wait. No worries if this fails.
#
$webtask = WebTask->Create($instance->uuid());
$webtask->AutoStore(1)
    if (defined($webtask));
562 563 564 565 566 567 568 569 570 571 572 573 574 575 576

#
# 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();
}
577 578 579
# Bind the process id.
$webtask->SetProcessID($PID)
    if (defined($webtask));
580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598

#
# This creates the sliver and starts it.
#
my $response =
    Genixmlrpc::CallMethod($cm_authority->url(), undef,
			   "CreateSliver",
			   { "slice_urn"   => $slice_urn,
			     "rspec"       => $rspecstr,
			     "keys"        =>
				 [{'urn'   => $user_urn,
				   'login' => $user_uid,
				   'keys'  => \@sshkeys }],
			     "credentials" =>
				 [$slice_credential->asString(),
				  $speaksfor_credential->asString()]});

if (!defined($response) || $response->code() != GENIRESPONSE_SUCCESS) {
    $slice->Delete();
Leigh B Stoller's avatar
Leigh B Stoller committed
599
    $instance->SetStatus("failed");
600 601 602 603 604 605 606 607 608
    if (defined($webtask)) {
	if (defined($response)) {
	    $webtask->output($response->output());
	    $webtask->Exited($response->code());
	}
	else {
	    $webtask->Exited(1);
	}
    }
609 610 611 612 613 614 615 616 617 618
    fatal("CreateSliver failed: ".
	  (defined($response) ? $response->output() : "") . "\n");
}

#
# We are going to use the manifests table.
#
my $manifest = $response->value()->[1];
if (!defined($manifest)) {
    $slice->UnLock();
619
    $webtask->Exited(1) if (defined($webtask));
Leigh B Stoller's avatar
Leigh B Stoller committed
620
    $instance->SetStatus("failed");
621 622
    fatal("Could not find the manifest in the response!");
}
Leigh B Stoller's avatar
Leigh B Stoller committed
623 624
$instance->SetStatus("provisioned");
$instance->SetManifest($manifest);
625 626 627 628

#
# but have to wait for the sliver to be ready, which means polling.
#
Leigh B Stoller's avatar
Leigh B Stoller committed
629
my $seconds  = 1500;
630 631 632
my $interval = 15;
my $ready    = 0;
my $failed   = 0;
633
my $public_url;
634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649

while ($seconds > 0) {
    sleep($interval);
    $seconds -= $interval;
    
    my $response =
	Genixmlrpc::CallMethod($cm_authority->url(), undef,
			       "SliverStatus",
			       { "slice_urn"   => $slice_urn,
				 "credentials" =>
				     [$slice_credential->asString(),
				      $speaksfor_credential->asString()]});

    if (!defined($response) || !defined($response->value()) ||
	($response->code() != GENIRESPONSE_SUCCESS &&
	 $response->code() != GENIRESPONSE_BUSY)) {
650 651 652
	print STDERR "SliverStatus failed";
	if (defined($response)) {
	    print STDERR ": " . $response->output();
653 654 655
	    if (defined($webtask)) {
		$webtask->output($response->output());
	    }
656 657 658 659
	}
	print STDERR "\n";
	$failed = 1;
	last;
660 661 662 663 664
    }
    next
	if ($response->code() == GENIRESPONSE_BUSY);

    my $blob = $response->value();
665 666 667
    if (exists($blob->{'public_url'})) {
	$public_url = $blob->{'public_url'};
    }
668 669 670 671 672 673 674 675 676
    if ($blob->{'status'} eq "ready") {
	$ready = 1;
	last;
    }
    elsif ($blob->{'status'} eq "failed") {
	$failed = 1;
	last;
    }
}
677 678 679 680 681 682
print STDERR "$slice_urn\n";
print STDERR "$public_url\n"
    if (defined($public_url));
print STDERR "\n";
print STDERR "$manifest\n\n";

683
if ($failed || !$ready) {
Leigh B Stoller's avatar
Leigh B Stoller committed
684
    $instance->SetStatus("failed");
685 686 687 688 689 690
    if (!$ready) {
	print STDERR "$slice_urn timed out.\n";
    }
    else {
	print STDERR "$slice_urn failed.\n"; 
    }
691
    $webtask->Exited(1) if (defined($webtask));
692 693 694
}
else {
    $instance->SetStatus("ready");
695
    $webtask->Exited(0) if (defined($webtask));
696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715
}
$slice->UnLock();
exit(0);

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

    print STDERR "*** $0:\n".
	         "    $mesg\n";
    exit(-1);
}
sub UserError($) {
    my($mesg) = $_[0];

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

716