manage_reservations.in 24.4 KB
Newer Older
1 2
#!/usr/bin/perl -w
#
3
# Copyright (c) 2000-2017 University of Utah and the Flux Group.
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38
# 
# {{{EMULAB-LICENSE
# 
# This file is part of the Emulab network testbed software.
# 
# This file is free software: you can redistribute it and/or modify it
# under the terms of the GNU Affero General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
# 
# This file is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Affero General Public
# License for more details.
# 
# You should have received a copy of the GNU Affero General Public License
# along with this file.  If not, see <http://www.gnu.org/licenses/>.
# 
# }}}
#
use English;
use strict;
use Getopt::Std;
use XML::Simple;
use Data::Dumper;
use CGI;
use POSIX ":sys_wait_h";
use Date::Parse;

#
# Back-end script to manage APT profiles.
#
sub usage()
{
    print("Usage: manage_reservations [-a <urn>] list [-u uid | -p pid]\n");
Leigh B Stoller's avatar
Leigh B Stoller committed
39 40
    print("Usage: manage_reservations [-a <urn>] delete pid uuid\n");
    print("Usage: manage_reservations [-a <urn>] approve -p portal uuid\n");
41
    print("Usage: manage_reservations [-a <urn>] systeminfo\n");
Leigh B Stoller's avatar
Leigh B Stoller committed
42
    print("Usage: manage_reservations [-a <urn>] prediction\n");
43 44 45 46 47 48 49
    exit(-1);
}
my $optlist     = "dt:a:";
my $debug       = 0;
my $webtask_id;
my $webtask;
my $authority;
50
my $aggregate;
51 52 53 54 55 56 57

#
# Configure variables
#
my $TB		= "@prefix@";
my $TBOPS       = "@TBOPSEMAIL@";
my $OURDOMAIN	= "@OURDOMAIN@";
Leigh B Stoller's avatar
Leigh B Stoller committed
58
my $ANNOUNCE    = "$TB/sbin/announce";
59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78
my $MYURN	= "urn:publicid:IDN+${OURDOMAIN}+authority+cm";

#
# Untaint the path
#
$ENV{'PATH'} = "$TB/bin:$TB/sbin:/bin:/usr/bin:/usr/bin:/usr/sbin";
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

#
# Turn off line buffering on output
#
$| = 1;

#
# Load the Testbed support stuff.
#
use lib "@prefix@/lib";
use EmulabConstants;
use emdb;
use emutil;
79
use Brand;
80 81 82 83 84 85 86 87
use User;
use Project;
use Reservation;
use EmulabConstants;
use libEmulab;
use libtestbed;
use WebTask;
use APT_Geni;
88
use APT_Aggregate;
89 90 91 92 93 94 95 96
use GeniResponse;
use GeniUser;

# Protos
sub fatal($);
sub DoReserve();
sub DoList();
sub DoDelete();
97 98
sub DoApprove();
sub DoSystemInfo();
Leigh B Stoller's avatar
Leigh B Stoller committed
99
sub DoPrediction();
100
sub readfile($);
101
sub AddAnnouncement($$$$$$$);
Leigh B Stoller's avatar
Leigh B Stoller committed
102
sub DeleteAnnouncement($);
103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132

#
# Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments.
#
my %options = ();
if (! getopts($optlist, \%options)) {
    usage();
}
if (defined($options{"t"})) {
    $webtask_id = $options{"t"};
    $webtask = WebTask->Lookup($webtask_id);
    if (!defined($webtask)) {
	fatal("Could not lookup webtask $webtask_id");
    }
    # Convenient.
    $webtask->AutoStore(1);
}
if (defined($options{"d"})) {
    $debug++;
}
if (@ARGV < 1) {
    usage();
}
my $action = shift(@ARGV);

#
# Default to local cluster
#
if (defined($options{"a"})) {
133 134 135 136 137 138
    if (GeniHRN::IsValid($options{"a"})) {
	$aggregate = APT_Aggregate->Lookup($options{"a"});
    }
    else {
	$aggregate = APT_Aggregate->LookupByNickname($options{"a"});
    }
139 140
}
else {
141
    $aggregate = APT_Aggregate->Lookup($MYURN);
142
}
Leigh B Stoller's avatar
Leigh B Stoller committed
143 144 145
if (!defined($aggregate)) {
    fatal("Could not lookup aggregate");
}
146 147 148 149
$authority = APT_Geni::GetAuthority($aggregate->urn());
if (!defined($authority)) {
    fatal("Could not look up authority");
}
Leigh B Stoller's avatar
Leigh B Stoller committed
150

151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166
# For credentials.
my $this_user = User->ThisUser();
if (! defined($this_user)) {
    fatal("You ($UID) do not exist!");
}
my $geniuser = GeniUser->CreateFromLocal($this_user);

if ($action eq "reserve") {
    DoReserve();
}
elsif ($action eq "list") {
    DoList();
}
elsif ($action eq "delete") {
    DoDelete();
}
167 168 169 170 171 172
elsif ($action eq "approve") {
    DoApprove();
}
elsif ($action eq "systeminfo") {
    DoSystemInfo();
}
Leigh B Stoller's avatar
Leigh B Stoller committed
173 174 175
elsif ($action eq "prediction") {
    DoPrediction();
}
176 177 178 179 180 181 182 183 184 185 186 187 188
else {
    usage();
}
exit(0);

#
# Create a reservation.
#
sub DoReserve()
{
    #
    # We allow for a user or project argument.
    #
189
    my $optlist = "t:s:e:nN:u:p:";
190 191
    my ($start, $end, $type, $reason, $update);
    my $checkonly = 0;
192 193
    my $portal;
    my $brand;
194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218
    my %rpcargs = ();
    my $context;
    my ($credential,$speaksfor);
    
    my %options = ();
    if (! getopts($optlist, \%options)) {
	usage();
    }
    usage()
	if (@ARGV < 2);
    my $project = Project->Lookup($ARGV[0]);
    my $count   = $ARGV[1];

    if (defined($options{"s"})) {
	$start = $options{"s"};
    }
    if (defined($options{"e"})) {
	$end = $options{"e"};
    }
    if (defined($options{"t"})) {
	$type = $options{"t"};
    }
    if (defined($options{"u"})) {
	$update = $options{"u"};
    }
219 220 221
    if (defined($options{"p"})) {
	$portal = $options{"p"};
    }
222 223 224 225 226 227 228
    if (defined($options{"N"})) {
	$reason = readfile($options{"N"});
    }
    if (defined($options{"n"})) {
	$checkonly = 1;
    }
    usage()
229
	if (!defined($project));
230 231 232 233 234
    # Need brand for email. No portal argument means emulab brand.
    $brand = Brand->Create($portal);
    if (!defined($brand)) {
	fatal("Bad branding");
    }
235 236 237
    if (defined($update)) {
	usage()
	    if (! (defined($count) || defined($start) || defined($end)));
238
    }
239 240
    else {
	usage()
241
	    if (! (defined($count) && defined($type) && defined($end)));
242 243 244 245 246 247 248
	
	if ($type !~ /^[-\w]+$/) {
	    fatal("Type is not a string");
	}
    }
    if (defined($count) && $count !~ /^\d+$/) {
	fatal("Count is not an integer");
249
    }
250 251 252
    if (defined($start) &&
	!($start =~ /^\d+$/ || str2time($start))) {
	fatal("Start is not a unix timestamp or datetime");
253
    }
254 255 256
    if (defined($end) &&
	!($end =~ /^\d+$/ || str2time($end))) {
	fatal("End is not a unix timestamp or datetime");
257
    }
258 259 260 261
    $rpcargs{"start"} = TBDateStringGMT($start) if (defined($start));
    $rpcargs{"end"}   = TBDateStringGMT($end) if (defined($end));
    $rpcargs{"count"} = $count if (defined($count));
    $rpcargs{"type"}  = $type if (!defined($update));
262 263 264 265 266 267 268
    $rpcargs{"check"} = $checkonly;
    $rpcargs{"reason"}= $reason if (defined($reason));
    $rpcargs{"update"}= $update if (defined($update));
    
    if ($this_user->IsAdmin()) {
	#
	# We do not have a very good notion of cross site admin.
269 270
	# So first we make sure that the user exists at the cluster
	# and then we make an "admin" call as the root authority.
271
	#
272 273 274
	if (APT_Geni::CreatePortalUser($authority, $geniuser)) {
	    fatal("Could not create admin user at remote cluster");
	}
275
	$rpcargs{"project_urn"} = $project->urn()->asString();
276
	$rpcargs{"user_urn"} = $geniuser->urn()->asString();
277 278 279 280 281 282 283
    }
    else {
	if (!$project->AccessCheck($this_user, TB_PROJECT_CREATEEXPT())) {
	    fatal("No permission to access reservation list for $project")
	}
	($credential,$speaksfor) =
	    APT_Geni::GenProjectCredential($project, $geniuser);
284 285 286 287 288 289 290 291 292

	fatal("Could not generate credentials")
	    if (!defined($credential));
	my $credentials = [$credential->asString()];
	if (defined($speaksfor)) {
	    $credentials = [@$credentials, $speaksfor->asString()];
	}
	$rpcargs{"credentials"} = $credentials;
	$context = APT_Geni::GeniContext();
293 294 295 296 297
    }
    my $response =
	APT_Geni::PortalRPC($authority, $context, "Reserve", \%rpcargs);
    if (GeniResponse::IsError($response)) {
	#
Leigh B Stoller's avatar
Leigh B Stoller committed
298
	# Watch for a refused error, we want to tell the user that.
299
	#
Leigh B Stoller's avatar
Leigh B Stoller committed
300 301 302
	if ($response->code() == GENIRESPONSE_REFUSED) {
	    UserError($response->output());
	}
303 304 305
	fatal($response->output());
    }
    print Dumper($response);
306 307 308 309 310 311 312
    #
    # Exit with different status if the reservation is feasible but
    # needs to be approved. The value is a boolean indicating
    # approved.  Note that this applies even in "check" mode; the
    # approval code indicates if the request is feasible and will be
    # immediately approved.
    #
Leigh B Stoller's avatar
Leigh B Stoller committed
313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334
    my $approved;
    my $uuid;
    my $idx;

    if (ref($response->value()) eq "HASH") {
	my $blob  = $response->value();
	$approved = $blob->{'approved'};
	$uuid     = $blob->{'uuid'} if (exists($blob->{'uuid'}));
	$idx      = $blob->{'idx'} if (exists($blob->{'idx'}));
	if (defined($idx) && $idx !~ /^\d*$/) {
	    fatal("Bad format for index from cluster");
	}
	if (defined($uuid) && !ValidUUID($uuid)) {
	    fatal("Bad format for uuid from cluster");
	}
    }
    else {
	# Backwards compat.
	$approved = $response->value();
    }
    if ($checkonly) {
	exit($approved ? 0 : 2);
335 336 337 338 339 340 341 342
    }
    #
    # Needs to be approved, exit with special status.
    #
    # If this was not $checkonly, then we want to send email locally
    # since the email was generated to the tbops but not the portal
    # email lists.
    #
Leigh B Stoller's avatar
Leigh B Stoller committed
343
    if (!$approved) {
344 345 346 347 348 349 350 351 352 353
	my $this_uid   = $this_user->uid();
	my $this_email = $this_user->email();
	my $url        = $brand->wwwBase() . "/list-reservations.php";
    
	$brand->SendEmail($brand->ExtensionsEmailAddress(),
	  "Pending reservation request needs approval",
	  "A reservation request was made by $this_uid, but it needs approval.".
	  "\n\n".
	  "See: $url", $this_email);
    }
Leigh B Stoller's avatar
Leigh B Stoller committed
354 355 356 357
    elsif (defined($uuid)) {
	#
	# Schedule an announcement for the user.
	#
358
	AddAnnouncement($portal, $brand, $uuid, $this_user, $count, $type, $start);
Leigh B Stoller's avatar
Leigh B Stoller committed
359 360 361 362 363 364 365
    }
    if (defined($webtask)) {
	$webtask->approved($approved);
	$webtask->idx($idx) if (defined($idx));
	$webtask->uuid($uuid) if (defined($uuid));
    }
    exit($approved ? 0 : 2);
366 367 368 369 370 371 372 373 374 375 376 377
}

#
# Ask for a list of reservations.
#
sub DoList()
{
    #
    # We allow for a user or project argument.
    #
    my $optlist = "u:p:Ai:";
    my $anon    = 0;
Leigh B Stoller's avatar
Leigh B Stoller committed
378
    my $uuid;
379
    my $project;
380
    my $user;
381 382 383 384 385 386 387 388 389 390 391
    my %rpcargs = ();
    my $context;
    
    my %options = ();
    if (! getopts($optlist, \%options)) {
	usage();
    }
    if (defined($options{"A"})) {
	$anon = 1;
    }
    if (defined($options{"i"})) {
Leigh B Stoller's avatar
Leigh B Stoller committed
392
	$uuid = $options{"i"};
393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410
    }
    if (defined($options{"u"})) {
	$user = User->Lookup($options{"u"});
	if (!defined($user)) {
	    fatal("No such user");
	}
	if (!$this_user->IsAdmin() && !$this_user->SameUser($user)) {
	    fatal("No permission to access reservation list for $user")
	}
	$geniuser = $this_user->CreateFromLocal($user);
    }
    if (defined($options{"p"})) {
	$project = Project->Lookup($options{"p"});

	if (!defined($project)) {
	    fatal("No such project");
	}
	if (!$this_user->IsAdmin() &&
411
	    !$project->AccessCheck($this_user, TB_PROJECT_CREATEEXPT())) {
412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441
	    fatal("No permission to access reservation list for $project")
	}
    }
    if ($this_user->IsAdmin() || $anon) {
	#
	# We do not have a very good notion of cross site admin. Get
	# the entire list, we will filter here.
	#
    }
    else {
	my ($credential,$speaksfor);
	
	if (defined($project)) {
	    ($credential,$speaksfor) =
		APT_Geni::GenProjectCredential($project, $geniuser);
	}
	else {
	    ($credential,$speaksfor) =
		APT_Geni::GenUserCredential($geniuser);
	}
	fatal("Could not generate credentials")
	    if (!defined($credential));
	
	my $credentials = [$credential->asString()];
	if (defined($speaksfor)) {
	    $credentials = [@$credentials, $speaksfor->asString()];
	}
	$rpcargs{"credentials"} = $credentials;
	$context = APT_Geni::GeniContext();
    }
Leigh B Stoller's avatar
Leigh B Stoller committed
442 443
    if (defined($uuid)) {
	$rpcargs{"uuid"} = $uuid;
444 445 446 447 448 449 450 451 452 453 454 455 456 457 458
    }
    my $response =
	APT_Geni::PortalRPC($authority, $context, "Reservations", (\%rpcargs));
    if (GeniResponse::IsError($response)) {
	#
	# All errors are fatal.
	#
	fatal($response->output());
    }
    my $list = $response->value()->{'reservations'};
    #
    # Map remote URNs to local projects and users. Not all of them can
    # be mapped of course, we leave those as is. 
    #
    foreach my $details (values(%$list)) {
459
	my $userhrn  = GeniHRN->new($details->{'user'});
460
	my $geniuser = GeniUser->Lookup($details->{'user'}, 1);
461
	if (defined($geniuser) && $geniuser->IsLocal()) {
462
	    #print Dumper($geniuser);
463
	    $details->{'uid'}     = $geniuser->uid();
464
	    $details->{'uid_idx'} = $geniuser->idx();
465
	}
466 467 468
	else {
	    $details->{'uid'}     = $userhrn->id();
	}
469 470 471 472 473 474 475 476
	my $projhrn = GeniHRN->new($details->{'project'});
	if ($projhrn->domain() eq $OURDOMAIN && defined($projhrn->project())) {
	    my $project = Project->Lookup($projhrn->project());
	    if (defined(($project))) {
		$details->{'pid'}     = $project->pid();
		$details->{'pid_idx'} = $project->pid_idx();
	    }
	}
477 478 479
	else {
	    $details->{'pid'} = $projhrn->id();
	}
480 481 482 483 484
    }
    #
    # Strip out unwanted results if we asked as an admin for a specific
    # user or project.
    #
485 486 487 488 489
    if ($this_user->IsAdmin() && (defined($project) || defined($user))) {
	my $tmp = {};
	
	foreach my $key (keys(%$list)) {
	    my $details = $list->{$key};
490

491 492 493 494 495 496 497 498 499 500 501 502
	    if (defined($project)) {
		next
		    if (!defined($details->{'pid_idx'}) ||
			$details->{'pid_idx'} != $project->pid_idx());
	    }
	    else {
		next
		    if (!defined($details->{'uid_idx'}) ||
			$details->{'uid_idx'} != $user->uid_idx());
	    }
	    $tmp->{$key} = $details;
	}
503
	$response->value()->{'reservations'} = $tmp;
504 505
    }
    if (defined($webtask)) {
506
	$webtask->value($response->value());
507 508 509
	$webtask->Exited(0);
    }
    else {
510
	print Dumper($response->value());
511 512 513 514 515 516 517
    }
    exit(0);
}

#
# Delete a reservation.
#
518 519
# This is not doing proper permission checks or credentials. Need to fix.
#
520 521
sub DoDelete()
{
522 523 524 525 526 527 528 529 530 531 532 533 534 535
    #
    # We allow for admins to pass a reason (deny with cause).
    #
    my $optlist = "N:";
    my $reason;
    
    my %options = ();
    if (! getopts($optlist, \%options)) {
	usage();
    }
    if (defined($options{"N"})) {
	$reason = readfile($options{"N"});
	chomp($reason);
    }
536 537
    usage()
	if (@ARGV != 2);
Leigh B Stoller's avatar
Leigh B Stoller committed
538 539
    my $pid  = shift(@ARGV);
    my $uuid = shift(@ARGV);
540 541
    
    # Check this since Reservation->Lookup() does not validate.
Leigh B Stoller's avatar
Leigh B Stoller committed
542 543
    fatal("Invalid uuid")
	if (!ValidUUID($uuid));
544 545 546 547 548 549 550 551 552

    my $project = Project->Lookup($pid);
    fatal("No such project")
	if (!defined($project));
    
    if (!$this_user->IsAdmin() &&
	!$project->AccessCheck($this_user, TB_PROJECT_CREATEEXPT())) {
	fatal("No permission to access reservation list for $project")
    }
Leigh B Stoller's avatar
Leigh B Stoller committed
553
    my $blob = { "uuid" => $uuid,
554 555 556 557 558
		 "project" => $project->urn()->asString()
    };
    if ($this_user->IsAdmin() && defined($reason) && $reason ne "") {
	$blob->{'reason'} = $reason;
    }
559
    my $response =
560
	APT_Geni::PortalRPC($authority, undef, "DeleteReservation", $blob);
561 562 563 564 565 566
    if (GeniResponse::IsError($response)) {
	#
	# All errors are fatal.
	#
	fatal($response->output());
    }
Leigh B Stoller's avatar
Leigh B Stoller committed
567
    DeleteAnnouncement($uuid);
568 569 570 571 572 573 574 575 576
    if (defined($webtask)) {
	$webtask->Exited(0);
    }
    else {
	print Dumper($response);
    }
    exit(0);
}

577 578 579 580 581
#
# Approve a reservation.
#
sub DoApprove()
{
Leigh B Stoller's avatar
Leigh B Stoller committed
582 583 584 585 586 587 588 589 590 591
    my $optlist = "p:";
    my $portal;

    my %options = ();
    if (! getopts($optlist, \%options)) {
	usage();
    }
    if (defined($options{"p"})) {
	$portal = $options{"p"}
    }
592
    usage()
Leigh B Stoller's avatar
Leigh B Stoller committed
593 594
	if (@ARGV != 1 || !defined($portal));
    my $uuid = shift(@ARGV);
595 596
    
    # Check this since Reservation->Lookup() does not validate.
Leigh B Stoller's avatar
Leigh B Stoller committed
597 598 599 600 601 602 603
    fatal("Invalid uuid")
	if (!ValidUUID($uuid));

    my $brand = Brand->Create($portal);
    if (!defined($brand)) {
	fatal("Bad branding");
    }
604 605 606 607 608 609 610 611

    if (!$this_user->IsAdmin()) {
	fatal("No permission to approve reservations")
    }
    # PortalRPC will use the root context in this case, which is
    # essentially saying the caller is an admin.
    my $response =
	APT_Geni::PortalRPC($authority, undef, "ApproveReservation",
Leigh B Stoller's avatar
Leigh B Stoller committed
612
			    {"uuid" => $uuid});
613 614 615 616 617 618
    if (GeniResponse::IsError($response)) {
	#
	# All errors are fatal.
	#
	fatal($response->output());
    }
Leigh B Stoller's avatar
Leigh B Stoller committed
619 620 621 622
    #
    # Schedule an announcement for the user.
    #
    my $blob = $response->value();
623 624 625 626 627 628 629
    if (exists($blob->{'user'})) {
	my $geniuser = GeniUser->Lookup($blob->{'user'}, 1);
	if (defined($geniuser) && $geniuser->IsLocal()) {
	    AddAnnouncement($portal, $brand, $uuid, $geniuser->emulab_user(),
			    $blob->{'nodes'}, $blob->{'type'}, $blob->{'start'});
	}
    }
630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667
    if (defined($webtask)) {
	$webtask->Exited(0);
    }
    else {
	print Dumper($response);
    }
    exit(0);
}

#
# Get the reservation system info.
#
sub DoSystemInfo()
{
    my $optlist = "p:";
    my $portal;
    my $errmsg;
    my @aggregates = ($authority);
    my @webtasks   = ();

    my %options = ();
    if (! getopts($optlist, \%options)) {
	usage();
    }
    if (defined($options{"p"})) {
	$portal = $options{"p"}
    }
    usage()
	if (@ARGV);

    #
    # Portal argument says to ignore aggregate argument, and contact
    # all aggregates listed for the portal. 
    #
    if (defined($portal)) {
	@aggregates = ();
	
	my @list = APT_Aggregate->LookupForPortal($portal);
Leigh B Stoller's avatar
Leigh B Stoller committed
668 669
	foreach my $agg (@list) {
	    my $authority = APT_Geni::GetAuthority($agg->urn());
670
	    if (!defined($authority)) {
Leigh B Stoller's avatar
Leigh B Stoller committed
671
		$errmsg = "Cannot lookup authority for $agg";
672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697
		goto bad;
	    }
	    push(@aggregates, $authority);
	}
    }

    my $coderef = sub {
	my ($blob) = @_;
	my $authority = $blob->{"authority"};
	my $webtask   = $blob->{"webtask"};
	
	# PortalRPC will use the root context in this case, which is
	# essentially saying the caller is an admin. But thats okay
	# for this call, it is just informational.
	my $response =
	    APT_Geni::PortalRPC($authority, undef, "ReservationSystemInfo");
	
	if (GeniResponse::IsError($response)) {
	    #
	    # All errors are fatal.
	    #
	    if (defined($webtask)) {
		$webtask->output($response->output());
		$webtask->Exited(-1);
	    }
	    else {
Leigh B Stoller's avatar
Leigh B Stoller committed
698
		print STDERR "$authority: " . $response->output() . "\n";
699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737
	    }
	    return -1;
	}
	if (defined($webtask)) {
	    $webtask->value($response->value());
	    $webtask->Exited(0);
	}
	return 0;
    };
    #
    # Multiple aggregates, we use parrun. We need a webtask for each
    # authority to communicate the results back to the parent, who
    # then combines them all.
    #
    my @return_codes = ();
    my @agglist = ();

    foreach my $auth (@aggregates) {
	my $temptask = WebTask->CreateAnonymous();
	# For delete below.
	push(@webtasks, $temptask);
	push(@agglist, {"authority" => $auth,
			"webtask"   => $temptask});
    }
    if (ParRun({"maxwaittime" => 60,
		"maxchildren" => scalar(@agglist)},
	    \@return_codes, $coderef, @agglist)) {
	#
	# The parent caught a signal. Leave things intact so that we can
	# kill things cleanly later.
	#
	$errmsg = "Internal error get reservation info";
	goto bad;
    }
    #
    # Check the exit codes, create return structure for the web interface.
    #
    my $blob = {};
    
Leigh B Stoller's avatar
Leigh B Stoller committed
738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821
    foreach my $agg (@agglist) {
	my $code  = shift(@return_codes);
	my $auth  = $agg->{'authority'};
	my $wtask = $agg->{'webtask'};

	$wtask->Refresh();

	if ($code) {
	    $errmsg  = "$auth: " . $wtask->output();
	    goto bad;
	}
	$blob->{$auth->urn()} = $wtask->value();
    }
    if (defined($webtask)) {
	$webtask->value($blob);
	$webtask->Exited(0);
    }
    else {
	print Dumper($blob);
    }
    foreach my $temptask (@webtasks) {
	$temptask->Delete();
    }
    exit(0);

  bad:
    foreach my $temptask (@webtasks) {
	$temptask->Delete();
    }
    fatal($errmsg);
}

#
# Get the prediction data.
#
sub DoPrediction()
{
    my $optlist = "p:";
    my $portal;
    my $errmsg;
    my @aggregates = ($authority);
    my @webtasks   = ();
    my @projlist   = ();

    my %options = ();
    if (! getopts($optlist, \%options)) {
	usage();
    }
    if (defined($options{"p"})) {
	$portal = $options{"p"}
    }
    # Argument is a list of projects, else we generate one for user.
    if (@ARGV) {
	foreach my $pid (@ARGV) {
	    my $project = Project->Lookup($pid);
	    if (!defined($project)) {
		fatal("No such project: $pid");
	    }
	    push(@projlist, $project->urn());
	}
    }
    else {
	my @plist;
	if ($this_user->ProjectMembershipList(\@plist)) {
	    fatal("Could not get project membership list");
	}
	foreach my $project (@plist) {
	    if ($project->AccessCheck($this_user, TB_PROJECT_CREATEEXPT())) {
		push(@projlist, $project->urn());
	    }
	}
	if (!@projlist) {
	    fatal("No projects to create experiments in");
	}
    }

    #
    # Portal argument says to ignore aggregate argument, and contact
    # all aggregates listed for the portal. 
    #
    if (defined($portal)) {
	@aggregates = ();
	
	my @list = APT_Aggregate->LookupForPortal($portal);
Leigh B Stoller's avatar
Leigh B Stoller committed
822 823
	foreach my $agg (@list) {
	    my $authority = APT_Geni::GetAuthority($agg->urn());
Leigh B Stoller's avatar
Leigh B Stoller committed
824
	    if (!defined($authority)) {
Leigh B Stoller's avatar
Leigh B Stoller committed
825
		$errmsg = "Cannot lookup authority for $agg";
Leigh B Stoller's avatar
Leigh B Stoller committed
826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860
		goto bad;
	    }
	    push(@aggregates, $authority);
	}
    }

    my $coderef = sub {
	my ($blob) = @_;
	my $authority = $blob->{"authority"};
	my $webtask   = $blob->{"webtask"};
	
	# PortalRPC will use the root context in this case, which is
	# essentially saying the caller is an admin. But thats okay
	# for this call, it is just informational.
	my $response =
	    APT_Geni::PortalRPC($authority, undef,
				"ReservationPrediction",
				{"projlist" => \@projlist});
	
	if (GeniResponse::IsError($response)) {
	    #
	    # All errors are fatal.
	    #
	    if (defined($webtask)) {
		$webtask->output($response->output());
		$webtask->Exited(-1);
	    }
	    else {
		print STDERR "$authority: " . $response->output() . "\n";
	    }
	    return -1;
	}
	if (defined($webtask)) {
	    $webtask->value($response->value());
	    $webtask->Exited(0);
861
	    $webtask->Store();
Leigh B Stoller's avatar
Leigh B Stoller committed
862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879
	}
	return 0;
    };
    #
    # Multiple aggregates, we use parrun. We need a webtask for each
    # authority to communicate the results back to the parent, who
    # then combines them all.
    #
    my @return_codes = ();
    my @agglist = ();

    foreach my $auth (@aggregates) {
	my $temptask = WebTask->CreateAnonymous();
	# For delete below.
	push(@webtasks, $temptask);
	push(@agglist, {"authority" => $auth,
			"webtask"   => $temptask});
    }
880
    if (ParRun({"maxwaittime" => 30,
Leigh B Stoller's avatar
Leigh B Stoller committed
881 882 883 884 885 886 887 888 889 890 891 892 893 894
		"maxchildren" => scalar(@agglist)},
	    \@return_codes, $coderef, @agglist)) {
	#
	# The parent caught a signal. Leave things intact so that we can
	# kill things cleanly later.
	#
	$errmsg = "Internal error get reservation prediction info";
	goto bad;
    }
    #
    # Check the exit codes, create return structure for the web interface.
    #
    my $blob = {};
    
895 896 897 898 899 900 901 902
    foreach my $agg (@agglist) {
	my $code  = shift(@return_codes);
	my $auth  = $agg->{'authority'};
	my $wtask = $agg->{'webtask'};

	$wtask->Refresh();

	if ($code) {
903 904 905 906 907 908 909 910 911 912
	    #
	    # If this timed out, lets not return a fatal error since
	    # this info is informational and does not prevent the web
	    # server from operating normally.
	    #
	    if ($code == 15) {
		$blob->{$auth->urn()} = "Timed out getting reservation ".
		    "system information";
		next;
	    }
Leigh B Stoller's avatar
Leigh B Stoller committed
913
	    $errmsg  = "$auth: " . $wtask->output();
914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936
	    goto bad;
	}
	$blob->{$auth->urn()} = $wtask->value();
    }
    if (defined($webtask)) {
	$webtask->value($blob);
	$webtask->Exited(0);
    }
    else {
	print Dumper($blob);
    }
    foreach my $temptask (@webtasks) {
	$temptask->Delete();
    }
    exit(0);

  bad:
    foreach my $temptask (@webtasks) {
	$temptask->Delete();
    }
    fatal($errmsg);
}

937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972
sub fatal($)
{
    my ($mesg) = @_;

    if (defined($webtask)) {
	$webtask->output($mesg);
	$webtask->code(-1);
    }
    print STDERR "*** $0:\n".
	         "    $mesg\n";
    # Exit with negative status so web interface treats it as system error.
    exit(-1);
}

sub UserError($)
{
    my ($mesg) = @_;

    if (defined($webtask)) {
	$webtask->output($mesg);
	$webtask->code(1);
    }
    print STDERR "*** $0:\n".
	         "    $mesg\n";
    exit(1);
}

sub readfile($) {
    local $/ = undef;
    my ($filename) = @_;
    open(FILE, $filename) or fatal("Could not open $filename: $!");
    my $contents = <FILE>;
    close(FILE);
    return $contents;
}

Leigh B Stoller's avatar
Leigh B Stoller committed
973 974 975
#
# Add or Edit a reservation announcement.
#
976
sub AddAnnouncement($$$$$$$)
Leigh B Stoller's avatar
Leigh B Stoller committed
977
{
978 979
    my ($portal, $brand, $uuid, $user, $nodes, $type, $start) = @_;
    my $this_uid = $user->uid();
Leigh B Stoller's avatar
Leigh B Stoller committed
980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012
    my $nickname = $aggregate->nickname();
    my $name     = $aggregate->name();
    my $url      = $brand->wwwBase() .
	"/reserve.php?edit=1&uuid=${uuid}&cluster=${nickname}";
    my $text = "You have a reservation at $name for $nodes $type ".
	"node(s) starting soon.";
    my $command;
    my $dateopt = "";

    #
    # If the reservation is more then 24 hours out, schedule an announcement
    # for 24 hours ahead. 
    #
    if (defined($start)) {
	if ($start !~ /^\d+$/) {
	    $start = str2time($start);
	}
	if ($start - time() > (3600 * 24)) {
	    $dateopt = "-S " . ($start - (3600 * 23));
	}
    }

    # This is awkward, the announcement stuff should be a library some day.
    my $query_result =
	emdb::DBQueryWarn("select idx from apt_announcements where uuid='$uuid'");
    return
	if (!$query_result);
    # Update mode.
    if ($query_result->numrows) {
	$command = "$ANNOUNCE -A $uuid -b 'View Reservation' ".
	    "-u '$url' $dateopt '$text'";
    }
    else {
1013
	$command = "$ANNOUNCE -a -p $portal -U $this_uid -I 4 ".
Leigh B Stoller's avatar
Leigh B Stoller committed
1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025
	    "-b 'View Reservation' -u '$url' -t $uuid $dateopt '$text'";
    }
    system($command);
}
sub DeleteAnnouncement($)
{
    my ($uuid) = @_;

    system("$ANNOUNCE -R $uuid");    
}