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

Round of changes related to dataset approval:

Previously we forced all Portal datasets to auto approve at the target
cluster, now we let the local policy settings determine that, and return
status indicating that the dataset needs to be approved by an admin.

Plumbed through the approval path to the remote cluster.

Fixed up polling to handle unapproved datasets and to watch for new
failed state that Mike added to indicate that allocation failed.
parent 8cc005b8
...@@ -47,15 +47,17 @@ use GeniResponse; ...@@ -47,15 +47,17 @@ use GeniResponse;
use GeniCertificate; use GeniCertificate;
use GeniAuthority; use GeniAuthority;
use GeniCredential; use GeniCredential;
use WebTask;
use overload ('""' => 'Stringify'); use overload ('""' => 'Stringify');
# Configure variables # Configure variables
my $TB = "@prefix@"; my $TB = "@prefix@";
my $TBOPS = "@TBOPSEMAIL@"; my $TBOPS = "@TBOPSEMAIL@";
my $OURDOMAIN = "@OURDOMAIN@"; my $OURDOMAIN = "@OURDOMAIN@";
my $MAINSITE = @TBMAINSITE@;
# Debugging # Debugging
my $usemydevtree = 0; my $usemydevtree = ($MAINSITE ? 0 : 0);
# #
# Lookup by uuid. # Lookup by uuid.
...@@ -132,6 +134,26 @@ sub LookupByRemoteURN($$) ...@@ -132,6 +134,26 @@ sub LookupByRemoteURN($$)
return Lookup($class, $uuid); return Lookup($class, $uuid);
} }
#
# Lookup by remote UUID
#
sub LookupByRemoteUUID($$)
{
my ($class, $uuid) = @_;
return undef
if ($uuid !~ /^\w+\-\w+\-\w+\-\w+\-\w+$/);
my $query_result =
DBQueryWarn("select uuid from apt_datasets ".
"where remote_uuid='$uuid'");
return undef
if (!$query_result || !$query_result->numrows);
($uuid) = $query_result->fetchrow_array();
return Lookup($class, $uuid);
}
AUTOLOAD { AUTOLOAD {
my $self = $_[0]; my $self = $_[0];
my $type = ref($self) or croak "$self is not an object"; my $type = ref($self) or croak "$self is not an object";
...@@ -358,7 +380,7 @@ sub IsExpired($) ...@@ -358,7 +380,7 @@ sub IsExpired($)
} }
# #
# Load the project object for an experiment. # Load the project.
# #
sub GetProject($) sub GetProject($)
{ {
...@@ -374,6 +396,23 @@ sub GetProject($) ...@@ -374,6 +396,23 @@ sub GetProject($)
return $project; return $project;
} }
#
# Load the creator
#
sub GetCreator($)
{
my ($self) = @_;
require User;
my $creator = User->Lookup($self->creator_idx());
if (! defined($creator)) {
print("*** WARNING: Could not lookup creator object for $self!\n");
return undef;
}
return $creator;
}
# #
# Lock and Unlock # Lock and Unlock
# #
...@@ -465,6 +504,13 @@ sub GetGeniAuthority($) ...@@ -465,6 +504,13 @@ sub GetGeniAuthority($)
return APT_Geni::GetAuthority($self->aggregate_urn()); return APT_Geni::GetAuthority($self->aggregate_urn());
} }
sub GetAggregate($)
{
my ($self) = @_;
return APT_Aggregate->Lookup($self->aggregate_urn());
}
# #
# Warn creator that the experiment is going to expire. This is hooked # Warn creator that the experiment is going to expire. This is hooked
# in from the sa_daemon, so we can send a message that is less geni like # in from the sa_daemon, so we can send a message that is less geni like
...@@ -733,5 +779,35 @@ sub GetCredential($) ...@@ -733,5 +779,35 @@ sub GetCredential($)
"GetDatasetCredential", $args); "GetDatasetCredential", $args);
} }
#
# Approve a dataset using an auth credential.
#
sub ApproveDataset($)
{
my ($self) = @_;
my $authority = $self->GetGeniAuthority();
my $geniuser = $self->GetGeniUser();
my $context = APT_Geni::GeniContext();
my $cert = $self->GetCertificate();
return undef
if (! (defined($geniuser) && defined($authority) &&
defined($context) && defined($cert)));
my ($credential) =
APT_Geni::GenAuthCredential($cert, ["admin"]);
return undef
if (!defined($credential));
my $args = {
"dataset_urn" => $cert->urn(),
"credentials" => [$credential->asString()],
};
my $cmurl = $authority->url();
$cmurl =~ s/protogeni/protogeni\/stoller/ if ($usemydevtree);
return Genixmlrpc::CallMethod($cmurl, $context,
"ApproveDataset", $args);
}
# _Always_ make sure that this 1 is at the end of the file... # _Always_ make sure that this 1 is at the end of the file...
1; 1;
...@@ -39,6 +39,7 @@ sub usage() ...@@ -39,6 +39,7 @@ sub usage()
print STDERR "Usage: manage_dataset [options --] refresh ...\n"; print STDERR "Usage: manage_dataset [options --] refresh ...\n";
print STDERR "Usage: manage_dataset [options --] modify ...\n"; print STDERR "Usage: manage_dataset [options --] modify ...\n";
print STDERR "Usage: manage_dataset [options --] extend ...\n"; print STDERR "Usage: manage_dataset [options --] extend ...\n";
print STDERR "Usage: manage_dataset [options --] approve ...\n";
print STDERR "Usage: manage_dataset [options --] snapshot ...\n"; print STDERR "Usage: manage_dataset [options --] snapshot ...\n";
print STDERR "Usage: manage_dataset [options --] getcredential ...\n"; print STDERR "Usage: manage_dataset [options --] getcredential ...\n";
exit(-1); exit(-1);
...@@ -101,6 +102,7 @@ sub DoRefreshInternal($$); ...@@ -101,6 +102,7 @@ sub DoRefreshInternal($$);
sub DoGetCredential(); sub DoGetCredential();
sub DoModify(); sub DoModify();
sub DoExtend(); sub DoExtend();
sub DoApprove();
sub DoSnapshot(); sub DoSnapshot();
sub DoSnapShotInternal($$$$$); sub DoSnapShotInternal($$$$$);
sub PollDatasetStatus($$$); sub PollDatasetStatus($$$);
...@@ -164,6 +166,9 @@ elsif ($action eq "snapshot") { ...@@ -164,6 +166,9 @@ elsif ($action eq "snapshot") {
elsif ($action eq "getcredential") { elsif ($action eq "getcredential") {
exit(DoGetCredential()); exit(DoGetCredential());
} }
elsif ($action eq "approve") {
exit(DoApprove());
}
else { else {
usage(); usage();
} }
...@@ -381,22 +386,47 @@ sub DoCreate() ...@@ -381,22 +386,47 @@ sub DoCreate()
$dataset->Update({"remote_url" => $blob->{"url"}}); $dataset->Update({"remote_url" => $blob->{"url"}});
} }
# if ($type ne "imdataset") {
# Okay, this is silly; there is no distinct state for resource allocation. #
# It is unapproved and locked. The other side tells us its locked in the # Okay, this is silly; there is no distinct state for resource
# blob (busy), so look for this and set the state to busy. Then we poll # allocation. The other side now tells us expicitly that the
# waiting for the lease to go nonbusy and approved. Ick. # dataset (lease) was approved or not. If not approved there is
# # no reason to continue, we just want to tell the user in the
if ($blob->{"busy"}) { # web UI an send email to local tbops.
$dataset->Update({"state" => "busy"}); #
# If approved, then it is probably busy and we need to wait for
# it to finish.
#
if (! $blob->{'approved'}) {
$dataset->Update({"state" => "unapproved"});
if (defined($webtask)) {
$webtask->needapproval(1);
$webtask->unapproved_reason($blob->{'unapproved_reason'})
if (exists($blob->{'unapproved_reason'}));
}
$dataset->Unlock();
return 0;
}
if ($blob->{"busy"}) {
# Will poll for completion below.
$dataset->Update({"state" => "busy"});
}
else {
# This should no longer happen.
$dataset->Update({"state" => $blob->{"state"}});
$dataset->Unlock();
return 0;
}
} }
else { else {
$dataset->Update({"state" => $blob->{"state"}}); $dataset->Update({"state" => $blob->{"state"}});
if ($type ne "imdataset" || !defined($instance)) { # Not doing a snapshot so just exit. Not sure this actually happens.
if (!defined($instance)) {
$dataset->Unlock(); $dataset->Unlock();
return 0; return 0;
} }
} }
# #
# Handoff to snapshot if an imdataset. # Handoff to snapshot if an imdataset.
# #
...@@ -477,9 +507,23 @@ sub DoDelete() ...@@ -477,9 +507,23 @@ sub DoDelete()
sub DoRefresh() sub DoRefresh()
{ {
my $errmsg; my $errmsg;
my $errcode;
my $usage = sub {
print STDERR "Usage: manage_dataset refresh [-p] uuid\n";
exit(-1);
};
my $optlist = "p";
my $poll = 0;
my %options = ();
if (! getopts($optlist, \%options)) {
&$usage();
}
if (defined($options{"p"})) {
$poll = 1;
}
if (@ARGV != 1) { if (@ARGV != 1) {
fatal("usage: $0 refresh pid/name"); &$usage();
} }
my $token = shift(@ARGV); my $token = shift(@ARGV);
my $dataset = APT_Dataset->Lookup($token); my $dataset = APT_Dataset->Lookup($token);
...@@ -489,9 +533,17 @@ sub DoRefresh() ...@@ -489,9 +533,17 @@ sub DoRefresh()
if ($dataset->Lock()) { if ($dataset->Lock()) {
uerror("dataset is busy, cannot lock it"); uerror("dataset is busy, cannot lock it");
} }
my $errcode = DoRefreshInternal($dataset, \$errmsg); if ($poll) {
goto failed if (PollDatasetStatus($dataset, $dataset->GetAggregate(), \$errmsg)) {
if ($errcode); # Parent exits;
return 0;
}
}
else {
$errcode = DoRefreshInternal($dataset, \$errmsg);
goto failed
if ($errcode);
}
$dataset->Unlock(); $dataset->Unlock();
return 0; return 0;
...@@ -867,10 +919,35 @@ sub PollDatasetStatus($$$) ...@@ -867,10 +919,35 @@ sub PollDatasetStatus($$$)
while ($seconds > 0) { while ($seconds > 0) {
$seconds -= $interval; $seconds -= $interval;
if (!defined($aggregate) || #
# The second part of the test is to distingush between an
# imdataset snapshot at its home aggregate, and an imdataset
# taking place at another cluster and thus needing a copy
# back. We use a different polling function for the later,
# since there is no dataset to ask about, just an image that
# is doing a snapshot. This needs more thought, its not a
# great way to do this.
#
if ($dataset->type() =~ /^(lt|st)dataset$/ ||
$aggregate->aggregate_urn() eq $dataset->aggregate_urn()) { $aggregate->aggregate_urn() eq $dataset->aggregate_urn()) {
if (DoRefreshInternal($dataset, $perrmsg)) { my $errcode = DoRefreshInternal($dataset, $perrmsg);
if ($errcode) {
print STDERR $$perrmsg; print STDERR $$perrmsg;
if ($errcode == GENIRESPONSE_SEARCHFAILED) {
#
# The dataset is gone, so it failed allocation.
# This should not happen for an imdataset of course.
# Mark the dataset as failed, we do not know why
# though, the allocation is asynchronous, and the error
# went out in email. But we can tell the user in the
# web UI.
#
$dataset->Update({"state" => "failed"});
$dataset->webtask()->output("allocation failure");
$dataset->webtask()->Exited(GENIRESPONSE_SEARCHFAILED);
last;
}
# Otherwise we keep trying.
sleep($interval); sleep($interval);
next; next;
} }
...@@ -883,6 +960,7 @@ sub PollDatasetStatus($$$) ...@@ -883,6 +960,7 @@ sub PollDatasetStatus($$$)
} }
} }
if ($dataset->state() eq "valid") { if ($dataset->state() eq "valid") {
print "Dataset is now valid\n";
$project->SendEmail($this_user->email(), $project->SendEmail($this_user->email(),
"Your dataset is now ready to use", "Your dataset is now ready to use",
"Dataset '$dname' is now ready to use.\n", "Dataset '$dname' is now ready to use.\n",
...@@ -892,6 +970,7 @@ sub PollDatasetStatus($$$) ...@@ -892,6 +970,7 @@ sub PollDatasetStatus($$$)
} }
sleep($interval); sleep($interval);
} }
unlink($logfile) if (defined($logfile));
$dataset->webtask()->Exited(-1) $dataset->webtask()->Exited(-1)
if ($seconds <= 0); if ($seconds <= 0);
return 0; return 0;
...@@ -1083,6 +1162,130 @@ sub PollImageStatus($$$) ...@@ -1083,6 +1162,130 @@ sub PollImageStatus($$$)
return 0; return 0;
} }
#
# Approve
#
sub DoApprove()
{
my $errmsg;
my $logname;
my $usage = sub {
print STDERR "Usage: manage_dataset approve pid/name\n";
exit(-1);
};
if (@ARGV != 1) {
&$usage();
}
my $token = shift(@ARGV);
my $dataset = APT_Dataset->Lookup($token);
if (!defined($dataset)) {
fatal("No such dataset");
}
my $dname = $dataset->dataset_id();
if (!$this_user->IsAdmin()) {
fatal("No permission to schedule reservation cancellation")
}
if ($dataset->Lock()) {
uerror("dataset is busy, cannot lock it");
}
my $project = $dataset->GetProject();
my $creator = $dataset->GetCreator();
my $response = $dataset->ApproveDataset();
if (!defined($response)) {
$errmsg = "RPC Error calling ExtendDataset";
goto failed;
}
if ($response->code() != GENIRESPONSE_SUCCESS) {
if ($response->code() == GENIRESPONSE_SEARCHFAILED) {
$errmsg = "Dataset no longer exists at the target\n";
}
else {
$errmsg = "ApproveDataset failed: ". $response->output() . "\n";
}
goto failed;
}
# No failure, change the state now so the web interface sees a change.
$dataset->Update({"state" => "busy"});
#
# Now we want to poll for allocation completion so we can tell the
# web interface when it is done (or failed). We know this when the
# state changes to valid or failed.
#
if (! $debug) {
$logname = TBMakeLogname("approvedataset");
if (my $childpid = TBBackGround($logname)) {
exit(0);
}
# Let parent exit;
sleep(2);
}
$dataset->webtask()->SetProcessID($PID);
# Arbitrary max wait.
my $seconds = 1200;
my $interval = 15;
while ($seconds > 0) {
my $errcode = DoRefreshInternal($dataset, \$errmsg);
if ($errcode) {
print STDERR $errmsg;
if ($errcode == GENIRESPONSE_SEARCHFAILED) {
#
# The dataset is gone, so it failed allocation.
# This should not happen for an imdataset of course.
# Mark the dataset as failed, we do not know why
# though, the allocation is asynchronous, and the error
# went out in email. But we can tell the user in the
# web UI.
#
$dataset->Update({"state" => "failed"});
$dataset->webtask()->output("allocation failure");
$dataset->webtask()->Exited(GENIRESPONSE_SEARCHFAILED);
last;
}
# Otherwise we keep trying.
goto again;
}
if ($dataset->state() eq "valid") {
$creator->SendEmail("Your dataset is now ready to use",
"Dataset '$dname' is now ready to use.\n",
$project->LogsEmailAddress(), $TBOPS);
$dataset->webtask()->Exited(0);
last;
}
if ($dataset->state() eq "failed") {
$creator->SendEmail("Your dataset failed to allocate!",
"Dataset '$dname' could not be allocated!\n",
$project->LogsEmailAddress(), $TBOPS);
$dataset->webtask()->Exited(0);
}
again:
$seconds -= $interval;
sleep($interval);
}
if ($seconds <= 0) {
$creator->SendEmail("Your dataset timed out while allocating!",
"Dataset '$dname' timed out while allocating!\n",
$project->LogsEmailAddress(), $TBOPS);
$dataset->Update({"state" => "failed"});
$dataset->webtask()->Exited(-1);
}
unlink($logname) if (defined($logname));
$dataset->Unlock();
return 0;
failed:
unlink($logname) if (defined($logname));
$dataset->Unlock();
# This will set the webtask, see below.
fatal($errmsg);
}
sub fatal($) sub fatal($)
{ {
my ($mesg) = @_; my ($mesg) = @_;
......
...@@ -108,6 +108,7 @@ my $CREATEDATASET = "$TB/bin/createdataset"; ...@@ -108,6 +108,7 @@ my $CREATEDATASET = "$TB/bin/createdataset";
my $DELETEDATASET = "$TB/bin/deletelease"; my $DELETEDATASET = "$TB/bin/deletelease";
my $EXTENDDATASET = "$TB/bin/extendlease"; my $EXTENDDATASET = "$TB/bin/extendlease";
my $GRANTDATASET = "$TB/bin/grantlease"; my $GRANTDATASET = "$TB/bin/grantlease";
my $APPROVEDATASET = "$TB/bin/approvelease";
my $GRANTIMAGE = "$TB/sbin/grantimage"; my $GRANTIMAGE = "$TB/sbin/grantimage";
my $WAP = "$TB/sbin/withadminprivs"; my $WAP = "$TB/sbin/withadminprivs";
my $SHAREVLAN = "$TB/sbin/sharevlan"; my $SHAREVLAN = "$TB/sbin/sharevlan";
...@@ -4512,6 +4513,10 @@ sub CreateDataset($) ...@@ -4512,6 +4513,10 @@ sub CreateDataset($)
my ($argref) = @_; my ($argref) = @_;
my $credentials = $argref->{'credentials'}; my $credentials = $argref->{'credentials'};
my $dataset_urn = $argref->{'dataset_urn'}; my $dataset_urn = $argref->{'dataset_urn'};
my $POLICY_FAIL = 2;
my $needapproval = 0;
my $unapproved_reason;
require WebTask;
require Lease; require Lease;
require Image; require Image;
require EmulabConstants; require EmulabConstants;
...@@ -4596,9 +4601,11 @@ sub CreateDataset($) ...@@ -4596,9 +4601,11 @@ sub CreateDataset($)
if (defined($lease)) { if (defined($lease)) {
GeniResponse->Create(GENIRESPONSE_ALREADYEXISTS); GeniResponse->Create(GENIRESPONSE_ALREADYEXISTS);
} }
my $cmd = "$CREATEDATASET -C -b "; my $opts = "-b ";
my $cmd = "$CREATEDATASET ";
if ($PROTOGENI_LOCALUSER) { if ($PROTOGENI_LOCALUSER) {
$cmd = "$WAP $cmd -o ". $user->uid() . " "; $opts .= "-o ". $user->uid() . " ";
$cmd = "$WAP $cmd ";
# #
# We do this as admin so that we create dataset owned by this # We do this as admin so that we create dataset owned by this
# user and in the target project. # user and in the target project.
...@@ -4609,7 +4616,7 @@ sub CreateDataset($) ...@@ -4609,7 +4616,7 @@ sub CreateDataset($)
my $size = $argref->{'size'}; my $size = $argref->{'size'};
return GeniResponse->MalformedArgsResponse("Bad size, use MiBs") return GeniResponse->MalformedArgsResponse("Bad size, use MiBs")
if ($size !~ /^\d+$/); if ($size !~ /^\d+$/);
$cmd .= " -s $size"; $opts .= " -s $size ";
} }
if (exists($argref->{'type'})) { if (exists($argref->{'type'})) {
my $type = $argref->{'type'}; my $type = $argref->{'type'};
...@@ -4617,26 +4624,26 @@ sub CreateDataset($) ...@@ -4617,26 +4624,26 @@ sub CreateDataset($)
if ($type !~ /^[-\w]+$/); if ($type !~ /^[-\w]+$/);
return GeniResponse->MalformedArgsResponse("Mismatching type") return GeniResponse->MalformedArgsResponse("Mismatching type")
if ($type ne $credential->target_urn()->type()); if ($type ne $credential->target_urn()->type());
$cmd .= " -t $type"; $opts .= " -t $type ";
} }
if (exists($argref->{'fstype'})) { if (exists($argref->{'fstype'})) {
my $fstype = $argref->{'fstype'}; my $fstype = $argref->{'fstype'};
return GeniResponse->MalformedArgsResponse("Bad FS type") return GeniResponse->MalformedArgsResponse("Bad FS type")
if ($fstype !~ /^[-\w]+$/); if ($fstype !~ /^[-\w]+$/);
$cmd .= " -f $fstype"; $opts .= " -f $fstype ";
} }
if (exists($argref->{'read_access'})) { if (exists($argref->{'read_access'})) {
my $read_access = $argref->{'read_access'}; my $read_access = $argref->{'read_access'};
return GeniResponse->MalformedArgsResponse("Bad read access") return GeniResponse->MalformedArgsResponse("Bad read access")
if (! ($read_access eq "project" || $read_access eq "global")); if (! ($read_access eq "project" || $read_access eq "global"));
$cmd .= " -R $read_access"; $opts .= " -R $read_access ";
} }
if (exists($argref->{'write_access'})) {