reserve.in 16 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27
#!/usr/bin/perl -w
#
# Copyright (c) 2016 University of Utah and the Flux Group.
# 
# {{{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 strict;
use English;
use Getopt::Std;
use Date::Parse;
28
use POSIX;
29 30 31 32 33 34 35 36 37 38 39 40 41 42 43

#
# Configure variables
#
my $TB		 = "@prefix@";
my $TBOPS        = "@TBOPSEMAIL@";

#
# Testbed Support libraries
#
use lib "@prefix@/lib";
use emdb;
use libtestbed;
use Project;
use Reservation;
44
use WebTask;
45 46 47

sub usage()
{
48
    print STDERR "Usage: reserve [-C] [-f] [-n] [-q] -t type [-s start] [-e end]\n" .
49
	"            [-u] [-U uid] [-N file] [-A file] [-a|-p] pid count\n";
50
    print STDERR "       reserve [-D file] -c idx\n";
51
    print STDERR "       reserve [-f] [-n] [-s start] [-e end] [-u]\n" .
52
	"            [-U uid] [-N file] [-A file] [-S size] [-a] -m idx \n";
53 54
    print STDERR "       reserve [-u] -i pid\n";
    print STDERR "       reserve [-u] -l\n";
55
    print STDERR "   -h   This message\n";
56
    print STDERR "   -u   Interpret/display all times in UTC\n";
57
    print STDERR "   -c   Clear existing reservation (by id)\n";
58
    print STDERR "   -C   Clear existing reservation for project (by date)\n";
59 60 61
    print STDERR "   -f   Force reservation into schedule, even if " .
	"overcommitted\n";
    print STDERR "   -n   Check feasibility only; don't actually reserve\n";
62
    print STDERR "   -q   Quiet operation; don't e-mail user\n";
63
    print STDERR "   -U   Mark reservation as being created by uid (admin-only)\n";
64 65 66 67 68
    print STDERR "   -t   Node type\n";
    print STDERR "   -i   Show existing reservation for project\n";
    print STDERR "   -l   List all existing reservations\n";
    print STDERR "   -s   Start time when reservation begins\n";
    print STDERR "   -e   End time when reservation expires\n";
69
    print STDERR "   -a   Approve reservation (auto for small, otherwise admin-only)\n";
70
    print STDERR "   -p   Create pending reservation (do not auto-approve)\n";
71 72
    print STDERR "   -m   Modify existing reservation\n";
    print STDERR "   -S   Specify new size of modified reservation\n";
73 74 75
    print STDERR "   -A   Supply file containing admin-only notes about reservation\n";
    print STDERR "   -N   Supply file containing user notes justifying reservation\n";
    print STDERR "   -D   Supply file containing reason why reservation was denied\n";
76
    exit( -1 );
77 78
}

79
my $optlist    = "ac:de:fhilm:npqs:t:uA:CD:N:S:U:T:";
80 81 82 83 84 85 86
my $debug      = 0;
my $info       = 0;
my $list       = 0;
my $clear      = 0;
my $clear_idx  = undef;
my $force      = 0;
my $impotent   = 0;
87
my $quiet      = 0;
88
my $modify_idx = undef;
89 90 91 92
my $starttime  = time; # default to starting immediately
my $endtime    = time + 24 * 60 * 60; # default to ending tomorrow
my $notes      = undef;
my $adminnotes = undef;
93
my $denynotes  = undef;
94
my $approve    = 0;
95
my $pending    = 0;
96 97 98 99
my $type;
my $pid;
my $count;
my $project;
100
my $webtask;
101
my $admin;
102 103 104 105 106 107 108 109 110 111 112 113 114
my $target_user;

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

    if (defined($webtask)) {
	$webtask->Exited(-1);
	$webtask->output($mesg);
    }
    die("*** $0:\n".
	"    $mesg\n");
}
115

116 117 118 119 120 121 122 123 124
sub readfile($) {
    local $/ = undef;
    my ($filename) = @_;
    open( FILE, $filename ) or die "$filename: $!";
    my $contents = <FILE>;
    close( FILE );
    return $contents;
}

125 126 127 128 129 130
sub convert($) {
    my ($unixtime) = @_;

    return strftime( "%Y-%m-%d %H:%M", localtime( $unixtime ) );
}

131 132 133 134 135 136 137 138 139 140
#
# Turn off line buffering on output
#
$| = 1;

#
# Untaint the path
# 
$ENV{'PATH'} = "/bin:/sbin:/usr/bin:";

141 142 143 144 145 146 147 148 149 150 151 152 153
#
# Verify user.
#
my $this_user;
if ($UID) {
    $this_user = User->ThisUser();
    if (! defined($this_user)) {
	fatal("You ($UID) do not exist!");
    }
    $admin = $this_user->IsAdmin();
}
$target_user = $this_user;

154 155 156 157 158 159 160 161
#
# Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments.
#
my %options = ();
if (! getopts($optlist, \%options)) {
    usage();
}
162 163 164 165
if (defined($options{"u"})) {
    # handle this option ASAP, since it affects parsing of other options!
    $ENV{ "TZ" } = "UTC";
}
166 167 168 169
if (defined($options{h})) {
    usage();
}
if (defined($options{c})) {
170 171 172 173 174
    $clear_idx = $options{c};
    unless( $clear_idx =~ /^[0-9]+$/ ) {
	fatal( "Invalid reservation index." );
    }
}
175 176 177 178 179 180
if (defined($options{m})) {
    $modify_idx = $options{m};
    unless( $modify_idx =~ /^[0-9]+$/ ) {
	fatal( "Invalid reservation index." );
    }
}
181
if (defined($options{C})) {
182 183 184 185 186 187
    $clear = 1;
}
if (defined($options{d})) {
    $debug = 1;
}
if (defined($options{f})) {
188
    fatal( "-f option requires administrator privileges" ) unless( $admin );
189 190 191 192 193
    $force = 1;
}
if (defined($options{n})) {
    $impotent = 1;
}
194 195 196
if (defined($options{q})) {
    $quiet = 1;
}
197 198 199 200 201 202 203 204 205 206
if (defined($options{t})) {
    $type = $options{t};
    unless( $type =~ /^[-\w]+$/ ) {
	fatal( "Invalid node type." );
    }
}
if (defined($options{i})) {
    $info = 1;
}
if (defined($options{l})) {
207
    fatal( "-l option requires administrator privileges" ) unless( $admin );
208 209
    $list = 1;
}
210 211 212 213 214 215 216
if (defined($options{T})) {
    $webtask = WebTask->Lookup($options{T});
    if (!defined($webtask)) {
	fatal("No such webtask: " . $options{T});
    }
    $webtask->AutoStore(1);
}
217
if (defined($options{"e"})) {
218 219 220 221 222 223
    $endtime = $options{"e"};
    if ($endtime !~ /^\d+$/) {
	$endtime = str2time($endtime);
	if( !defined( $endtime ) ) {
	    fatal("Could not parse -e option.");
	}
224 225 226
    }
}
if (defined($options{"s"})) {
227 228 229 230 231 232
    $starttime = $options{"s"};
    if ($starttime !~ /^\d+$/) {
	$starttime = str2time($starttime);
	if( !defined( $starttime ) ) {
	    fatal("Could not parse -s option.");
	}
233 234
    }
}
235 236 237 238
if (defined($options{"N"})) {
    $notes = readfile( $options{"N"} );
}
if (defined($options{"A"})) {
239
    fatal( "-A option requires administrator privileges" ) unless( $admin );
240 241
    $adminnotes = readfile( $options{"A"} );
}
242 243 244
if (defined($options{"D"})) {
    $denynotes = readfile( $options{"D"} );
}
245
if (defined($options{"U"})) {
246
    fatal( "-U option requires administrator privileges" ) unless( $admin );
247 248 249 250
    $target_user = User->Lookup($options{"U"});
    fatal("No such user")
	if (!defined($target_user));
}
251 252 253 254 255 256
if (defined($options{S})) {
    $count = $options{S};
    unless( $count =~ /^[0-9]+$/ ) {
	fatal( "Invalid reservation size." );
    }
}
257
if (defined($options{'a'})) {
258
    fatal( "-a option requires administrator privileges" ) unless( $admin );
259 260
    $approve = 1;
}
261 262 263
if (defined($options{'p'})) {
    $pending = 1;
}
264 265 266 267 268 269 270 271
if ($info) {
    usage() if( @ARGV != 1 );
    
    $pid = $ARGV[0];
}
elsif ($list) {
    usage() if(@ARGV);
}
272 273 274
elsif( defined( $clear_idx ) ) {
    usage() if(@ARGV);
}
275
else {
276 277 278 279 280 281 282
    if( defined( $modify_idx ) ) {
	usage() if( @ARGV || defined( $type ) );
	
	my $oldres = Reservation->Lookup( $modify_idx );
	if( !defined( $oldres ) ) {
	    fatal( "Could not find existing reservation." );
	}
283

284 285 286
	$pid = $oldres->pid();
	$type = $oldres->type();
	$count = $oldres->nodes() unless( defined( $count ) );
287 288
	$starttime = $oldres->start() unless( defined( $options{"s"} ) );
	$endtime = $oldres->end() unless( defined( $options{"e"} ) );
289
    } else {
290
	usage() if( @ARGV != 2 || !defined( $type ) );
291 292 293 294 295
	
	$pid     = shift(@ARGV);
	$count   = shift(@ARGV);
    }
    
296 297 298 299 300 301 302 303
    if( $count < 1 ) {
	fatal( "Must reserve at least one node." );
    }
    
    if( $endtime <= $starttime ) {
	fatal( "Reservation must not end until after it starts." );
    }

304
    if( $endtime <= time && !$clear ) {
305 306 307 308 309 310 311 312 313 314 315 316
	fatal( "Reservation end time has already passed." );
    }

    if( $endtime > time + 3 * 365 * 24 * 60 * 60 ) {
	fatal( "Reservation ends too far in the future." );
    }
}

#
# List all pending reservations.
#
if ($list) {
317
    my $query = $type ? "SELECT idx, pid, nodes, type, approved, " .
318 319
	"UNIX_TIMESTAMP( start ) AS s, UNIX_TIMESTAMP( end ) AS e FROM " .
	"future_reservations WHERE type='$type' ORDER BY s" :
320
	"SELECT idx, pid, nodes, type, approved, UNIX_TIMESTAMP( start ) AS s, " .
321 322
	"UNIX_TIMESTAMP( end ) AS e FROM future_reservations " .
	"ORDER BY s";
323 324 325 326

    my $query_result = DBQueryFatal( $query );

    if( $query_result->numrows ) {
327 328
	print "A Index Start            End              Project             Nodes Type\n";
	print "- ----- -----            ---              -------             ----- ----\n";
329 330 331
    }

    while( my $row = $query_result->fetchrow_hashref() ) {
332
	my $idx = $row->{'idx'};
333 334 335
	my $pid = $row->{'pid'};
	my $nodes = $row->{'nodes'};
	my $type = $row->{'type'};
336 337
	my $start = convert( $row->{'s'} );
	my $end = convert( $row->{'e'} );
338
	my $approved = defined( $row->{'approved'} ) ? "Y" : " ";
339

340
	printf( "%1s %5d %16s %16s %-19s %5d %s\n", $approved, $idx, $start, $end, $pid, $nodes, $type );
341 342 343 344 345
    }
    
    exit(0);
}

346
my $pid_idx;
347 348 349 350 351 352 353 354 355
if( defined( $clear_idx ) ) {
    my $res = Reservation->Lookup( $clear_idx );
    fatal( "could not find existing reservation" ) unless( defined( $res ) );
    $pid_idx = $res->pid_idx();
    $project = Project->Lookup( $pid_idx );
    if (!defined($project)) {
	fatal("No such project $pid\n");
    }
} else {
356 357
    if ($pid =~ /^(.*):(.*)$/) {
	require GeniHRN;
358

359
	my $urn = GeniHRN::Generate($pid, "authority", "sa");
360

361 362 363 364 365
	$project = Project->LookupNonLocal($urn);
	if (!defined($project)) {
	    fatal("No such nonlocal project $pid\n");
	}
	$pid = $project->pid();
366
    }
367 368
    else {
	$project = Project->Lookup($pid);
369

370 371 372
	if (!defined($project)) {
	    fatal("No such project $pid\n");
	}
373
    }
374
    $pid_idx = $project->pid_idx();
375 376
}

377 378 379 380 381
if( !$admin ) {
    fatal( "You are not a project member" )
	unless( $project->LookupUser( $this_user ) );
}

382 383 384 385
#
# Show and exit.
#
if ($info) {
386
    my $query = $type ? "SELECT uid, nodes, type, approved, " .
387
	"UNIX_TIMESTAMP( start ) AS s, UNIX_TIMESTAMP( end ) AS e FROM " .
388
	"future_reservations WHERE type='$type' AND pid_idx=$pid_idx " .
389
	"ORDER BY s" : "SELECT uid, nodes, type, approved, " .
390 391
	"UNIX_TIMESTAMP( start ) AS s, UNIX_TIMESTAMP( end ) AS e FROM " .
	"future_reservations WHERE pid_idx=$pid_idx ORDER BY s";
392 393 394 395

    my $query_result = DBQueryFatal( $query );

    if( $query_result->numrows ) {
396 397
	print "A Start            End              User                Nodes Type\n";
	print "- -----            ---              ----                ----- ----\n";
398 399 400 401 402 403
    }

    while( my $row = $query_result->fetchrow_hashref() ) {
	my $uid = $row->{'uid'};
	my $nodes = $row->{'nodes'};
	my $type = $row->{'type'};
404 405
	my $start = convert( $row->{'s'} );
	my $end = convert( $row->{'e'} );
406
	my $approved = defined( $row->{'approved'} ) ? "Y" : " ";
407

408
	printf( "%1s %16s %16s %-19s %5d %s\n", $approved, $start, $end, $uid, $nodes, $type );
409 410 411 412 413 414 415 416
    }
    
    exit(0);
}
    
#
# Clear and exit.
#
417 418
if ($clear || $clear_idx) {
    my $res;
419

420 421 422 423 424 425
    if( $clear_idx ) {
	$res = Reservation->Lookup( $clear_idx );
    } else {
	$res = Reservation->Lookup( $pid, $starttime, $endtime, $type, $count );
    }
    
426 427 428 429 430 431 432 433
    if( !defined( $res ) ) {
	print STDERR "reserve: no matching reservation found.\n";
	
	exit( 1 );
    }
    
    $res->Cancel();
    
434 435 436 437 438 439 440 441 442 443 444 445 446
    my $user = User->Lookup( $res->uid() );
    my $count = $res->nodes();
    my $type = $res->type();
    my $s = convert( $res->start() );
    my $e = convert( $res->end() );
    SENDMAIL( $user->email(), "Reservation CANCELLED",
	      "Your reservation request for $count $type nodes,\n" .
	      "starting at $s and ending at\n" .
	      "$e, has been CANCELLED.\n" .
	      ( defined( $denynotes ) ?
		"The reason for cancellation is:\n" .
		$denynotes . "\n" : "" ) ) unless( $quiet );
	
447 448 449
    exit( 0 );
}

450 451
# For now, auto-approve reservation requests up to 64 node-hours.
# Later we'll probably want this threshold to vary based on the node type,
452 453
# how far into the future the reservation starts, existing approved
# reservations for the same project, the phase of the moon...
454 455 456 457 458
# who knows.
if( $count * ( $endtime - $starttime ) / 3600 <= 0x40 ) {
    $approve = 1;
}

459 460 461
# If they said "-p", don't approve no matter what.
$approve = 0 if( $pending );

462 463 464 465 466 467
#
# Do not allow this as root; we want proper history.
#
if ($UID == 0) {
    fatal("Please do not run this as root!");
}
468 469
my $uid = $target_user->uid();
my $uid_idx = $target_user->uid_idx();
470

471 472 473 474 475 476
my $res;
if( defined( $modify_idx ) ) {
    $res = Reservation->Lookup( $modify_idx );
    $res->SetStart( $starttime );
    $res->SetEnd( $endtime );
    $res->SetNodes( $count );
477 478 479 480
    # The user who originally requested the reservation is not necessarily
    # the same one who's modifying it now.
    $uid = $res->uid();
    $uid_idx = $res->uid();
481 482 483 484
} else {
    $res = Reservation->Create( $pid, $uid, $starttime, $endtime, $type,
				$count );
}
485 486
$res->SetNotes( $notes ) if( defined( $notes ) );
$res->SetAdminNotes( $adminnotes ) if( defined( $adminnotes ) );
487
$res->Approve( $target_user ) if( $approve );
488 489 490 491 492 493

print "$res\n" if( $debug );

while( 1 ) {
    my $version = Reservation->GetVersion();
    my $reservations = Reservation->LookupAll( $type );
494 495 496 497 498 499 500 501 502 503 504 505 506 507
    if( defined( $modify_idx ) ) {
	my $i;

	for( $i = 0; $i < @$reservations; $i++ ) {
	    my $r = $$reservations[ $i ];

	    if( defined( $r->idx() ) && $r->idx() == $modify_idx ) {
		$$reservations[ $i ] = $res;
		last;
	    }
	}
    } else {
	push( @$reservations, $res );
    }
508 509 510 511 512 513
    my $error;
    if( !Reservation->IsFeasible( $reservations, \$error ) ) {
	print STDERR "reserve: $error\n";
	if( $force ) {
	    print STDERR "Continuing anyway!\n";
	} else {
514 515 516 517
	    if (defined($webtask)) {
		$webtask->Exited(1);
		$webtask->output($error);
	    }
518 519 520
	    exit( 1 );
	}
    }
521
    exit( $approve ? 0 : 2 ) if( $impotent );
522 523 524
    # FIXME if $modify_idx is set, the old reservation was approved,
    # and $approve is false, then things get ugly.  e-mail the
    # admins and leave the database untouched???
525
    next if( !defined( Reservation->BeginTransaction( $version ) ) );
526
    $res->Book( $modify_idx );
527
    Reservation->EndTransaction();
528 529
    my $s = convert( $starttime );
    my $e = convert( $endtime );
530
    if( $approve ) {
531 532 533 534
	# The reservation is approved -- presumably it is either newly
	# approved or edited since first approval.  E-mail the user
	# unconditionally, since it's probably good for them to hear
	# either way.
535 536
	my $user = User->Lookup( $uid );
	SENDMAIL( $user->email(), "Reservation approved",
537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555
		  "Your reservation request for $count $type nodes,\n" .
		  "starting at $s and ending at\n" .
		  "$e, has been approved.\n" .
		  "\n" .
		  "If you do not intend to use these resources, please\n" .
		  "cancel this reservation as soon as possible, since\n" .
		  "the nodes are currently unavailable to other users for\n" .
		  "the duration of your reservation.\n" .
		  "\n" .
		  "Please note that we make no guarantees about the\n" .
		  "availability or suitability of these nodes for your\n" .
		  "experiment(s).\n" .
		  "\n" .
		  "PLEASE NOTE: Reservations are an experimental\n" .
		  "testbed feature under active development.  Until\n" .
		  "further notice, you should expect reservation\n" .
		  "system failures.  Please send reports about the\n" .
		  "reservation system to $TBOPS.\n" .
		  "Thank you for your assistance in debugging this\n" .
556
		  "feature!\n" ) unless( $quiet );
557
	
558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574
	exit( 0 );
    } else {
	# We just booked a reservation we didn't pre-approve.  It requires
	# admin attention to be made effective.
	my $idx = $res->idx();

	print STDERR "reserve: reservation is feasible but has NOT yet been approved.\n";
	
	SENDMAIL( $TBOPS, "Reservation request pending",
		  "User \"$uid\" has requested a reservation for $count $type nodes,\n" .
		  "starting at $s and ending at $e.\n" .
		  "\n" .
		  "The request was feasible at the time it was made, but administrator\n" .
		  "approval is required to hold the resources.\n" .
		  "\n" .
		  "You can approve the request by invoking:\n" .
		  "    reserve -a -m $idx\n" .
575
		  "on boss.\n" ) unless( $quiet );
576 577 578
	
	exit( 2 );
    }
579
}