...
 
Commits (168)
#!/usr/bin/perl -w
#
# Copyright (c) 2000-2018 University of Utah and the Flux Group.
# Copyright (c) 2000-2019 University of Utah and the Flux Group.
#
# {{{EMULAB-LICENSE
#
......@@ -496,9 +496,11 @@ my $usr_email = $newuser->email();
my $firstinitstate;
if (TBGetSiteVar("general/firstinit/state", \$firstinitstate)) {
#
# The first user gets admin status and some extra groups, etc.
# These initial users gets admin status and some extra groups, etc.
#
if ($firstinitstate eq "createproject") {
if ($firstinitstate eq "createproject" &&
($new_uid eq EmulabConstants::PROTOUSER() ||
$new_uid eq EmulabConstants::CKUPUSER())) {
DBQueryFatal("update users set ".
" admin=1,status='". $User::USERSTATUS_UNAPPROVED . "' " .
"where uid_idx='$usr_idx'");
......
......@@ -40,14 +40,19 @@ use Getopt::Std;
# and forces the target user into that state. Eventually, this should
# be the default mode of operation (independent of web interface).
#
# Use -e with passwd to apply the default password expire interval to
# the new password, otherwise the password is expired immediately to
# force a change.
#
sub usage()
{
print("Usage: tbacct [-f] [-b] [-u] [-v] ".
print("Usage: tbacct [-e] [-f] [-b] [-u] [-v] ".
"<add|del|mod|passwd|wpasswd|email|freeze|thaw|verify|revoke|dots|deactivate|reactivate> ".
"<user> [args]\n");
exit(-1);
}
my $optlist = "fbuvs";
my $optlist = "efbuvs";
my $expok = 0;
my $force = 0;
my $batch = 0;
my $update = 0;
......@@ -201,6 +206,9 @@ if (scalar(@ARGV) == 3 && $ARGV[0] eq "passwd") {
if (! getopts($optlist, \%options)) {
usage();
}
if (defined($options{"e"})) {
$expok = 1;
}
if (defined($options{"f"})) {
$force = 1;
}
......@@ -701,13 +709,13 @@ sub UpdatePassword()
}
#
# Insert into database. When changing password for someone else,
# always set the expiration to right now so that the target user
# is "forced" to change it.
# Insert into database. When changing password for someone else
# and "-e" (expok) isn't set, then set the expiration to right
# now so that the target user is "forced" to change it.
#
my $expires;
if (! $target_user->SameUser($this_user)) {
if (!$expok && ! $target_user->SameUser($this_user)) {
$expires = "now()";
}
elsif ($EXPIRE_PASSWORDS) {
......
......@@ -207,6 +207,12 @@ sub STATUS($$;$)
$self->{'STATUS'}->{$name} = $newval;
return $self->{'STATUS'}->{$name};
}
sub IsUp($)
{
my ($self) = @_;
return $self->status() eq "up" ? 1 : 0;
}
#
# Insert a status (change) event.
......@@ -315,8 +321,14 @@ sub CheckStatus($$;$)
$self->name() . " cluster: " . $perrmsg;
}
else {
$$perrmsg = "The " . $self->name() . " cluster ".
"is currently unreachable, please try again later.";
my $message = "The " . $self->name() . " cluster ".
"is currently unavailable";
if ($$perrmsg ne "") {
$message .= ": " . $$perrmsg;
}
$message .= ". ";
$message .= "Please try again later.";
$$perrmsg = $message;
}
return 1;
}
......
#!/usr/bin/perl -wT
#
# Copyright (c) 2007-2018 University of Utah and the Flux Group.
# Copyright (c) 2007-2019 University of Utah and the Flux Group.
#
# {{{EMULAB-LICENSE
#
......@@ -583,12 +583,13 @@ sub PingAggregate($$;$$)
return -1;
}
my $cmurl = $authority->url();
if (defined($portalrpc)) {
if (defined($portalrpc) && $portalrpc) {
$cmurl =~ s/\/cm$/\/cluster/;
}
if ($usemydevtree) {
$cmurl =~ s/protogeni/protogeni\/stoller/;
}
my $oldto = Genixmlrpc->SetTimeout($timeout);
my $response = Genixmlrpc::CallMethod($cmurl, $context, "GetVersion");
Genixmlrpc->SetTimeout($oldto);
......
......@@ -498,6 +498,16 @@ sub SetStatus($$)
}
sub SetAggregateStatus($$)
{
my ($self, $status) = @_;
foreach my $agg ($self->AggregateList()) {
$agg->SetStatus($status);
}
return 0;
}
sub ActiveAggregateList($)
{
my ($self) = @_;
......@@ -710,7 +720,7 @@ sub RecordHistory($$)
" created,start_at,started,stop_at,now(),$expired, ".
" extension_count,extension_days,extension_hours, ".
" physnode_count,virtnode_count, ".
" servername,repourl,reponame,reporef,repohash, ".
" servername,portal,repourl,reponame,reporef,repohash, ".
" rspec,script,params,manifest ".
" from apt_instances where uuid='$uuid'")
or return -1;
......@@ -729,7 +739,7 @@ sub RecordError($$$)
" creator,creator_idx,creator_uuid,pid,pid_idx, ".
" gid,gid_idx, ".
" created,start_at,started,stop_at,'$exitcode', ".
" $safe_message,public_url,logfileid ".
" $safe_message,public_url,logfileid,portal ".
" from apt_instances where uuid='$uuid'")
or return -1;
......@@ -1672,6 +1682,9 @@ sub CreateImageCreds($$$;$)
$$pmsg = "No permission to use $image_urn";
return 1;
}
next
if ($image->global());
#
# If the image is restricted, the experiment has to be created
# in the same project as the image, or in a project that has
......@@ -1867,6 +1880,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;
......@@ -2763,9 +2928,9 @@ sub CredentialError()
#
# Ask aggregate to terminate a sliver.
#
sub Terminate($)
sub Terminate($;$)
{
my ($self) = @_;
my ($self, $withprivs) = @_;
my $method;
my @params;
my $authority = $self->GetGeniAuthority();
......@@ -2794,14 +2959,24 @@ sub Terminate($)
}
else {
my $credentials;
my ($slice_credential, $speaksfor_credential) =
APT_Geni::GenCredentials($slice, $geniuser, undef, 1);
return CredentialError()
if (!defined($slice_credential));
$credentials = [$slice_credential->asString()];
if (defined($speaksfor_credential)) {
$credentials = [@$credentials, $speaksfor_credential->asString()];
if ($withprivs) {
my $slice_credential = APT_Geni::GenAuthCredential($slice);
return CredentialError()
if (!defined($slice_credential));
$credentials = [$slice_credential->asString()];
}
else {
my ($slice_credential, $speaksfor_credential) =
APT_Geni::GenCredentials($slice, $geniuser, undef, 1);
return CredentialError()
if (!defined($slice_credential));
$credentials = [$slice_credential->asString()];
if (defined($speaksfor_credential)) {
$credentials = [@$credentials,
$speaksfor_credential->asString()];
}
}
$method = "DeleteSliver";
@params = ($slice->urn(), $credentials,
......
......@@ -88,6 +88,14 @@ sub versname($)
return $self->name() . ":" . $self->version();
}
# Concat pid,name/vers.
sub pidversname($)
{
my ($self) = @_;
return $self->pid() . "," . $self->name() . ":" . $self->version();
}
sub BlessRow($$)
{
my ($class, $row) = @_;
......@@ -684,7 +692,7 @@ sub Delete($$)
DBQueryWarn("lock tables apt_profiles write, apt_profile_versions write, ".
" web_tasks write, apt_profile_favorites write, ".
" apt_profile_images write")
" apt_profile_images write, apt_parameter_sets write")
or return -1;
if ($purge) {
......@@ -711,6 +719,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;
......@@ -1498,7 +1509,7 @@ sub CheckLicenses($$$$$)
my $manager_urn = GetManagerId($ref);
my $aptagg = APT_Aggregate->Lookup($manager_urn);
print STDERR "CheckLicenses: $client_id, $manager_urn\n";
#print STDERR "CheckLicenses: $client_id, $manager_urn\n";
#
# Check for aggregate restriction,
#
......@@ -1530,14 +1541,19 @@ sub CheckLicenses($$$$$)
my $hardtype = undef;
my $component_id = GeniXML::GetNodeId($ref);
if ($component_id && $component_id ne "*") {
print STDERR "CheckLicenses: $client_id, $component_id\n";
my $node_id = $component_id;
my $hrn = GeniHRN->new($component_id);
if (! ($hrn && $hrn->IsNode())) {
$$perrmsg = "Not a valid component ID: $component_id";
return 1;
#print STDERR "CheckLicenses: $client_id, $component_id\n";
if (GeniHRN::IsValid($component_id)) {
my $hrn = GeniHRN->new($component_id);
if (! ($hrn && $hrn->IsNode())) {
$$perrmsg = "Not a valid component ID: $component_id";
return 1;
}
$node_id = $hrn->id();
}
my $node = Node->Lookup($hrn->id());
my $node = Node->Lookup($node_id);
if ($node) {
my $idx;
......@@ -1557,7 +1573,7 @@ sub CheckLicenses($$$$$)
if (!exists($licenses{"$idx"})) {
$licenses{"$idx"} = {
"type" => "node",
"target" => $hrn->id(),
"target" => $node_id,
"license" => $idx,
};
}
......@@ -1577,7 +1593,7 @@ sub CheckLicenses($$$$$)
}
}
if ($hardtype) {
print STDERR "CheckLicenses: $client_id, $hardtype\n";
#print STDERR "CheckLicenses: $client_id, $hardtype\n";
my $nodetype = NodeType->Lookup($hardtype);
if (! $nodetype) {
......@@ -1664,7 +1680,7 @@ sub SetRepo($$$$$$)
"cd repository && " .
"git config --add core.sharedRepository group && ".
"git checkout $repohash ";
if ($reporef =~ m"^(refs/|)heads/(.+)") {
if (defined($reporef) && $reporef =~ m"^(refs/|)heads/(.+)") {
my $branchname = $2;
$command .= "&& git branch -ft $branchname origin/$branchname" .
"&& git checkout -B $branchname HEAD ";
......@@ -2104,6 +2120,159 @@ sub Convert2Genilib($)
return 0;
}
#
# Convert data_set in rspec to simplified bindings array.
#
sub GetBindings($$$;$)
{
my ($rspec, $pbindings, $perrmsg, $asparamdefs) = @_;
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;
}
# This is silly.
my $getName = sub {
my ($ref) = @_;
my $name = GeniXML::GetText("name", $ref);
# Not sure why the name is in dotted notation. Kill it.
my @tokens = split(/[.]/, $name);
if (@tokens > 1) {
$name = pop(@tokens);
}
return $name;
};
#
# Convert XML goo to multilevel array of bindings.
#
my $bindings = {};
my $processSet;
#
# Process each item in the dataset.
#
$processSet = sub {
my ($ref) = @_;
my $which = $ref->nodeName();
if ($which eq "data_list") {
my @list = ();
foreach my $child ($ref->childNodes()) {
next
if ($child->nodeName() !~ /^data/);
push(@list, &$processSet($child));
}
if ($asparamdefs) {
return {"value" => \@list};
}
return \@list;
}
elsif ($which eq "data_struct") {
my $b = {};
foreach my $child ($ref->childNodes()) {
next
if ($child->nodeName() !~ /^data/);
my $childname = &$getName($child);
$b->{$childname} = &$processSet($child);
}
if ($asparamdefs) {
return {"value" => $b};
}
return $b;
}
elsif ($which eq "data_item" ||
$which eq "data_member_item") {
my $value = $ref->findvalue('.');
if ($asparamdefs) {
$value = {"value" => $value};
}
return $value;
}
};
foreach my $ref ($dataset->childNodes()) {
next
if ($ref->nodeName() !~ /^data/ || $ref->nodeName eq "data_set");
my $name = &$getName($ref);
my $value = &$processSet($ref);
print "$name\n";
print Dumper($value);
#
# This was a bad decision, need to fix. Top level struct.
#
if (!$asparamdefs && $ref->nodeName() eq "struct") {
foreach my $key (keys(%{$value})) {
$bindings->{$key} = $value->{$key};
}
}
else {
$bindings->{$name} = $value;
}
}
$$pbindings = $bindings;
return 0;
}
sub BindingsToParams($)
{
my ($bindings) = @_;
my $paramdefs = {};
my $convert;
$convert = sub {
my ($val) = @_;
if (!ref($val)) {
return {"value" => $val};
}
if (ref($val) eq "ARRAY") {
my @list = ();
foreach my $v (@{$val}) {
push(@list, &$convert($v));
}
return {"value" => \@list};
}
my $b = {};
foreach my $k (keys(%{$val})) {
$b->{$k} = &$convert($val->{$k});
}
return $b;
};
foreach my $key (keys(%{$bindings})) {
my $val = $bindings->{$key};
$paramdefs->{$key} = &$convert($val);
}
return $paramdefs;
}
###################################################################
package APT_Profile::ImageInfo;
use emdb;
......
#!/usr/bin/perl -wT
#
# Copyright (c) 2007-2016, 2018 University of Utah and the Flux Group.
# Copyright (c) 2007-2016, 2018, 2019 University of Utah and the Flux Group.
#
# {{{EMULAB-LICENSE
#
......@@ -42,6 +42,7 @@ use vars qw(@ISA @EXPORT);
use emdb;
use libtestbed;
use APT_Instance;
use APT_Aggregate;
use Project;
use Group;
use GeniHRN;
......@@ -226,3 +227,24 @@ sub ReservationUtilization($$)
return 0;
}
#
# Look using all the various lookup ways.
#
sub LookupAggregate($)
{
my ($token) = @_;
my $aggregate = APT_Aggregate->Lookup($token);
return $aggregate
if (defined($aggregate));
$aggregate = APT_Aggregate->LookupByNickname($token);
return $aggregate
if (defined($aggregate));
$aggregate = APT_Aggregate->LookupByDomain($token);
return $aggregate
if (defined($aggregate));
return undef;
}
......@@ -34,10 +34,11 @@ BIN_SCRIPTS = manage_profile manage_instance manage_dataset \
create_instance rungenilib ns2rspec nsgenilib.py \
rspec2genilib ns2genilib manage_reservations manage_gitrepo \
manage_images rtecheck checkprofile manage_extensions \
create_slivers searchip
create_slivers searchip start-experiment
SBIN_SCRIPTS = apt_daemon aptevent_daemon portal_xmlrpc apt_checkup \
portal_monitor apt_scheduler portal_resources \
manage_licenses manage_aggregate powder_shutdown
manage_licenses manage_aggregate powder_shutdown \
rfmonitor_daemon
LIB_SCRIPTS = APT_Profile.pm APT_Instance.pm APT_Dataset.pm APT_Geni.pm \
APT_Aggregate.pm APT_Utility.pm APT_Rspec.pm
WEB_BIN_SCRIPTS = webmanage_profile webmanage_instance webmanage_dataset \
......
#!/usr/bin/perl -w
#
# Copyright (c) 2008-2018 University of Utah and the Flux Group.
# Copyright (c) 2008-2019 University of Utah and the Flux Group.
#
# {{{GENIPUBLIC-LICENSE
#
......@@ -72,26 +72,12 @@ sub SendStatus($)
{
my ($status) = @_;
if (1) {
# Error, we are done.
LogEnd($status);
}
else {
# We want to keep logging, not send an email here.
LogStop();
}
print "Content-Type: text/plain \n\n";
print "We love all profiles equally.\n";
print "Exited with $status\n";
exit(0);
}
#
# Send logs to tblogs (only)
#
LogStart(0, undef, LIBAUDIT_LOGONLY() | LIBAUDIT_LOGTBLOGS());
AddAuditInfo("to", $TBLOGS);
# The query holds the token we need to find the profile.
my $query = new CGI();
......@@ -148,7 +134,12 @@ if ($mypid) {
SendStatus(0);
}
sleep(1);
libaudit::AuditFork();
#
# Send logs to tblogs (only)
#
LogStart(0, undef, LIBAUDIT_LOGONLY() | LIBAUDIT_LOGTBLOGS());
AddAuditInfo("to", $TBLOGS);
if ($debug) {
print "$profile\n";
......@@ -180,5 +171,5 @@ if ($?) {
if ($debug > 1) {
print $output;
}
LogEnd(0);
exit(0);
......@@ -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);
#
......@@ -44,9 +45,10 @@ sub usage()
print "Usage: quickvm [-u uuid] [--site site:1=aggregate ...] <xmlfile>\n";
exit(1);
}
my @optlist = ('d', 'v', 'u=s', 'a=s', 'S', 'k=s', 'i', 't=s');
my @optlist = ('d', 'v', 'f', 'u=s', 'a=s', 'S', 'k=s', 'i', 't=s');
my $debug = 0;
my $verbose = 1;
my $foreground = 0;
my $ignorefailures = 0;
my $xmlfile;
my $webtask;
......@@ -155,6 +157,9 @@ if (defined($options{"k"})) {
if (defined($options{"d"})) {
$debug = 1;
}
if (defined($options{"f"})) {
$foreground = 1;
}
if (defined($options{"i"})) {
$ignorefailures = 1;
}
......@@ -272,7 +277,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 +379,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");
......@@ -391,8 +405,30 @@ if ($profile->repourl()) {
}
else {
# Otherwise we are instantiating whatever the profile itself references.
$reporef = "refs/heads/master";
#$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");
}
}
......@@ -711,7 +747,7 @@ if ($tmp) {
if (defined($webtask)) {
$webtask->required_licenses($licenses);
}
UserError("Licenses are required");
UserError("Licenses are required before you can start this experiment");
}
UserError($errmsg);
}
......@@ -844,17 +880,22 @@ my $blob = {'uuid' => $quickvm_uuid,
'start_at' => $start_at,
'stop_at' => $stop_at,
'servername' => $SERVER_NAME,
'portal' => $portal,
'rspec' => $rspecstr,
'cert' => $alt_certificate->cert(),
'privkey' => $alt_certificate->PrivKeyDelimited(),
};
if (defined($bindings)) {
$blob->{"params"} = $bindings;
}
if ($profile->repourl()) {
if (defined($script)) {
$blob->{"script"} = $script;
}
$blob->{"repourl"} = $profile->repourl();
$blob->{"reporef"} = $reporef;
$blob->{"reporef"} = $reporef ? $reporef : "";
$blob->{"repohash"} = $repohash;
$blob->{"paramdefs"} = $paramdefs if (defined($paramdefs));
}
if (defined($project)) {
$blob->{"pid"} = $project->pid();
......@@ -969,7 +1010,7 @@ if (defined($start_at)) {
# Hand off to create slivers script. We have to fork/system cause
# of libaudit logging.
#
if (!$debug) {
if (! ($debug || $foreground)) {
libaudit::AuditPrefork();
my $child = fork();
if ($child) {
......@@ -992,7 +1033,7 @@ if ($?) {
#
if (!$usestitcher && $code > 0) {
AuditAbort()
if (!$debug);
if (! ($debug || $foreground));
}
exit($code);
}
......
......@@ -166,6 +166,7 @@ else {
exit(1);
}
}
$webtask->AutoStore(1);
#
# Anything to do? See create_instance; Note that we skip anything
......@@ -190,11 +191,10 @@ foreach my $agg ($instance->AggregateList()) {
if (!$aptagg->deferrable()) {
$instance->SetStatus("failed");
if (defined($webtask)) {
$webtask->output($errmsg);
$webtask->Exited(1);
}
$instance->RecordError(1, $errmsg);
$webtask->output($errmsg);
$webtask->Exited(GENIRESPONSE_SERVER_UNAVAILABLE);
$instance->RecordError(GENIRESPONSE_SERVER_UNAVAILABLE, $errmsg);
$genislice->UnLock();
exit(1);
}
# Mark as deferred (it might still be "created" if not scheduled).
......@@ -236,7 +236,6 @@ my $slice_urn = $genislice->urn();
my $uuid = $instance->uuid();
my $project = $instance->GetProject();
my $rspecstr = $instance->rspec();
$webtask->AutoStore(1);
#
# Load the SA cert to act as caller context.
......@@ -902,6 +901,10 @@ sub CreateSlivers()
$output = "Internal error creating experiment on the ".
"$cluster cluster";
}
elsif (scalar($instance->AggregateList()) > 1) {
$output = "Error creating experiment on the $cluster cluster:".
"\n\n" . $output;
}
$webtask->output($output);
# This will be the createsliver exit code if we got one, or -1.
......
......@@ -83,7 +83,7 @@ sub usage()
exit(-1);
}
my $optlist = "du:p:o:n:CRB:N";
my $optlist = "du:p:o:n:CRB:Nr:h:";
my $basename = "py-cage";
my $jailname = "py-cage-$$";
my $user = "nobody";
......@@ -92,6 +92,8 @@ my $gid;
my $pfile;
my $ofile;
my $ifile;
my $repo;
my $reporef;
my $limits = 1;
my $haverctl = 0;
......@@ -109,6 +111,8 @@ sub mysystem($);
#
my $TBROOT = "@prefix@";
my $GENILIB = "$TBROOT/lib/geni-lib/";
my $REPODIR = "/repos";
my $GIT = "/usr/local/bin/git";
my $debug = 0;
# Watch for this being defined in the calling environment and use that.
......@@ -229,6 +233,31 @@ if (defined($options{"B"})) {
}
$basename = $base;
}
if (defined($options{"r"})) {
$repo = $options{"r"};
# Must taint check
if ($repo =~ /^([-\w]+)$/) {
$repo = $1;
}
else {
print STDERR "Bad data in argument: $repo\n";
usage();
}
if (! -e "$REPODIR/$repo") {
print STDERR "No such repo '$repo'\n";
usage();
}
if (defined($options{"h"})) {
$reporef = $options{"h"};
# Must taint check
if ($reporef =~ /^([-\w\/]+)$/) {
$reporef = $1;
}
else {
die("Bad data in argument: $reporef");
}
}
}
#
# Extract params from the environment (if invoked via rungenilib.proxy).
......@@ -387,6 +416,32 @@ if ($action != 1) {
print STDERR "Could not populate jail\n";
exit(-1);
}
if (defined($repo)) {
if (mysystem("$GIT clone -q $REPODIR/$repo ".
" ${jailrootdir}${tempdir}/repository")) {
print STDERR "Could not clone repo in the jail\n";
exit(-1);
}
# The root of the repository for module imports.
$ENV{"PYTHONPATH"} = "/${tempdir}/repository:" . $ENV{"PYTHONPATH"};
if (defined($reporef)) {
if ($reporef =~ m"^(refs/|)heads/(.+)") {
my $branchname = $2;
mysystem("cd ${jailrootdir}${tempdir}/repository; ".
"$GIT checkout -q $branchname");
}
else {
mysystem("cd ${jailrootdir}${tempdir}/repository; ".
"$GIT checkout -q $reporef");
}
if ($?) {
print STDERR "Could not clone repo in the jail\n";
exit(-1);
}
}
}
#
# XXX adjust the environment for the portal module to reflect the jail.
......
#!/usr/bin/perl -w
#
# Copyright (c) 2000-2018 University of Utah and the Flux Group.
# Copyright (c) 2000-2019 University of Utah and the Flux Group.
#
# {{{EMULAB-LICENSE
#
......@@ -34,13 +34,13 @@ use POSIX qw(:signal_h);
sub usage()
{
print STDOUT
"Usage: gitrepo.proxy -n reponame clone url\n".
"Usage: gitrepo.proxy -n reponame clone [-c] url\n".
"Usage: gitrepo.proxy -n reponame update\n".
"Usage: gitrepo.proxy -n reponame delete\n";
exit(-1);
}
my $optlist = "dn:";
my $optlist = "dn:";
my $debug = 0;
my $reponame;
......@@ -127,8 +127,17 @@ exit(-1);
#
sub Clone()
{
my $checkout = 0;
usage()
if (!@ARGV);
if ($ARGV[0] eq "-c") {
$checkout = 1;
shift(@ARGV);
usage()
if (!@ARGV);
}
my $repourl = shift(@ARGV);
if (-e "$REPODIR/$reponame") {
......@@ -137,7 +146,7 @@ sub Clone()
chdir($REPODIR) or
fatal("Could not chdir to $REPODIR");
my $status = RunCommand("$GIT clone --bare ".
my $status = RunCommand("$GIT clone " . ($checkout ? "" : "--bare ") .
" $repourl $reponame");
if ($status) {
fatal("Not able to clone repo from $repourl");
......@@ -152,11 +161,38 @@ sub Clone()
chdir("$REPODIR/$reponame") or
fatal("Could not chdir to $REPODIR/$reponame");
my $refspec = GetDefaultBranch($reponame);
#
# If we did a checkout, look for submodules that need to be initialized
#
if ($checkout) {
if (-e ".gitmodules") {
if (system("$GIT submodule init") ||
system("$GIT submodule update")) {
fatal("Could not initialize submodules");
}
}
# Need to force getting all the remote branches.
# -p prunes deleted branches. But tags are not pruned.
if (system("$GIT fetch -u -f -p -t origin '+refs/*:refs/*'")) {
fatal("Could not fetch remote branches");
}
if (-e "profile.py") {
system("/bin/cat profile.py");
}
elsif (-e "profile.rspec") {
system("/bin/cat profile.rspec");
}
else {
print STDERR "No geni-lib script or rspec in this repository\n";
}
}
else {
my $refspec = GetDefaultBranch($reponame);
if (system("$GIT cat-file -e ${refspec}:profile.py") &&
system("$GIT cat-file -e ${refspec}:profile.rspec")) {
print STDERR "No geni-lib script or rspec in this repository\n";
if (system("$GIT cat-file -e ${refspec}:profile.py") &&
system("$GIT cat-file -e ${refspec}:profile.rspec")) {
print STDERR "No geni-lib script or rspec in this repository\n";
}
}
return 0;
}
......@@ -181,34 +217,76 @@ sub Delete()
#
sub Update()
{
my $command;
if (! -e "$REPODIR/$reponame") {
fatal("Repository does not exist.");
}
chdir("$REPODIR/$reponame") or
fatal("Could not chdir to $REPODIR/$reponame");
# -p prunes deleted branches. But tags are not pruned.
my $status = RunCommand("$GIT fetch -p -t origin '+refs/*:refs/*'");
if (-e ".git") {
$command = "$GIT fetch -q";
}
else {
$command = "$GIT fetch -q -u -f -t origin '+refs/*:refs/*'";
}
my $status = RunCommand($command);
if ($status) {
fatal("Not able to update repo");
}
my $current_refspec = GetDefaultBranch($reponame);
my $remote_refspec = GetRemoteDefaultBranch($reponame);
#
# Local checkout.
#
if (-e ".git") {
$command = "$GIT merge -q origin/$current_refspec";
my $status = RunCommand($command);
if ($status) {
fatal("Not able to merge current branch");
}
if (-e ".gitmodules") {
$status = RunCommand("$GIT submodule update");
if ($status) {
fatal("Not able to update submodules");
}
}
}
#
# Update local default branch if the remote has switched it.
#
if ($current_refspec ne $remote_refspec) {
system("$GIT symbolic-ref --short HEAD '$remote_refspec'");
if (-e ".git") {
$command = "$GIT checkout -q $remote_refspec";
}
else {
$command = "$GIT symbolic-ref --short HEAD '$remote_refspec'";
}
system($command);
if ($?) {
fatal("Could not update default branch tp $remote_refspec");
}
$current_refspec = $remote_refspec;
}
if (system("$GIT cat-file -e ${current_refspec}:profile.py") &&
system("$GIT cat-file -e ${current_refspec}:profile.rspec")) {
print STDERR "No geni-lib script or rspec in this repository\n";
if (-e ".git") {
if (-e "profile.py") {
system("/bin/cat profile.py");
}
elsif (-e "profile.rspec") {
system("/bin/cat profile.rspec");
}
else {
print STDERR "No geni-lib script or rspec in this repository\n";
}
}
else {
if (system("$GIT cat-file -e ${current_refspec}:profile.py") &&
system("$GIT cat-file -e ${current_refspec}:profile.rspec")) {
print STDERR "No geni-lib script or rspec in this repository\n";
}
}
return 0;
}
......@@ -235,7 +313,7 @@ sub GetDefaultBranch($)
else {
fatal("Illegal default branch name: $branch");
}
return "refs/heads/$branch";
return (-e ".git" ? $branch : "refs/heads/$branch");
}
#
......@@ -280,7 +358,7 @@ sub GetRemoteDefaultBranch($)
if (!defined($branch)) {
fatal("Could not get default branch from remote repo");
}
return "refs/heads/$branch";
return (-e ".git" ? $branch : "refs/heads/$branch");
}
#
......@@ -289,6 +367,9 @@ sub GetRemoteDefaultBranch($)
sub RunCommand($)
{
my ($cmd) = @_;
if ($debug) {
print STDERR "$cmd\n";
}
#
# Fork a child process to run git in.
......
......@@ -42,6 +42,8 @@ sub usage()
print STDERR " manage_aggregate ping [-a <agg>]\n";
print STDERR " manage_aggregate portals [-a <agg>] add <portal> \n";
print STDERR " manage_aggregate portals [-a <agg>] rem <portal> \n";
print STDERR " manage_aggregate feature [-a <agg>] set <feature> \n";
print STDERR " manage_aggregate feature [-a <agg>] clear \n";
print STDERR "Options:\n";
print STDERR " -a agg - URN, nickname or domain of aggregate\n";
exit(-1);
......@@ -88,7 +90,7 @@ sub DoShow();
sub DoFlags();
sub DoPing();
sub DoPortals();
sub LookupAggregate($);
sub DoFeature();
#
# Parse command arguments. Once we return from getopts, all that should be
......@@ -109,7 +111,7 @@ my $action = shift(@ARGV);
#
# Default to local cluster, unless overridden in the action.
#
my $aggregate = LookupAggregate($MYURN);
my $aggregate = APT_Utility::LookupAggregate($MYURN);
if (!defined($aggregate)) {
fatal("Could not lookup local aggregate: $MYURN");
}
......@@ -134,6 +136,9 @@ elsif ($action eq "ping") {
elsif ($action eq "portals") {
DoPortals();
}
elsif ($action eq "feature") {
DoFeature();
}
else {
usage();
}
......@@ -187,7 +192,7 @@ sub DoShow()
if (@ARGV);
if (defined($options{"a"})) {
$aggregate = LookupAggregate($options{"a"});
$aggregate = APT_Utility::LookupAggregate($options{"a"});
fatal("No such aggregate")
if (!defined($aggregate));
}
......@@ -207,6 +212,7 @@ sub DoShow()
print "LocalImages: " . ($aggregate->nolocalimages() ? "No" : "Yes")."\n";
print "PanicPowerOff: " . ($aggregate->panicpoweroff() ? "Yes" : "No")."\n";
print "Portals: " . $aggregate->portals() . "\n";
print "Use Feature: " . ($aggregate->canuse_feature() || "") . "\n";
print "Status: " . $aggregate->status() . "\n";
return 0;
}
......@@ -226,7 +232,7 @@ sub DoFlags()
if (@ARGV != 2 || $ARGV[1] !~ /^(yes|no)$/);
if (defined($options{"a"})) {
$aggregate = LookupAggregate($options{"a"});
$aggregate = APT_Utility::LookupAggregate($options{"a"});
fatal("No such aggregate")
if (!defined($aggregate));
}
......@@ -304,7 +310,7 @@ sub DoPing()
if (@ARGV);
if (defined($options{"a"})) {
$aggregate = LookupAggregate($options{"a"});
$aggregate = APT_Utility::LookupAggregate($options{"a"});
fatal("No such aggregate")
if (!defined($aggregate));
}
......@@ -327,7 +333,7 @@ sub DoPortals()
usage();
}
if (defined($options{"a"})) {
$aggregate = LookupAggregate($options{"a"});
$aggregate = APT_Utility::LookupAggregate($options{"a"});
fatal("No such aggregate")