Commit dc90a087 authored by Leigh B Stoller's avatar Leigh B Stoller
Browse files

Changes to reservation system wrt classic interface:

1. Reservation system now groks experiment lockdown and swappable. When
   swapping in, lockdown and swappable mean the expected end of the
   experiment is never.

2. Reservation library now handles changes to lockdowm, swappable, and
   autoswap (timeout). editexp now hands these changes off to a new
   script called manage_expsettings, which can be called by hand since
   we might need to force a change (I am not changing the classic UI, if
   a change is not allowed by the res system, we have to do it by hand).

3. Minor fixes to reservation library.
parent d5a924c5
#!/usr/bin/perl -wT
#
# Copyright (c) 2000-2011 University of Utah and the Flux Group.
# Copyright (c) 2000-2017 University of Utah and the Flux Group.
#
# {{{EMULAB-LICENSE
#
......@@ -43,9 +43,10 @@ my $verify = 0; # Check data and return status only.
#
# Configure variables
#
my $TB = "@prefix@";
my $TBOPS = "@TBOPSEMAIL@";
my $TBAUDIT = "@TBAUDITEMAIL@";
my $TB = "@prefix@";
my $TBOPS = "@TBOPSEMAIL@";
my $TBAUDIT = "@TBAUDITEMAIL@";
my $MANAGESETTINGS = "$TB/sbin/manage_expsettings";
#
# Untaint the path
......@@ -63,6 +64,7 @@ $| = 1;
#
use lib "@prefix@/lib";
use libdb;
use emutil;
use libtestbed;
use User;
use Project;
......@@ -153,6 +155,7 @@ my %xmlfields =
# The rest are optional, so we can skip passing ones that are not changing
"description" => ["description", $SLOT_OPTIONAL],
"idle_ignore" => ["idle_ignore", $SLOT_OPTIONAL],
"lockdown" => ["lockdown", $SLOT_OPTIONAL],
"swappable" => ["swappable", $SLOT_OPTIONAL],
"noswap_reason" => ["noswap_reason", $SLOT_OPTIONAL],
"idleswap" => ["idleswap", $SLOT_OPTIONAL],
......@@ -304,6 +307,8 @@ if (!defined($experiment)) {
if (!$experiment->AccessCheck($this_user, TB_EXPT_MODIFY())) {
UserError("Experiment: Not enough permission");
}
my $pid = $experiment->pid();
my $eid = $experiment->eid();
#
# Description must not be blank.
......@@ -330,32 +335,124 @@ if (exists($editexp_args{"idle_ignore"})) {
}
}
#
# Lockdown
#
if (exists($editexp_args{"lockdown"})) {
my $requested = ($editexp_args{"lockdown"} eq "1" ? 1 : 0);
if ($requested != $experiment->lockdown()) {
if ($editexp_args{"lockdown"} eq "1" && !$this_user->IsAdmin()) {
UserError("lockdown: Only Administrators can lockdown experiments");
}
#
# New path; have to deal with this via the reservation system.
#
my $which = ($requested ? "set" : "clear");
my $output = emutil::ExecQuiet("$MANAGESETTINGS ".
"lockdown $pid,$eid $which");
if ($?) {
my $rval = $? >> 8;
if ($rval == 1) {
UserError("lockdown: locking down this experiment would ".
"cause a reservation system overbook situation");
}
else {
print STDERR $output;
fatal($output);
}
}
}
delete($editexp_args{"lockdown"});
}
#
# Swappable
#
if (exists($editexp_args{"swappable"})) {
if ($editexp_args{"swappable"} ne "1") {
$editexp_args{"swappable"} = 0;
# Turning off swappable, must provide justification.
if ((exists($editexp_args{"noswap_reason"}) ?
$editexp_args{"noswap_reason"} eq "" :
$experiment->noswap_reason() eq "")) {
if (!$this_user->IsAdmin()) {
UserError("Swappable: No justification provided");
my $requested = ($editexp_args{"swappable"} eq "0" ? 0 : 1);
if ($requested != $experiment->swappable()) {
if ($requested == 0 && !$this_user->IsAdmin()) {
UserError("swappable: Only Administrators can turn off swappable");
}
#
# New path; have to deal with this via the reservation system.
#
my $which = ($requested ? "set" : "clear");
my $output = emutil::ExecQuiet("$MANAGESETTINGS ".
"swappable $pid,$eid $which");
if ($?) {
my $rval = $? >> 8;
if ($rval == 1) {
UserError("swappable: disabling swappable would ".
"cause a reservation system overbook situation");
}
else {
$editexp_args{"noswap_reason"} = "ADMIN";
print STDERR $output;
fatal($output);
}
}
if ($experiment->swappable()) {
$doemail = 1;
}
}
delete($editexp_args{"swappable"});
}
if (exists($editexp_args{"noswap_reason"})) {
$editexp_args{"noswap_reason"} =
escapeshellarg($editexp_args{"noswap_reason"});
#
# AutoSwap
#
my $autoswap_max = TBGetSiteVar("general/autoswap_max");
if (exists($editexp_args{"autoswap"}) ||
exists($editexp_args{"autoswap_timeout"})) {
my $hours;
my $which;
if (exists($editexp_args{"autoswap"})) {
my $requested = ($editexp_args{"autoswap"} eq "1" ? 1 : 0);
if ($requested != $experiment->autoswap()) {
if ($requested == 0 && !$this_user->IsAdmin()) {
UserError("Max Duration: ".
"Only Administrators can turn off Max Duration");
}
$which = ($requested ? "set" : "clear");
}
}
if (exists($editexp_args{"autoswap_timeout"})) {
my $requested = $editexp_args{"autoswap_timeout"};
if ($requested != $experiment->autoswap_timeout()) {
if ($requested <= 0) {
UserError("Max Duration: Invalid time provided");
}
if ($requested > $autoswap_max && !$this_user->IsAdmin()) {
UserError("Max Duration: $autoswap_max hours maximum - ".
"you must ask testbed operations for more");
}
$hours = $editexp_args{"autoswap_timeout"};
}
}
if (defined($hours) || defined($which)) {
# If only changing the timeout, we still need a set/clear argument.
$which = ($experiment->autoswap() ? "set" : "clear")
if (!defined($which));
$hours = "" if (!defined($hours));
my $output = emutil::ExecQuiet("$MANAGESETTINGS ".
"autoswap $pid,$eid $which $hours");
if ($?) {
my $rval = $? >> 8;
if ($rval == 1) {
UserError("autoswap: modifying autoswap would ".
"cause a reservation system overbook situation");
}
else {
print STDERR $output;
fatal($output);
}
}
}
delete($editexp_args{"autoswap"});
delete($editexp_args{"autoswap_timeout"});
}
#
......@@ -396,30 +493,6 @@ if (exists($editexp_args{"noidleswap_reason"})) {
escapeshellarg($editexp_args{"noidleswap_reason"});
}
#
# AutoSwap
#
if (exists($editexp_args{"autoswap"})) {
if ($editexp_args{"autoswap"} ne "1") {
if (!$this_user->IsAdmin()) {
UserError("Max Duration: ".
"you must ask testbed operations to disable this");
}
$editexp_args{"autoswap"} = 0;
}
}
my $autoswap_max = TBGetSiteVar("general/autoswap_max");
if (exists($editexp_args{"autoswap_timeout"})) {
if ($editexp_args{"autoswap_timeout"} <= 0) {
UserError("Max Duration: Invalid time provided");
}
if ($editexp_args{"autoswap_timeout"} > $autoswap_max &&
!$this_user->IsAdmin()) {
UserError("Max Duration: $autoswap_max hours maximum - ".
"you must ask testbed operations for more");
}
}
#
# Swapout disk state saving
#
......
......@@ -1231,8 +1231,8 @@ sub EditExp($$$$$$)
($mods{"autoswap_timeout"} = $argref->{"autoswap_timeout"});
}
foreach my $col ("idle_ignore", "swappable", "noswap_reason",
"idleswap", "noidleswap_reason", "autoswap", "savedisk",
foreach my $col ("idle_ignore", "noswap_reason",
"idleswap", "noidleswap_reason", "savedisk",
"cpu_usage", "mem_usage", "linktest_level") {
# Copy args we want so that others can't get through.
if (exists($argref->{$col})) {
......@@ -1254,7 +1254,6 @@ sub EditExp($$$$$$)
return undef;
}
}
my $creator = $experiment->creator();
my $swapper = $experiment->swapper();
my $uid = $user->uid();
......@@ -1262,11 +1261,7 @@ sub EditExp($$$$$$)
my $eid = $experiment->eid();
if (!keys %mods) {
if (!$noreport) {
# Warn the user that the submit button was pressed with no effect.
$$usrerr_ref = "Submit: Nothing changed";
return undef;
}
return 1;
}
# Do not send this email if the user is an administrator
# (adminmode does not matter), and is changing an expt he created
......@@ -3238,6 +3233,69 @@ sub SetPanicBit($$)
return 0;
}
sub SetSwappable($$)
{
my ($self, $arg) = @_;
my $idx = $self->idx();
my $onoff = ($arg ? 1 : 0);
return -1
if (!DBQueryWarn("update experiments set ".
" swappable='$onoff' ".
"where idx='$idx'"));
$self->{'EXPT'}->{'swappable'} = $onoff;
return 0;
}
sub SetLockdown($$)
{
my ($self, $arg) = @_;
my $idx = $self->idx();
my $onoff = ($arg ? 1 : 0);
return -1
if (!DBQueryWarn("update experiments set ".
" lockdown='$onoff' ".
"where idx='$idx'"));
$self->{'EXPT'}->{'lockdown'} = $onoff;
return 0;
}
sub SetAutoswap($$)
{
my ($self, $arg) = @_;
my $idx = $self->idx();
my $onoff = ($arg ? 1 : 0);
return -1
if (!DBQueryWarn("update experiments set ".
" autoswap='$onoff' ".
"where idx='$idx'"));
$self->{'EXPT'}->{'lockdown'} = $onoff;
return 0;
}
sub SetAutoswapTimeout($$)
{
my ($self, $minutes) = @_;
my $idx = $self->idx();
return -1
if (!DBQueryWarn("update experiments set ".
" autoswap_timeout='$minutes' ".
"where idx='$idx'"));
$self->{'EXPT'}->{'autoswap_timeout'} = $minutes;
return 0;
}
#
# Is experiment firewalled?
#
......
......@@ -59,24 +59,24 @@ sub FlushAll($)
sub CreateCommon($$$$$$$$)
{
my ($class, $pid, $eid, $uid, $start, $end, $type, $nodes) = @_;
my $uid_idx;
my $project;
if( defined( $pid ) ) {
$project = Project->Lookup( $pid );
if( !defined( $project ) ) {
print STDERR "Res->CreateCommon: no DB record for project: $pid\n";
return undef;
}
}
my $user;
if( defined( $uid ) ) {
$user = User->Lookup( $uid );
} else {
$user = User->ThisUser();
}
if( !defined( $user ) ) {
return undef;
my $user = User->Lookup( $uid );
if (!defined($user)) {
print STDERR "Res->CreateCommon: no DB record for user: $uid\n";
return undef;
}
$uid_idx = $user->uid_idx();
}
my $self = {};
......@@ -87,8 +87,8 @@ sub CreateCommon($$$$$$$$)
$self->{'END'} = $end;
$self->{'TYPE'} = $type;
$self->{'NODES'} = $nodes;
$self->{'UID'} = $user->uid();
$self->{'UID_IDX'} = $user->uid_idx();
$self->{'UID'} = $uid,
$self->{'UID_IDX'} = $uid_idx,
$self->{'NOTES'} = undef;
$self->{'ADMIN_NOTES'} = undef;
$self->{'APPROVED'} = undef;
......@@ -350,12 +350,17 @@ sub GetVersion($)
# possibly invalidating the checks already made, and the entire operation
# must be retried from the beginning. Otherwise, the caller is free
# to proceed with the updates and then complete with EndTransaction().
sub BeginTransaction($$)
sub BeginTransaction($$;@)
{
my ($self, $old_version) = @_;
my ($self, $old_version, @tables) = @_;
my $moretables = "";
if (@tables) {
@tables = join(", ", map {"$_ write"} @tables);
$moretables = ", @tables";
}
DBQueryFatal( "LOCK TABLES future_reservations WRITE, " .
"reservation_version WRITE" );
"reservation_version WRITE $moretables" );
my $version = GetVersion( $self );
......@@ -551,21 +556,29 @@ sub LookupAll($$;$)
return $cache{$type} if( exists( $cache{$type} ) );
Tidy( $class );
# Mysql 5.7 group by nonsense. Revisit later, like when hell freezes.
DBQueryWarn("SET SESSION sql_mode=(SELECT REPLACE(\@\@sql_mode,".
"'ONLY_FULL_GROUP_BY',''))");
my @reservations = ();
my $query = $PGENISUPPORT ? "SELECT COUNT(*), e.pid, e.eid, " .
"e.expt_swap_uid, " .
"UNIX_TIMESTAMP( e.expt_swapped ) + " .
"UNIX_TIMESTAMP( stats.swapin_last ) + " .
"e.autoswap_timeout * 60, e.autoswap, " .
"nr.pid, UNIX_TIMESTAMP( s.expires ), " .
"s.lockdown, n.reserved_pid, " .
"UNIX_TIMESTAMP( pr.end ) " .
"s.lockdown as slice_lockdown, ".
"n.reserved_pid, " .
"UNIX_TIMESTAMP( pr.end ), ".
"e.lockdown, e.swappable " .
"FROM nodes AS n " .
"LEFT OUTER JOIN " .
"reserved AS r ON n.node_id=r.node_id " .
"LEFT OUTER JOIN experiments AS e ON " .
"r.pid=e.pid AND r.eid=e.eid LEFT " .
"r.pid=e.pid AND r.eid=e.eid " .
"LEFT OUTER JOIN experiment_stats AS stats ON ".
"r.pid=stats.pid AND r.eid=stats.eid LEFT " .
"OUTER JOIN next_reserve AS nr ON " .
"n.node_id=nr.node_id LEFT OUTER JOIN " .
"project_reservations AS pr ON " .
......@@ -579,16 +592,19 @@ sub LookupAll($$;$)
"UNIX_TIMESTAMP( pr.end )" :
"SELECT COUNT(*), e.pid, e.eid, " .
"e.expt_swap_uid, " .
"UNIX_TIMESTAMP( e.expt_swapped ) + " .
"UNIX_TIMESTAMP( stats.swapin_last ) + " .
"e.autoswap_timeout * 60, e.autoswap, " .
"nr.pid, NULL, " .
"NULL, n.reserved_pid, " .
"UNIX_TIMESTAMP( pr.end ) " .
"UNIX_TIMESTAMP( pr.end ), " .
"e.lockdown, e.swappable " .
"FROM nodes AS n " .
"LEFT OUTER JOIN " .
"reserved AS r ON n.node_id=r.node_id " .
"LEFT OUTER JOIN experiments AS e ON " .
"r.pid=e.pid AND r.eid=e.eid LEFT " .
"r.pid=e.pid AND r.eid=e.eid " .
"LEFT OUTER JOIN experiment_stats AS stats ON ".
"r.pid=stats.pid AND r.eid=stats.eid LEFT " .
"OUTER JOIN next_reserve AS nr ON " .
"n.node_id=nr.node_id " .
"LEFT OUTER JOIN " .
......@@ -601,10 +617,11 @@ sub LookupAll($$;$)
my $query_result = DBQueryWarn( $query );
while( my($count, $pid, $eid, $uid, $end, $autoswap, $next_reserve,
$slice_expire, $slice_lockdown, $reserved_pid, $pr_end ) =
$slice_expire, $slice_lockdown, $reserved_pid, $pr_end,
$expt_lockdown, $swappable) =
$query_result->fetchrow_array() ) {
my $endtime;
if( defined( $slice_expire ) ) {
# Node(s) allocated to a GENI slice. Treat as unavailable
# if locked down, otherwise assume released at slice expiry
......@@ -613,7 +630,8 @@ sub LookupAll($$;$)
} else {
# A non-GENI slice. Use the computed autoswap duration,
# if autoswap is enabled.
$endtime = $autoswap ? $end : undef;
$endtime = ($expt_lockdown || !$swappable ? undef :
$autoswap ? $end : undef);
}
# If next_reserve is set, assume unavailable indefinitely.
......@@ -1192,6 +1210,60 @@ sub ExtendSlice($$$;$$$) {
}
}
#
# This is identical to above, but for experiment autoswap.
#
sub AutoSwapTimeout($$$;$$$) {
my ($class, $expt, $minutes, $error, $impotent, $force) = @_;
if( $minutes <= $expt->autoswap_timeout()) {
if( $impotent ) {
return 0;
} else {
my $result = $expt->SetAutoswapTimeout($minutes);
if( $result < 0 && ref( $error ) ) {
$$error = "Couldn't update experiment autoswap_timeout";
}
return $result;
}
}
my @types = ExptTypes( $expt->idx() );
while( 1 ) {
my $version = GetVersion( $class );
foreach my $type ( @types ) {
my $reservations = LookupAll( $class, $type );
foreach my $res ( @$reservations ) {
if( defined( $res->pid() ) && defined( $res->eid() ) &&
$res->pid() eq $expt->pid() &&
$res->eid() eq $expt->eid() ) {
$res->{'END'} = time() + ($minutes * 60);
last;
}
}
if( !$force && !IsFeasible( $class, $reservations, $error ) ) {
return -1;
}
}
return 0
if( $impotent );
next if( !defined( BeginTransaction( $class, $version, "experiments")));
my $result = $expt->SetAutoswapTimeout($minutes);
if( $result < 0 && ref( $error ) ) {
$$error = "Couldn't update experiment autoswap_timeout";
}
EndTransaction( $class );
return $result;
}
}
#
# Estimate an upper bound for permissible expiry times on a slice.
#
......@@ -1259,11 +1331,11 @@ sub MaxSliceExtension($$$;$$) {
}
#
# Attempt to lock down an existing slice.
# Attempt to lock down an existing slice or experiment.
#
# Reservation->Lockdown( $slice, $error, $impotent, $force )
# Reservation->Lockdown( $target, $error, $impotent, $force )
#
# $slice must be a reference to a GeniSlice object.
# $target must be a reference to a GeniSlice object or Experiment object.
# $error (if defined) is a reference to a scalar; if defined and lockdown is
# not possible, a reason will be given here.
# $impotent (if defined and true) will attempt a hypothetical lockdown and
......@@ -1272,16 +1344,92 @@ sub MaxSliceExtension($$$;$$) {
# admission control constraints.
sub Lockdown($$;$$$) {
my ($class, $slice, $error, $impotent, $force) = @_;
my ($class, $target, $error, $impotent, $force) = @_;
my $expt;
# It's always a successful no-op if already locked down.
return 0 if( $slice->lockdown() );
if (ref($target) eq "GeniSlice") {
return 0 if( $target->lockdown() );
$expt = Experiment->Lookup( $target->exptidx() );
return -1
if (!defined($expt));
}
elsif (ref($target) eq "Experiment") {
return 0 if( $target->lockdown() );
$expt = $target;
}
else {
$$error = "Do not know how to lockdown $target" if (defined($error));
return -1;
}
my $exptidx = $slice->exptidx();
my $expt = Experiment->Lookup( $exptidx );
my $coderef = sub {
my ($error) = @_;
my $result;
if (ref($target) eq "GeniSlice") {
$result = $target->SetLockdown( 0 );
}
else {
$result = $target->LockDown( 1 );
}
if( $result < 0 && ref( $error ) ) {
$$error = "Couldn't update slice or experiment lockdown";
}
return $result;
};
return LockdownAux($class, $expt, $coderef, $error, $impotent, $force);
}
#
# Ditto swappable and autoswap. We can use the same support function below.
#
sub DisableSwapping($$;$$$)
{
my ($class, $experiment, $error, $impotent, $force) = @_;
my $coderef = sub {
my ($error) = @_;
my $result;
$result = $experiment->SetSwappable(0);
if( $result < 0 && ref( $error ) ) {
$$error = "Couldn't update swappable";
}
return $result;
};
return LockdownAux($class, $experiment,
$coderef, $error, $impotent, $force);
}
sub DisableAutoSwap($$;$$$)
{
my ($class, $experiment, $error, $impotent, $force) = @_;
my $coderef = sub {
my ($error) = @_;
my $result;
$result = $experiment->SetAutoswap(0);
if( $result < 0 && ref( $error ) ) {
$$error = "Couldn't update autoswap";
}
return $result;
};
return LockdownAux($class, $experiment,
$coderef, $error, $impotent, $force);
}
#
# Support for above.
#