Commit 03e4d8bc authored by Leigh B Stoller's avatar Leigh B Stoller

Changed related to parameter sets and experiment bindings:

* Show the parameter bindings on the status page for an experiment, and
  on the memlane page. This is strictly informational so that users can
  quickly see the parameters that are/were chosen at the time the
  experiment was created.

* Add a Save Parameters button on the memlane and status pages. This
  will generate a json structure and store it in the DB for that profile
  and user. Optionally, mark the parameter set as specific to a profile
  version or repo hash, so a user can quickly link to that version/hash
  and apply the parameter set.

* On the instantiate page, the parameters step include new buttons to
  1) reset the form to default, 2) apply the parameters used in the most
  recent experiment (current, then history), 3) choose from a dropdown
  of parameters the users has saved for that profile, and 4) take the
  user to their activation history for the profile, to pick one to run
  again or save parameters.

* Add a new tab to the user dashboard to show the user's saved parameter
  sets.

* Lots of changes to the new version of the ppwizard for apply
  parameter sets and showing warnings about them. This code has NOT been
  applied to the old ppwizard.
parent 03ca4aa5
......@@ -1867,6 +1867,158 @@ sub ResolveDefer($)
return 0;
}
###################################################################
package APT_Instance::History;
use emdb;
use libtestbed;
use Carp;
use JSON;
use English;
use GeniXML;
use GeniHRN;
use Date::Parse;
use Data::Dumper;
use vars qw($AUTOLOAD);
use overload ('""' => 'Stringify');
#
# Lookup and create a class instance to return.
#
sub Lookup($$$)
{
my ($class, $uuid) = @_;
my $query_result =
DBQueryWarn("select * from apt_instance_history where uuid='$uuid'");
return undef
if (! (defined($query_result) && $query_result->numrows));
my $self = {};
$self->{'DBROW'} = $query_result->fetchrow_hashref();
bless($self, $class);
#
# Get the list of aggregate records. Early records do not have one.
#
$query_result =
DBQueryWarn("select * from apt_instance_aggregate_history ".
"where uuid='$uuid'");
return undef
if (!defined($query_result));
if (!$query_result->numrows) {
my $that = {
"DBROW" => {
"uuid" => $self->uuid(),
"name" => $self->name(),
"aggregate_urn" => $self->aggregate_urn(),
"status" => $self->status(),
"public_url" => $self->public_url(),
"manifest" => $self->manifest(),
}
};
bless($that, "APT_Instance::History::Aggregate");
$self->{"AGGREGATES"} = {
$self->aggregate_urn() => $that
};
}
else {
$self->{"AGGREGATES"} = {};
while (my $row = $query_result->fetchrow_hashref()) {
my $that = {"DBROW" => $row};
bless($that, "APT_Instance::History::Aggregate");
$self->{"AGGREGATES"}->{$that->aggregate_urn()} = $that;
}
}
return $self;
}
AUTOLOAD {
my $self = $_[0];
my $type = ref($self) or confess "$self is not an object";
my $name = $AUTOLOAD;
$name =~ s/.*://; # strip fully-qualified portion
# A DB row proxy method call.
if (exists($self->{'DBROW'}->{$name})) {
return $self->{'DBROW'}->{$name};
}
carp("No such slot '$name' field in class $type");
return undef;
}
sub AggregateList($) { return values(%{ $_[0]->{'AGGREGATES'} }); }
sub AggregateHash($) { return $_[0]->{'AGGREGATES'}; }
#
# Stringify for output.
#
sub Stringify($)
{
my ($self) = @_;
my $uuid = $self->uuid();
my $pid = $self->pid();
my $name = $self->name();
return "[APT_InstanceHistory: $pid,$name]";
}
# Break circular reference someplace to avoid exit errors.
sub DESTROY {
my $self = shift;
$self->{'DBROW'} = undef;
$self->{'AGGREGATES'} = undef;
}
###################################################################
package APT_Instance::History::Aggregate;
use emdb;
use libtestbed;
use Carp;
use JSON;
use English;
use GeniXML;
use GeniHRN;
use Data::Dumper;
use vars qw($AUTOLOAD);
use overload ('""' => 'Stringify');
AUTOLOAD {
my $self = $_[0];
my $type = ref($self) or confess "$self is not an object";
my $name = $AUTOLOAD;
$name =~ s/.*://; # strip fully-qualified portion
# A DB row proxy method call.
if (exists($self->{'DBROW'}->{$name})) {
return $self->{'DBROW'}->{$name};
}
carp("No such slot '$name' field in class $type");
return undef;
}
#
# Stringify for output.
#
sub Stringify($)
{
my ($self) = @_;
my $uuid = $self->uuid();
my $urn = $self->aggregate_urn();
return "[APT_InstanceHistory::Aggregate: $uuid, $urn]";
}
# Break circular reference someplace to avoid exit errors.
sub DESTROY {
my $self = shift;
$self->{'DBROW'} = undef;
}
###################################################################
package APT_Instance::ExtensionInfo;
use emdb;
......
......@@ -711,6 +711,9 @@ sub Delete($$)
DBQueryWarn("delete from apt_profile_favorites ".
"where profileid='$profileid'")
or goto bad;
DBQueryWarn("delete from apt_parameter_sets ".
"where profileid='$profileid'")
or goto bad;
DBQueryWarn("delete from apt_profile_images ".
"where profileid='$profileid'")
or goto bad;
......@@ -2109,6 +2112,98 @@ sub Convert2Genilib($)
return 0;
}
#
# Convert data_set in rspec to simplified bindings array.
#
sub GetBindings($$$)
{
my ($rspec, $pbindings, $perrmsg) = @_;
if (!ref($rspec)) {
$rspec = GeniXML::Parse($rspec);
if (! defined($rspec)) {
$$perrmsg = "GetBindings: Could not parse rspec";
return -1;
}
}
my $dataset = GeniXML::FindNodesNS("n:data_set", $rspec,
$GeniXML::PROFILE_PARAMETERS_NS)->pop();
if (! defined($dataset)) {
$$perrmsg = "No parameter bindings in the rspec";
return -1;
}
# Mistaken data_set in some history entries, so need to process a bit
# differently
if (!$dataset->hasChildNodes()) {
$dataset = $rspec;
}
#
# Convert XML goo to multilevel array of bindings.
#
my $bindings = {};
my $processSet;
#
# Process each item in the dataset.
#
$processSet = sub {
my ($ref, $bindings) = @_;
my $which = $ref->nodeName();
if ($which eq "data_list") {
my $name = GeniXML::GetText("name", $ref);
my @list = ();
foreach my $child ($ref->childNodes()) {
my $nodeName = $child->nodeName();
if ($nodeName eq "data_member_item") {
my $value = $child->findvalue('.');
push(@list, $value);
}
elsif ($nodeName eq "data_struct") {
my $b = {};
&$processSet($child, $b);
push(@list, $b);
}
}
# Not sure why the name is in dotted notation. Kill it.
my @tokens = split(/[.]/, $name);
if (@tokens > 1) {
$name = pop(@tokens);
}
$bindings->{$name} = \@list;
}
elsif ($which eq "data_struct") {
foreach my $child ($ref->childNodes()) {
my $nodeName = $child->nodeName();
&$processSet($child, $bindings);
}
}
elsif ($which eq "data_item" ||
$which eq "data_member_item") {
my $name = GeniXML::GetText("name", $ref);
my $value = $ref->findvalue('.');
# Not sure why the name is in dotted notation. Kill it.
my @tokens = split(/[.]/, $name);
if (@tokens > 1) {
$name = pop(@tokens);
}
$bindings->{$name} = $value;
}
};
foreach my $ref ($dataset->childNodes()) {
next
if ($ref->nodeName() !~ /^data/ || $ref->nodeName eq "data_set");
&$processSet($ref, $bindings);
}
$$pbindings = $bindings;
return 0;
}
###################################################################
package APT_Profile::ImageInfo;
use emdb;
......
......@@ -34,6 +34,7 @@ use XML::Simple;
use File::Temp qw(tempfile :mktemp tmpnam :POSIX);
use Date::Parse;
use Data::Dumper;
use JSON;
use Cwd qw(realpath);
#
......@@ -272,7 +273,8 @@ foreach my $key ("username", "email", "profile", "portal") {
#
my ($value, $user_urn, $user_uid, $user_hrn, $user_email, $project, $pid,
$gid, $group, $sshkey, $profile, $profileid, $version, $rspecstr, $errmsg,
$userslice_id, $portal, $script, $reporef, $repohash, $duration);
$userslice_id, $portal, $script, $paramdefs, $bindings,
$reporef, $repohash, $duration);
# This is used internally to determine which portal was used.
$portal = $xmlparse->{'attribute'}->{"portal"}->{'value'};
......@@ -373,6 +375,14 @@ if ($profile->repourl()) {
fatal("Missing refspec for repository");
}
}
if (exists($xmlparse->{'attribute'}->{"paramdefs"})) {
$paramdefs = $xmlparse->{'attribute'}->{"paramdefs"}->{'value'};
if (! TBcheck_dbslot($paramdefs, "default", "html_fulltext",
TBDB_CHECKDBSLOT_WARN|TBDB_CHECKDBSLOT_ERROR)) {
fatal("Illegal paramdefs for repo-based profile");
}
}
if (exists($xmlparse->{'attribute'}->{"reporef"})) {
if (!exists($xmlparse->{'attribute'}->{"repohash"})) {
fatal("Missing hash for repository");
......@@ -393,6 +403,28 @@ if ($profile->repourl()) {
# Otherwise we are instantiating whatever the profile itself references.
$reporef = "refs/heads/master";
$repohash = $profile->repohash();
$paramdefs= $profile->paramdefs();
}
}
#
# We want to stash simplified bindings in the DB whie the instance is
# active, for display purposes.
#
if (defined($paramdefs)) {
if (APT_Profile::GetBindings($rspecstr, \$bindings, \$errmsg)) {
fatal($errmsg);
}
}
elsif ($profile->paramdefs() && $profile->paramdefs() ne "") {
if (APT_Profile::GetBindings($rspecstr, \$bindings, \$errmsg)) {
fatal($errmsg);
}
}
if (defined($bindings)) {
$bindings = eval { encode_json($bindings); };
if ($@) {
fatal("Could not json encode bindings");
}
}
......@@ -848,6 +880,9 @@ my $blob = {'uuid' => $quickvm_uuid,
'cert' => $alt_certificate->cert(),
'privkey' => $alt_certificate->PrivKeyDelimited(),
};
if (defined($bindings)) {
$blob->{"params"} = $bindings;
}
if ($profile->repourl()) {
if (defined($script)) {
$blob->{"script"} = $script;
......@@ -855,6 +890,7 @@ if ($profile->repourl()) {
$blob->{"repourl"} = $profile->repourl();
$blob->{"reporef"} = $reporef;
$blob->{"repohash"} = $repohash;
$blob->{"paramdefs"} = $paramdefs if (defined($paramdefs));
}
if (defined($project)) {
$blob->{"pid"} = $project->pid();
......
......@@ -29,8 +29,9 @@ use File::Temp qw(tempfile :mktemp :POSIX);
use Data::Dumper;
use CGI;
use POSIX ":sys_wait_h";
use POSIX qw(setsid);
use POSIX qw(setsid strftime);
use Carp qw(cluck);
use JSON;
#
# Back-end script to manage APT profiles.
......@@ -44,6 +45,11 @@ sub usage()
print("Usage: manage_profile delete -a <profile>\n");
print("Usage: manage_profile undelete pid,name:version\n");
print("Usage: manage_profile listimages <profile>\n");
print("Usage: manage_profile bindings <profile> <instance>\n");
print("Usage: manage_profile paramset ".
"[-u user] [-m description] [-b] add <name> <profile> <instance>\n");
print("Usage: manage_profile paramset ".
"[-u user] delete <name> <profile>\n");
exit(-1);
}
my $optlist = "dvt:m";
......@@ -119,6 +125,8 @@ sub GetScriptParameters($$);
sub VerifyXML($$);
sub ModifyProfileInternal($$$);
sub UseNewGenilib($);
sub Bindings();
sub ParamSet();
# The web interface (and in the future the xmlrpc interface) sets this.
my $this_user = User->ImpliedUser();
......@@ -219,6 +227,12 @@ elsif ($action eq "listimages") {
elsif ($action eq "create") {
exit(CreateProfile());
}
elsif ($action eq "bindings") {
exit(Bindings());
}
elsif ($action eq "paramset") {
exit(ParamSet());
}
else {
usage();
}
......@@ -1111,6 +1125,33 @@ sub UserError($)
exit(1);
}
#
# Not sure what I was thinking above, XML was dumb.
#
sub UserErrorSane($)
{
my ($ref) = @_;
my $errors = {};
if (ref($ref) eq "SCALAR") {
$errors->{"error"} = $$ref;
}
else {
$errors = $ref;
}
if (defined($webtask_id)) {
$webtask->Exited(1);
$webtask->errors($errors);
}
else {
foreach my $key (keys(%$errors)) {
print "$key: " . $errors->{$key} . "\n";
}
}
# Exit with positive status so web interface treats it as user error.
exit(1);
}
sub escapeshellarg($)
{
my ($str) = @_;
......@@ -1680,3 +1721,189 @@ sub UseNewGenilib($)
return 0;
}
#
# Get the bindings used in an instance (which might be in the history table)
# and return them as a json array.
#
sub Bindings()
{
my $optlist = "";
my $bindings;
my $errmsg;
my %options = ();
if (! getopts($optlist, \%options)) {
usage();
}
usage()
if (@ARGV != 2);
my $profile = APT_Profile->Lookup($ARGV[0]);
if (!defined($profile)) {
fatal("No such profile exists: " . $ARGV[0]);
}
my $instance = APT_Instance->Lookup($ARGV[1]);
if (!$instance) {
$instance = APT_Instance::History->Lookup($ARGV[1]);
if (!$instance) {
fatal("No such instance");
}
}
#print $instance->rspec() . "\n";
my $rspec = GeniXML::Parse($instance->rspec());
if (! defined($rspec)) {
fatal("Could not parse rspec");
}
if (APT_Profile::GetBindings($rspec, \$bindings, \$errmsg)) {
fatal($errmsg);
}
if (defined($webtask)) {
$webtask->bindings($bindings);
$webtask->Exited(0);
}
else {
print Dumper($bindings);
}
return 0;
}
#
# Deal with parameter sets.
#
sub ParamSet()
{
my $optlist = "u:m:b";
my $bound = 0;
my $user;
my $description;
my $bindings;
my $errmsg;
my %options = ();
if (! getopts($optlist, \%options)) {
usage();
}
if (defined($options{"u"})) {
$user = User->Lookup($options{"u"});
if (!defined($user)) {
fatal("No such user");
}
}
else {
$user = $this_user;
}
my $uid = $user->uid();
my $uid_idx = $user->uid_idx();
usage()
if (@ARGV < 3);
my $op = shift(@ARGV);
if (! ($op eq "add" || $op eq "delete")) {
fatal("Improper action");
}
my $name = shift(@ARGV);
if ($name !~ /^[-\w]+$/ || length($name) >= 32) {
UserErrorSane({"name" => "Alphanumeric no greater then 32 characters"});
}
my $safe_name = DBQuoteSpecial($name);
my $profile = APT_Profile->Lookup(shift(@ARGV));
if (!defined($profile)) {
fatal("No such profile");
}
my $profileid = $profile->profileid();
if ($op eq "delete") {
my $query_result =
DBQueryWarn("select uuid from apt_parameter_sets ".
"where uid_idx='$uid_idx' and ".
" profileid='$profileid' and name=$safe_name");
fatal("Database error")
if (!defined($query_result));
if (!$query_result->numrows) {
fatal("No such parameter set");
}
if (!DBQueryWarn("delete from apt_parameter_sets ".
"where uid_idx='$uid_idx' and ".
" profileid='$profileid' and name=$safe_name")) {
fatal("DB error deleting parameter set");
}
if (defined($webtask)) {
$webtask->Exited(0);
}
return 0;
}
usage()
if (@ARGV != 1);
if (defined($options{"m"})) {
$description = $options{"m"};
if (! TBcheck_dbslot($description, "default", "tinytext",
TBDB_CHECKDBSLOT_ERROR)) {
UserErrorSane({"description" => TBFieldErrorString()});
}
}
else {
$description = "Created on " .
POSIX::strftime("20%y-%m-%d %H:%M:%S %Z", localtime(time()));
}
if (defined($options{"b"})) {
$bound = 1;
}
# Ensure name is unique.
my $query_result =
DBQueryWarn("select uuid from apt_parameter_sets ".
"where uid_idx='$uid_idx' and ".
" profileid='$profileid' and name=$safe_name");
fatal("Database error")
if (!defined($query_result));
if ($query_result->numrows) {
UserErrorSane({"name" => "Already in use"});
}
my $instance = APT_Instance->Lookup($ARGV[0]);
if (!$instance) {
$instance = APT_Instance::History->Lookup($ARGV[0]);
if (!$instance) {
fatal("No such instance");
}
}
my $rspec = GeniXML::Parse($instance->rspec());
if (! defined($rspec)) {
fatal("Could not parse rspec");
}
if (APT_Profile::GetBindings($rspec, \$bindings, \$errmsg)) {
fatal($errmsg);
}
print Dumper($bindings);
$bindings = eval { encode_json($bindings); };
if ($@) {
fatal("Could not json encode the bindings\n");
}
my $safe_bindings = DBQuoteSpecial($bindings);
my $safe_descrip = DBQuoteSpecial($description);
my $query =
"insert into apt_parameter_sets set created=now(), ".
" uuid=uuid(),uid='$uid',uid_idx='$uid_idx', ".
" profileid='$profileid',bindings=$safe_bindings, ".
" name=$safe_name,description=$safe_descrip";
if ($bound) {
$query .= ",version_uuid=" . DBQuoteSpecial($profile->uuid());
if ($profile->repourl()) {
$query .= ",reporef=" . DBQuoteSpecial($instance->reporef());
$query .= ",repohash=" . DBQuoteSpecial($instance->repohash());
}
}
$query_result = DBQueryWarn($query);
if (!$query_result) {
fatal("Could not insert bindings into DB");
}
if (defined($webtask)) {
$webtask->Exited(0);
}
return 0;
}
#!/usr/bin/perl -wT
#
# Copyright (c) 2005-2017 University of Utah and the Flux Group.
# Copyright (c) 2005-2019 University of Utah and the Flux Group.
#
# {{{EMULAB-LICENSE
#
......@@ -717,6 +717,8 @@ sub Delete($)
or return -1;
DBQueryWarn("delete from apt_profile_favorites where uid_idx='$uid_idx'")
or return -1;
DBQueryWarn("delete from apt_parameter_sets where uid_idx='$uid_idx'")
or return -1;
DBQueryWarn("delete from users where uid_idx='$uid_idx'")
or return -1;
......
......@@ -525,6 +525,27 @@ CREATE TABLE `apt_news` (
PRIMARY KEY (`idx`)
) ENGINE=MyISAM DEFAULT CHARSET=latin1;
--
-- Table structure for table `apt_parameter_sets`
--
DROP TABLE IF EXISTS `apt_parameter_sets`;
CREATE TABLE `apt_parameter_sets` (
`uuid` varchar(40) NOT NULL,
`uid` varchar(8) NOT NULL default '',
`uid_idx` mediumint(8) unsigned NOT NULL default '0',
`created` datetime default NULL,
`name` varchar(64) NOT NULL default '',
`description` text,
`profileid` int(10) unsigned NOT NULL default '0',
`version_uuid` varchar(40) default NULL,
`reporef` varchar(128) default NULL,
`repohash` varchar(64) default NULL,
`bindings` mediumtext,
PRIMARY KEY (`uuid`),
UNIQUE KEY (`uid_idx`,`profileid`,`name`)
) ENGINE=MyISAM DEFAULT CHARSET=latin1;
--
-- Table structure for table `apt_profile_favorites`
--
......
use strict;
use libdb;
sub DoUpdate($$$)
{
my ($dbhandle, $dbname, $version) = @_;
if (!DBTableExists("apt_parameter_sets")) {