create_instance.in 19 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
my $xmlparse;
60 61 62 63

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

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

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

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

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

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

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

175 176 177
# Email record.
if (! $debug) {
    AuditStart(0, undef, LIBAUDIT_LOGTBLOGS()|LIBAUDIT_LOGONLY());
178
    AddAuditInfo("cc", "aptnet-logs\@flux.utah.edu");
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 206

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

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

211 212 213 214
if (defined($aggregate)) {
    $CMURN = $aggregate;
}
elsif ($utahddc) {
215
    $CMURN = $DDCURN;
216
}
217 218 219 220 221 222 223 224
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);
225
if (!defined($cm_authority)) {
226 227 228 229
    $cm_authority = GeniAuthority->CreateFromRegistry("cm", $CMURN);
    if (!defined($cm_authority)) {    
	fatal("Could not load CM authority object");
    }
230 231 232 233 234
}

#
# Must wrap the parser in eval since it exits on error.
#
235 236 237 238
$xmlparse = eval { XMLin($xmlfile,
			 VarAttr => 'name',
			 ContentKey => '-content',
			 SuppressEmpty => undef); };
239 240 241 242 243 244
fatal($@)
    if ($@);

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

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

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

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

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

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

412 413 414
if ($localuser) {
    my $emulab_user = $geniuser->emulab_user();
    if ($emulab_user->IsNonLocal()) {
415 416 417 418 419
	#
	# 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.
	#
420
	system("$UPDATEGENIUSER -s " . $emulab_user->uid());
421
	if (0) {
422 423 424
	    fatal("Could not update ssh keys for nonlocal user");
	}
    }
425 426
    elsif (!$emulab_user->isEmulab() && defined($sshkey) &&
	   !$emulab_user->LookupSSHKey($sshkey)) {
427 428 429 430 431 432
	#
	# 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. 
	#
433 434 435 436 437 438 439 440 441 442
	$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);
    }
443 444 445 446 447 448 449 450 451 452 453 454 455 456
    #
    # 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");
    }
457 458 459
}
elsif (!$localuser && defined($sshkey)) {
    #
460 461
    # 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.
462 463
    # We allow key reuse for existing users, see above.
    #
464 465 466
    $geniuser->DeleteKeys();
    $geniuser->AddKey($sshkey);
}
Leigh B Stoller's avatar
Leigh B Stoller committed
467
# There will be "internal" keys cause we pass the flag asking for them.
468
my @sshkeys;
Leigh B Stoller's avatar
Leigh B Stoller committed
469
if ($geniuser->GetKeyBundle(\@sshkeys, 1) < 0 || !@sshkeys) {
470 471 472 473 474 475
    fatal("No ssh keys to use for $geniuser!");
}

#
# Now generate a slice registration and credential
#
476 477
my $safe_uid    = $user_uid; $safe_uid =~ s/_/-/;
my $slice_id    = $safe_uid . "-QV" . TBGetUniqueIndex('next_quickvm', 1);
478 479 480
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"} : "");
481

482
print STDERR "\n";
483 484 485 486 487
print STDERR "User:    $user_urn\n";
print STDERR "Email:   $user_email" . (!$localuser ? " (guest)" : "") . "\n";
print STDERR "Profile: " . $profile_object->name() . ":${version}\n";
print STDERR "Slice:   $slice_urn\n";
print STDERR "Server:  $SERVER_NAME\n";
Leigh B Stoller's avatar
Leigh B Stoller committed
488
print STDERR "\n";
489 490
print STDERR "$rspecstr\n";

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 516
#
# 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");
}
517 518
# These get quick expirations, unless it is a real user.
if ($slice->SetExpiration(time() + (($localuser ? 16 : 3) * 3600)) != 0) {
519 520 521 522 523
    $slice->Delete();
    fatal("Could not set the slice expiration for $slice_urn");
}
my $slice_uuid = $slice->uuid();

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

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

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

#
# 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
600
    $instance->SetStatus("failed");
601 602 603 604 605 606 607 608 609
    if (defined($webtask)) {
	if (defined($response)) {
	    $webtask->output($response->output());
	    $webtask->Exited($response->code());
	}
	else {
	    $webtask->Exited(1);
	}
    }
610 611 612 613 614 615 616 617 618 619
    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();
620
    $webtask->Exited(1) if (defined($webtask));
Leigh B Stoller's avatar
Leigh B Stoller committed
621
    $instance->SetStatus("failed");
622 623
    fatal("Could not find the manifest in the response!");
}
Leigh B Stoller's avatar
Leigh B Stoller committed
624 625
$instance->SetStatus("provisioned");
$instance->SetManifest($manifest);
626 627 628 629

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

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)) {
651 652 653
	print STDERR "SliverStatus failed";
	if (defined($response)) {
	    print STDERR ": " . $response->output();
654 655 656
	    if (defined($webtask)) {
		$webtask->output($response->output());
	    }
657 658 659 660
	}
	print STDERR "\n";
	$failed = 1;
	last;
661 662 663 664 665
    }
    next
	if ($response->code() == GENIRESPONSE_BUSY);

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

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

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

704 705 706
    print STDERR Dumper($xmlparse)
	if (defined($xmlparse));

707 708 709 710 711 712 713 714 715 716 717 718 719
    print STDERR "*** $0:\n".
	         "    $mesg\n";
    exit(-1);
}
sub UserError($) {
    my($mesg) = $_[0];

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

720