Commit 8b9e74a5 authored by Leigh Stoller's avatar Leigh Stoller

Add web interface for creating remote datasets on APT. The same code is

used to manage local blockstores (datasets). A cheesy iframe hack is used
to embed the APT pages (slick new interface) inside the antique Emulab
interface.

Currently the only hooks from the admin drop down menu, since there is some
additional work before we let users see it.
parent a3e565f4
#!/usr/bin/perl -wT
#
# Copyright (c) 2007-2014 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/>.
#
# }}}
#
package APT_Dataset;
use strict;
use English;
use Data::Dumper;
use Carp;
use Exporter;
use vars qw(@ISA @EXPORT $AUTOLOAD);
@ISA = "Exporter";
@EXPORT = qw ( );
# Must come after package declaration!
use EmulabConstants;
use emdb;
use emutil;
use libtestbed;
use APT_Geni;
use Genixmlrpc;
use GeniResponse;
use GeniCertificate;
use overload ('""' => 'Stringify');
# Configure variables
my $TB = "@prefix@";
my $TBOPS = "@TBOPSEMAIL@";
#
# Lookup by uuid.
#
sub Lookup($$;$)
{
my ($class, $token) = @_;
my $query_result;
if ($token =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/) {
$query_result =
DBQueryWarn("select * from apt_datasets where uuid='$token'");
}
elsif ($token =~ /^([-\w]+)\/([-\w]+)$/) {
$query_result =
DBQueryWarn("select * from apt_datasets ".
"where pid='$1' and dataset_id='$2'");
}
else {
return undef;
}
return undef
if (!$query_result || !$query_result->numrows);
my $self = {};
$self->{'DATASET'} = $query_result->fetchrow_hashref();
bless($self, $class);
return $self;
}
AUTOLOAD {
my $self = $_[0];
my $type = ref($self) or croak "$self is not an object";
my $name = $AUTOLOAD;
$name =~ s/.*://; # strip fully-qualified portion
# A DB row proxy method call.
if (exists($self->{'DATASET'}->{$name})) {
return $self->{'DATASET'}->{$name};
}
carp("No such slot '$name' field in class $type");
return undef;
}
# Break circular reference someplace to avoid exit errors.
sub DESTROY {
my $self = shift;
$self->{'DATASET'} = undef;
}
#
# Refresh a class instance by reloading from the DB.
#
sub Refresh($)
{
my ($self) = @_;
return -1
if (! ref($self));
my $uuid = $self->uuid();
my $query_result =
DBQueryWarn("select * from apt_datasets where uuid='$uuid'");
return -1
if (!$query_result || !$query_result->numrows);
$self->{'DATASET'} = $query_result->fetchrow_hashref();
return 0;
}
#
# Create an Dataset
#
sub Create($$)
{
my ($class, $argref) = @_;
my $uuid;
if (exists($argref->{'uuid'})) {
$uuid = $argref->{'uuid'};
delete($argref->{'uuid'});
}
else {
$uuid = NewUUID();
}
my $idx = TBGetUniqueIndex('next_leaseidx');
#
# The uuid has to be unique, so lock the table for the check/insert.
#
DBQueryWarn("lock tables apt_datasets write")
or return undef;
my $query_result =
DBQueryWarn("select uuid from apt_datasets where uuid='$uuid'");
if ($query_result->numrows) {
DBQueryWarn("unlock tables");
tberror("Dataset uuid $uuid already exists!");
return undef;
}
my $query = "insert into apt_datasets set ".
" locked=now(),locker_pid='$PID', ".
" idx='$idx',created=now(),uuid='$uuid', ".
join(",", map("$_=" .
DBQuoteSpecial($argref->{$_}), keys(%{$argref})));
if (! DBQueryWarn($query)) {
DBQueryWarn("unlock tables");
tberror("Error inserting new apt_datasets record for $uuid!");
return undef;
}
DBQueryWarn("unlock tables");
return Lookup($class, $uuid);
}
#
# Stringify for output.
#
sub Stringify($)
{
my ($self) = @_;
my $uuid = $self->uuid();
return "[APT_Dataset: $uuid]";
}
#
# Perform some updates ...
#
sub Update($$)
{
my ($self, $argref) = @_;
# Must be a real reference.
return -1
if (! ref($self));
my $uuid = $self->uuid();
my $query = "update apt_datasets set ".
join(",", map("$_=" . DBQuoteSpecial($argref->{$_}), keys(%{$argref})));
$query .= " where uuid='$uuid'";
return -1
if (! DBQueryWarn($query));
return Refresh($self);
}
sub Delete($)
{
my ($self) = @_;
# Must be a real reference.
return -1
if (! ref($self));
my $uuid = $self->uuid();
DBQueryWarn("delete from apt_datasets where uuid='$uuid'") or
return -1;
return 0;
}
sub SetStatus($$)
{
my ($self,$status) = @_;
# Must be a real reference.
return -1
if (! ref($self));
my $uuid = $self->uuid();
DBQueryWarn("update apt_datasets set status='$status' ".
"where uuid='$uuid'") or
return -1;
$self->{'DATASET'}->{'status'} = $status;
return 0;
}
#
# Lock and Unlock
#
sub Lock($;$)
{
my ($self, $steal) = @_;
# Already locked?
if ($self->GotLock()) {
return 0;
}
return -1
if (!DBQueryWarn("lock tables apt_datasets write"));
my $idx = $self->idx();
my $query_result =
DBQueryWarn("update apt_datasets set locked=now(),locker_pid=$PID " .
"where idx=$idx ".
(!defined($steal) ? "and locked is null" : ""));
if (! $query_result ||
$query_result->numrows == 0) {
DBQueryWarn("unlock tables");
return -1
}
DBQueryWarn("unlock tables");
$self->{'LOCKED'} = time();
$self->{'LOCKER_PID'} = $PID;
return 0;
}
sub Unlock($)
{
my ($self) = @_;
my $idx = $self->idx();
return -1
if (! DBQueryWarn("update apt_datasets set locked=null,locker_pid=0 " .
"where idx=$idx"));
$self->{'LOCKED'} = 0;
$self->{'LOCKER_PID'} = 0;
return 0;
}
sub GotLock($)
{
my ($self) = @_;
return 1
if ($self->{'LOCKED'} &&
$self->{'LOCKER_PID'} == $PID);
return 0;
}
sub TakeLock($)
{
my ($self) = @_;
return $self->Lock(1);
}
#
# Locate Geni objects
#
sub GetGeniUser($)
{
my ($self) = @_;
require GeniUser;
require User;
#
# Only local users can do this, so do a direct local lookup.
#
my $user = User->Lookup($self->creator_idx());
return undef
if (!defined($user));
return GeniUser->CreateFromLocal($user);
}
sub GetGeniAuthority($)
{
my ($self) = @_;
require GeniAuthority;
return APT_Geni::GetAuthority($self->aggregate_urn());
}
#
# 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
# and more APT/Cloud.
#
sub WarnExpiring($$)
{
my ($self, $when) = @_;
return 0;
}
#
# Create a dataset on the remote aggregate.
#
sub CreateDataset($)
{
my ($self) = @_;
my $authority = $self->GetGeniAuthority();
my $geniuser = $self->GetGeniUser();
my $context = APT_Geni::GeniContext();
return undef
if (! (defined($geniuser) && defined($authority) && defined($context)));
my ($slice_credential, $speaksfor_credential) =
APT_Geni::GenCredentials($geniuser, $geniuser, ["blockstores"]);
return undef
if (! (defined($speaksfor_credential) &&
defined($slice_credential)));
my $args = {
"size" => $self->size(),
"name" => $self->dataset_id(),
"type" => $self->type(),
"credentials" => [$slice_credential->asString(),
$speaksfor_credential->asString()],
};
$args->{"fstype"} = $self->fstype()
if ($self->fstype() ne "none");
$args->{"expires"} = TBDateStringGMT($self->expires())
if (defined($self->expires()));
my $cmurl = $authority->url();
$cmurl =~ s/protogeni/protogeni\/stoller/;
return Genixmlrpc::CallMethod($cmurl, $context, "CreateDataset", $args);
}
#
# Delete a dataset on the remote aggregate.
#
sub DeleteDataset($)
{
my ($self) = @_;
my $authority = $self->GetGeniAuthority();
my $geniuser = $self->GetGeniUser();
my $context = APT_Geni::GeniContext();
return undef
if (! (defined($geniuser) && defined($authority) && defined($context)));
my ($slice_credential, $speaksfor_credential) =
APT_Geni::GenCredentials($geniuser, $geniuser, ["blockstores"]);
return undef
if (! (defined($speaksfor_credential) &&
defined($slice_credential)));
my $args = {
"name" => $self->dataset_id(),
"credentials" => [$slice_credential->asString(),
$speaksfor_credential->asString()],
};
my $cmurl = $authority->url();
$cmurl =~ s/protogeni/protogeni\/stoller/;
return Genixmlrpc::CallMethod($cmurl, $context, "DeleteDataset", $args);
}
#
# Refresh our metadata.
#
sub DescribeDataset($)
{
my ($self) = @_;
my $authority = $self->GetGeniAuthority();
my $geniuser = $self->GetGeniUser();
my $context = APT_Geni::GeniContext();
return undef
if (! (defined($geniuser) && defined($authority) && defined($context)));
my ($slice_credential, $speaksfor_credential) =
APT_Geni::GenCredentials($geniuser, $geniuser, ["blockstores"]);
return undef
if (! (defined($speaksfor_credential) &&
defined($slice_credential)));
my $args = {
"name" => $self->dataset_id(),
"credentials" => [$slice_credential->asString(),
$speaksfor_credential->asString()],
};
my $cmurl = $authority->url();
$cmurl =~ s/protogeni/protogeni\/stoller/;
return Genixmlrpc::CallMethod($cmurl, $context, "DescribeDataset", $args);
}
# _Always_ make sure that this 1 is at the end of the file...
1;
......@@ -30,10 +30,10 @@ include $(OBJDIR)/Makeconf
SUBDIRS =
BIN_SCRIPTS = manage_profile manage_instance
BIN_SCRIPTS = manage_profile manage_instance manage_dataset
SBIN_SCRIPTS =
LIB_SCRIPTS = APT_Profile.pm APT_Instance.pm
WEB_BIN_SCRIPTS = webmanage_profile webmanage_instance
LIB_SCRIPTS = APT_Profile.pm APT_Instance.pm APT_Dataset.pm APT_Geni.pm
WEB_BIN_SCRIPTS = webmanage_profile webmanage_instance webmanage_dataset
WEB_SBIN_SCRIPTS=
LIBEXEC_SCRIPTS = $(WEB_BIN_SCRIPTS) $(WEB_SBIN_SCRIPTS)
......
#!/usr/bin/perl -w
#
# Copyright (c) 2000-2014 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 English;
use strict;
use Getopt::Std;
use Data::Dumper;
use POSIX ":sys_wait_h";
use POSIX qw(setsid close);
use Date::Parse;
#
# Back-end script to manage APT profiles.
#
sub usage()
{
print STDERR "Usage: manage_dataset [options --] create ...\n";
print STDERR "Usage: manage_dataset [options --] delete ...\n";
print STDERR "Usage: manage_dataset [options --] refresh ...\n";
exit(-1);
}
my $optlist = "dt:";
my $debug = 0;
my $webtask_id;
my $webtask;
#
# Configure variables
#
my $TB = "@prefix@";
my $TBOPS = "@TBOPSEMAIL@";
#
# 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 libtestbed;
use EmulabConstants;
use emdb;
use emutil;
use User;
use Project;
use APT_Dataset;
use WebTask;
use Blockstore;
use GeniResponse;
# Protos
sub fatal($);
sub DoCreate();
sub DoDelete();
sub DoRefresh();
sub DoRefreshInternal($$);
#
# Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments.
#
my %options = ();
if (grep {$_ eq "--"} @ARGV &&
! getopts($optlist, \%options)) {
usage();
}
if (defined($options{"d"})) {
$debug = 1;
}
if (defined($options{"t"})) {
$webtask_id = $options{"t"};
}
if (@ARGV < 1) {
usage();
}
# The web interface (and in the future the xmlrpc interface) sets this.
my $this_user = User->ImpliedUser();
if (! defined($this_user)) {
$this_user = User->ThisUser();
if (!defined($this_user)) {
fatal("You ($UID) do not exist!");
}
}
my $action = shift(@ARGV);
#
# Create the webtask object if coming from the web interface.
#
if (defined($webtask_id)) {
$webtask = WebTask->Create(undef, $webtask_id);
if (!defined($webtask)) {
fatal("Could not create webtask");
}
# Convenient.
$webtask->AutoStore(1);
}
if ($action eq "create") {
exit(DoCreate());
}
elsif ($action eq "delete") {
exit(DoDelete());
}
elsif ($action eq "refresh") {
exit(DoRefresh());
}
else {
usage();
}
exit(1);
#
#
#
sub DoCreate()
{
my $usage = sub {
print STDERR "Usage: manage_dataset create ".
"[-t type] [-f fstype] [-e expiration] -s size pid/name\n";
exit(-1);
};
my $aggregate_urn = "urn:publicid:IDN+apt.emulab.net+authority+cm";
my $logfile;
my $errmsg;
my $pid;
my $expires;
my $size;
my $type = "stdataset";
my $fstype;
my $optlist = "ds:t:e:f:";
my %options = ();
if (! getopts($optlist, \%options)) {
&$usage();
}
if (defined($options{"d"})) {
$debug = 1;
}
if (defined($options{"t"})) {
$type = $options{"t"};
&$usage()
if (! ($type eq "stdataset" || $type eq "ltdataset"));
}
if (defined($options{"f"})) {
$fstype = $options{"f"};
&$usage()
if ($fstype !~ /^(ext2|ext3|ext4|ufs|ufs2)$/);
}
if (defined($options{"s"})) {
if ($options{"s"} =~ /^(\d+)$/) {
$size = $1;
}
elsif ($options{"s"} =~ /^(\d+)(\w+)$/) {
$size = Blockstore::ConvertToMebi($options{"s"});
if ($size < 0) {
fatal("Could not parse size.");
}
}
else {
&$usage();
}
}
if (defined($options{"e"})) {
$expires = str2time($options{"e"});
if (!defined($expires)) {
fatal("Could not parse expiration date.");
}
$expires = $options{"e"};
}
&$usage()
if (@ARGV != 1 || !defined($size) ||
($type eq "stdataset" && !defined($expires)));
my $name = shift(@ARGV);
if ($name =~ /^([-\w]+)\/([-\w]+)$/) {
$pid = $1;
$name = $2;
}
else {
fatal("Dataset name $name not in the form <pid>/<name>.");
}
my $project = Project->Lookup($pid);
if (!defined($project)) {
fatal("No such project");
}
if (!$project->AccessCheck($this_user, TB_PROJECT_CREATELEASE())) {
fatal("Not enough permission in project");
}
&$usage()
if ($type eq "stdataset" && !defined($expires));
if (APT_Dataset->Lookup("$pid/$name")) {
fatal("Dataset already exists!");
}
my $blob = {
"dataset_id" => $name,
"pid" => $project->pid(),
"pid_idx" => $project->pid_idx,
"creator_uid" => $this_user->uid(),
"creator_idx" => $this_user->uid_idx(),
"aggregate_urn" => $aggregate_urn,
"type" => $type,
"size" => $size,
};
$blob->{"fstype"} = $fstype
if (defined($fstype));
$blob->{"expires"} = $expires
if (defined($expires));
my $dataset = APT_Dataset->Create($blob);
if (!defined($dataset)) {
fatal("Internal error creating dataset object");
}
# new dataset is returned locked.
#
# Ask the aggregate to create the dataset.
#
my $response = $dataset->CreateDataset();
if ($response->code() != GENIRESPONSE_SUCCESS) {
$errmsg = "CreateDataset failed: ". $response->output() . "\n";
goto failed;
}
$blob = $response->value();
$dataset->Update({"remote_uuid" => $blob->{"uuid"}});
#
# 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
# blob (busy), so look for this and set the state to busy. Then we poll
# waiting for the lease to go nonbusy and approved. Ick.
#
if ($blob->{"busy"}) {
$dataset->Update({"state" => "busy"});
}
else {
$dataset->Update({"state" => $blob->{"state"}});
$dataset->Unlock();
return 0;
}
#
# If busy, then allocation is in progress. We leave it locked and
# poll in the background for a while, hoping for it to eventually
# stop being busy. Eventually might have to replace this, since
# polling got any non-small length of time will lead to trouble.
#
if (! $debug) {
$logfile = TBMakeLogname("createdataset");
<