...
 
Commits (22)
......@@ -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;
}
......
......@@ -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) = @_;
......@@ -2915,9 +2925,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();
......@@ -2946,14 +2956,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,
......
#!/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;
}
......@@ -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,7 +34,7 @@ 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";
......@@ -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;
}
......@@ -187,12 +223,31 @@ sub Update()
chdir("$REPODIR/$reponame") or
fatal("Could not chdir to $REPODIR/$reponame");
#
# When not using a bare repo, we have to force the fetch to update
# the current banch.
#
my $fopt = (-e ".git" ? "-u -f" : "");
# -p prunes deleted branches. But tags are not pruned.
my $status = RunCommand("$GIT fetch -p -t origin '+refs/*:refs/*'");
my $status = RunCommand("$GIT fetch $fopt -p -t origin '+refs/*:refs/*'");
if ($status) {
fatal("Not able to update repo");
}
#
# Local checkout, must merge. This is done when we have submodules.
#
if (-e ".git") {
my $status = RunCommand("$GIT merge");
if ($status) {
fatal("Not able to fetch repo");
}
$status = RunCommand("$GIT submodule update");
if ($status) {
fatal("Not able to update submodules");
}
}
my $current_refspec = GetDefaultBranch($reponame);
my $remote_refspec = GetRemoteDefaultBranch($reponame);
......@@ -206,9 +261,22 @@ sub Update()
}
$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;
}
......
......@@ -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")
if (!defined($aggregate));
}
......@@ -364,6 +370,44 @@ sub DoPortals()
print "Portals set to: ". join(",", @portals) . "\n";
}
#
# Set or clear the canuse feature
#
sub DoFeature()
{
my $optlist = "a:";
my %options = ();
if (! getopts($optlist, \%options)) {
usage();
}
if (defined($options{"a"})) {
$aggregate = APT_Utility::LookupAggregate($options{"a"});
fatal("No such aggregate")
if (!defined($aggregate));
}
usage()
if (@ARGV < 1 || @ARGV > 2);
my $action = shift(@ARGV);
fatal("Must be one of 'set' or 'clear'")
if ($action ne "set" && $action ne "clear");
if ($action eq "clear") {
$aggregate->Update({"canuse_feature" => "NULL"}) == 0
or fatal("Could not clear feature");
}
else {
usage()
if (!@ARGV);
my $feature = shift(@ARGV);
$aggregate->Update({"canuse_feature" => $feature}) == 0
or fatal("Could not set feature");
}
}
exit(0);
sub fatal($)
......@@ -375,21 +419,3 @@ sub fatal($)
exit(-1);
}
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;
}
......@@ -108,6 +108,8 @@ sub DoCommitList();
sub DoCommitInfo();
sub DoGetSource();
sub DoGetRepoSize();
sub DoRemoveRepo();
sub DoPruneStaleRepos();
sub GetRepoSource($;$$);
sub GetRepoSize($);
sub GetBranchList($);
......@@ -195,6 +197,12 @@ elsif ($action eq "commitinfo") {
elsif ($action eq "reposize") {
DoGetRepoSize();
}
elsif ($action eq "remove") {
DoRemoveRepo();
}
elsif ($action eq "prune") {
DoPruneStaleRepos();
}
else {
usage();
}
......@@ -264,15 +272,17 @@ sub DoCheckRemote()
# Use -o to write the file to stdout or a file.
# Use -r to remove repo after getting the script/rspec.
# Add -u to update if repo is already cloned.
# Add -c for a full checkout. Only admins for now.
#
sub DoClone()
{
my $optlist = "o:rn:uS:";
my $optlist = "o:rn:uS:c";
my $ofile;
my $remove;
my $reponame;
my $update;
my $sourcename;
my $checkout = 0;
my %options = ();
if (! getopts($optlist, \%options)) {
......@@ -286,6 +296,9 @@ sub DoClone()
if ($repourl =~ /^(.*)$/) {
$repourl = $1;
}
if (defined($options{"c"})) {
$checkout = 1;
}
if (defined($options{"o"})) {
$ofile = $options{"o"};
}
......@@ -320,7 +333,11 @@ sub DoClone()
$cmd .= "-n $reponame update";
}
else {
$cmd .= "-n $reponame clone '$repourl'";
$cmd .= "-n $reponame clone ";
if ($checkout) {
$cmd .= " -c ";
}
$cmd .= "'$repourl'";
}
if ($debug) {
print "'$cmd'\n";
......@@ -345,7 +362,7 @@ sub DoClone()
RemoveRepo($reponame);
fatal("Could not estimate repository size");
}
if ($size > 500) {
if ($size > 150) {
RemoveRepo($reponame);
UserError("Repository is too big: greate then 500MiB");
}
......@@ -368,6 +385,7 @@ sub DoClone()
$webtask->log($log);
$webtask->hash($hash);
$webtask->size("$size MiB");
$webtask->name($reponame);
}
if (defined($ofile)) {
if ($ofile eq "-") {
......@@ -622,40 +640,43 @@ sub GetRepoSource($;$$)
fatal("Could not chdir to $repodir: $!");
foreach my $maybe (@locations) {
my $file;
if (system("$GIT cat-file -e ".
"$refspec:${maybe}.py >/dev/null 2>&1") == 0) {
$source = "${maybe}.py";
$file = "${maybe}.py";
}
elsif (system("$GIT cat-file -e ".
" $refspec:${maybe}.rspec >/dev/null 2>&1") == 0) {
$source = "${maybe}.rspec";
$file = "${maybe}.rspec";
}
if ($file) {
#
# Do this seemingly odd cat-file, simply cause its the only way
# --follow-symlinks works. It adds the commit hash as the first
# line of output, so see below where that first line is killed.
#
$source =
emutil::ExecQuiet("echo '$refspec:$file' | ".
" $GIT cat-file --batch ".
" --follow-symlinks");
if ($?) {
print STDERR $source;
return undef;
}
# Kill first line.
$source =~ s/^(?:.*\n){1}//;
last;
}
last
if ($source);
}
if (!$source) {
print STDERR "$repodir, $refspec\n";
print STDERR `/usr/bin/id`;
print STDERR `/bin/ls -la`;
print STDERR "Could not find source code in repository: $reponame\n";
return undef;
}
#
# Do this seemingly odd cat-file, simply cause its the only way
# --follow-symlinks works. It adds the commit hash as the first
# line of output, so see below where that first line is killed.
#
my $stuff =
emutil::ExecQuiet("echo '$refspec:$source' | ".
" $GIT cat-file --batch --follow-symlinks");
if ($?) {
print STDERR $stuff;
return undef;
}
# Kill first line.
$stuff =~ s/^(?:.*\n){1}//;
return $stuff;
return $source;
}
#
......@@ -756,6 +777,36 @@ sub RemoveRepo($)
return 0;
}
#
# Remove a repo
#
sub DoRemoveRepo()
{
my $optlist = "n:p:";
my %options = ();
if (! getopts($optlist, \%options)) {
usage();
}
my $reponame = GetRepoName(\%options);
if (! -e "$REPODIR/$reponame") {
fatal("Repository does not exist.");
}
if (RemoveRepo($reponame)) {
if (defined($webtask)) {
$webtask->Exited(-1);
}
exit(-1);
}
else {
if (defined($webtask)) {
$webtask->Exited(0);
}
exit(0);
}
}
#
# Return a branch list.
#
......@@ -1222,6 +1273,48 @@ sub GetRepoSize($)
return $mebi;
}
#
# Prune stale repos (repos we left behind).
#
sub DoPruneStaleRepos()
{
my $optlist = "n";
my $impotent = 1;
my @stale = ();
my %options = ();
if (! getopts($optlist, \%options)) {
usage();
}
if (defined($options{"n"})) {
$impotent = 1;
}
chdir("$REPODIR") or
fatal("Could not chdir to $REPODIR");
opendir(DIR, $REPODIR) or
fatal("Unable to open directory $REPODIR");
while (my $dirent = readdir(DIR)) {
next
if ($dirent eq "." || $dirent eq "..");
next
if (!ValidUUID($dirent));
my $query_result =
DBQueryFatal("select uuid,deleted from apt_profile_versions ".
"where reponame='$dirent'");
if (!$query_result->numrows) {
if ($impotent) {
print "Would delete stale repo $dirent\n";
}
push(@stale, $dirent);
next;
}
}
exit(0);
}
#
# Get estimated repository size.
#
......
......@@ -1336,6 +1336,14 @@ sub DoTerminate()
if (defined($options{"L"})) {
$takelock = 1;
}
#
# Admins can terminate a paniced experiment, we will pass along an
# admin credential to tell the CM its okay.
#
if ($instance->paniced() && !$this_user->IsAdmin()) {
fatal("Only administrators can terminate a paniced experiment")
}
my $slice = $instance->GetGeniSlice();
if (!defined($slice)) {
......@@ -1426,7 +1434,16 @@ sub DoTerminate()
}
my $response;
$errcode = CallMethodOnAggregates("Terminate", 10, \$response, @agglist);
#
# Helper callback to send the proper arguments.
#
my $coderef = sub {
my ($sliver) = @_;
# Flag that we want to clear the panic, so send an auth credential.
return $sliver->Terminate($instance->paniced() ? 1 : undef);
};
$errcode = CallMethodOnAggregates($coderef, 10, \$response, @agglist);
if ($errcode) {
$exitcode = -1;
......
......@@ -121,7 +121,7 @@ sub CanDelete($$);
sub PublishProfile($);
sub InsertImageRecords($);
sub ListImages();
sub GetScriptParameters($$);
sub GetScriptParameters($$$);
sub VerifyXML($$);
sub ModifyProfileInternal($$$);
sub UseNewGenilib($);
......@@ -254,6 +254,7 @@ sub CreateProfile()
my $parent_profile;
my $node_id;
my $usererror;
my $reponame;
my %errors = ();
my %options = ();
......@@ -308,12 +309,13 @@ sub CreateProfile()
# Need to do initial clone.
#
if (exists($new_args{'repourl'})) {
$reponame = NewUUID();
my $repourl = $new_args{'repourl'};
my $reponame = NewUUID();
my $repohash;
my $checkout = ($this_user->IsAdmin() ? "-c" : "");
my $output =
emutil::ExecQuiet("$MANAGEGITREPO clone -n $reponame ".
emutil::ExecQuiet("$MANAGEGITREPO clone $checkout -n $reponame ".
" -S " . $new_args{"name"} . " '$repourl'");
if ($?) {
UserError($output);
......@@ -344,7 +346,7 @@ sub CreateProfile()
# Script parameters
if (defined($script) && $script ne "" && $script =~ /^import/m) {
my $paramdefs;
my $retval = GetScriptParameters($script, \$paramdefs);
my $retval = GetScriptParameters($script, $reponame, \$paramdefs);
if ($retval) {
if ($retval < 0) {
fatal("Could not get paramdefs: $paramdefs!");
......@@ -738,7 +740,8 @@ sub ModifyProfileInternal($$$)
# data. Only python scripts of course.
#
my $output;
my $retval = GetScriptParameters($script, \$output);
my $retval = GetScriptParameters($script,
$profile->reponame(), \$output);
if ($retval) {
if ($retval < 0) {
$$pmsg = $output;
......@@ -1008,6 +1011,8 @@ sub UpdateProfileFromRepo()
fatal("Could not open temporary file for script");
}
my $opts = ($usenewgenilib ? "-N" : "");
# Import repo into jail.
$opts .= " -r " . $profile->reponame();
print $fh $script;
$output = emutil::ExecQuiet("$RUNGENILIB $opts $filename");
if ($?) {
......@@ -1064,9 +1069,9 @@ sub UpdateProfileFromRepo()
# For a Parameterized Profile, need to generate and store the form
# data. Only python scripts of course. Does not return on error.
#
sub GetScriptParameters($$)
sub GetScriptParameters($$$)
{
my ($script, $pref) = @_;
my ($script, $reponame, $pref) = @_;
my ($fh, $filename) = tempfile(UNLINK => 1);
if (!defined($fh)) {
......@@ -1074,6 +1079,8 @@ sub GetScriptParameters($$)
return -1;
}
my $opts = ($usenewgenilib ? "-N" : "");
# Import repo into jail.
$opts .= " -r $reponame" if (defined($reponame));
print $fh $script;
my $output = emutil::ExecQuiet("$RUNGENILIB $opts -p $filename");
......
#!/usr/local/bin/python
#
# Copyright (c) 2005-2018 University of Utah and the Flux Group.
# Copyright (c) 2005-2019 University of Utah and the Flux Group.
#
# {{{EMULAB-LICENSE
#
......@@ -232,6 +232,10 @@ for child in tree.getroot():
pass
elif element.tag == "routertype" and element.text:
routertype = element.text
if routertype == "static-old":
Fatal("Unsupported routertype static-old on node " +
vname + ": " + element.text)
pass
if routertype == "static-ddijk":
routertype = "static"
pass
......
......@@ -45,14 +45,18 @@ sub usage()
print STDERR " -P file - Generate and write parameter block to file\n";
print STDERR " -b file - Run script using the parameter defs in file\n";
print STDERR " -W - Python warnings are fatal.\n";
print STDERR " -r repo - Map repo into jail.\n";
print STDERR " -h hash - With -r, set the checkout hash.\n";
exit(-1);
}
my $optlist = "do:pP:b:WN";
my $optlist = "do:pP:b:WNr:h:";
my $debug = 0;
my $getparams = 0;
my $paramfile;
my $ofile;
my $repo;
my $reporef;
my $newgenilib = 0;
my $warningsfatal = 0;
......@@ -64,6 +68,7 @@ my $TBOPS = "@TBOPSEMAIL@";
my $CONTROL = "@USERNODE@";
my $MAINSITE = @TBMAINSITE@;
my $TAR = "/usr/bin/tar";
my $REPODIR = "/repos";
# Locals
my $SAVEUID = $UID;
......@@ -147,6 +152,29 @@ if (defined($options{"b"})) {
if (defined($options{"o"})) {
$ofile = $options{"o"};
}
if (defined($options{"r"})) {
$repo = $options{"r"};
# Must taint check
if ($repo =~ /^([-\w]+)$/) {
$repo = $1;
}
else {
die("Bad data in argument: $repo");
}
if (! -e "$REPODIR/$repo") {
die("No such repo $repo\n");
}
if (defined($options{"h"})) {
$reporef = $options{"h"};
# Must taint check
if ($reporef =~ /^([-\w\/]+)$/) {
$reporef = $1;
}
else {
die("Bad data in argument: $reporef");
}
}
}
if (@ARGV != 1) {
usage();
}
......@@ -219,6 +247,8 @@ $cmdargs .= " -u " . $this_user->uid();
$cmdargs .= ($getparams ? " -p " : "");
$cmdargs .= ($warningsfatal ? " -W " : "");
$cmdargs .= ($newgenilib ? " -N " : "");
$cmdargs .= (defined($repo) ? " -r $repo " : "");
$cmdargs .= (defined($reporef) ? " -h $reporef " : "");
#
# We want to send over both files via STDIN, so combine them, and pass
......@@ -260,6 +290,9 @@ while (<ERR>) {
$errs .= $_;
}
close(ERR);
if ($debug) {
print STDERR $errs;
}
my $exit_status = $?;
if ($exit_status) {
......
......@@ -40,13 +40,15 @@ sub usage()
exit(-1);
}
my $optlist = "u:vpb:WJB:N";
my $optlist = "u:vpb:WJB:Nr:h:";
my $user;
my $getparams= 0;
my $paramsize;
my $warningsfatal = 0;
my $usejail = 0;
my $iocagepath;
my $repo;
my $reporef;
#
# Configure variables
......@@ -56,6 +58,7 @@ my $TBOPS = "@TBOPSEMAIL@";
my $TESTMODE = 0;
my $GENILIB = "$TB/lib/geni-lib";
my $JAILPROG = "$TB/libexec/genilib-jail";
my $REPODIR = "/repos";
my $TAR = "/usr/bin/tar";
my $debug = 0;
......@@ -119,6 +122,29 @@ if (defined($options{"J"})) {
$iocagepath = $options{"B"};
}
}
if (defined($options{"r"})) {
$repo = $options{"r"};
# Must taint check
if ($repo =~ /^([-\w]+)$/) {
$repo = $1;
}
else {
die("Bad data in argument: $repo");
}
if (! -e "$REPODIR/$repo") {
die("No such repo $repo\n");
}
if (defined($options{"h"})) {
$reporef = $options{"h"};
# Must taint check
if ($reporef =~ /^([-\w\/]+)$/) {
$reporef = $1;
}
else {
die("Bad data in argument: $reporef");
}
}
}
#
# First option has to be the -u option, the user to run this script as.
......@@ -232,6 +258,14 @@ if ($warningsfatal) {
my $exit_status;
if ($usejail) {
my $bopt = (defined($iocagepath) ? "-B $iocagepath" : "");
my $ropt = "";
if (defined($repo)) {
$ropt = "-r $repo";
if (defined($reporef)) {
$ropt .= " -h $reporef";
}
}
#
# We are executing the command in a jail, fire off the jail script.
......@@ -245,7 +279,7 @@ if ($usejail) {
# name space. Those copies will be owned by the user so they can be
# read/written.
#
$exit_status = system("$JAILPROG $bopt -u $user $ifile");
$exit_status = system("$JAILPROG $bopt $ropt -u $user $ifile");
#
# Now that we are done with the files, chown them to the user and
......
......@@ -143,6 +143,9 @@ my %options = ();
if (! GetOptions(\%options, @optlist)) {
usage();
}
if (defined($options{"d"})) {
$debug = 1;
}
usage()
if (@ARGV != 1 || !defined($pid));
......@@ -164,6 +167,9 @@ if (!defined($project)) {
}
if (!defined($portal)) {
$portal = $project->Brand()->brand();
if ($portal eq "classic") {
$portal = "emulab";
}
}
# This was a dumb mistake, I need to convert from servername to portal.
$ENV{"SERVER_NAME"} = $project->Brand()->Server();
......@@ -367,7 +373,7 @@ if (defined($stop_at)) {
}
@args = (@args, $xmlfile);
if ($debug) {
if (0 && $debug) {
print "@args\n";
system("/bin/cat $xmlfile");
}
......@@ -377,7 +383,7 @@ if ($debug) {
# attached to a tty. In general, this script is going to get called in
# a disconnected state.
#
if (isatty(\*STDOUT)) {
if (isatty(\*STDOUT) && !$debug) {
$logfile = TBMakeLogname("start-experiment");
if (my $childpid = TBBackGround($logfile)) {
......
......@@ -1603,6 +1603,23 @@ sub GetCreator($)
return $user;
}
sub GetUpdater($)
{
my ($self) = @_;
require User;
return undef
if (!$self->updater_idx());
my $user = User->Lookup($self->updater_idx());
if (! defined($user)) {
print("*** WARNING: Could not lookup user object for $self!\n");
return undef;
}
return $user;
}
#
# Check permissions. Note that root may ask permission, which comes in
# as an undef user.
......@@ -2122,6 +2139,32 @@ sub Unlock($)
return 0;
}
#
# Steal the lock
#
sub TakeLock($)
{
my ($self) = @_;
return -1
if (!DBQueryWarn("lock tables images write"));
my $imageid = $self->imageid();
my $query_result =
DBQueryWarn("update images set locker_pid=$PID " .
"where imageid='$imageid' and locked is not null");
if (! $query_result ||
$query_result->numrows == 0) {
DBQueryWarn("unlock tables");
return -1;
}
DBQueryWarn("unlock tables");
$self->{'IMAGE'}->{'locker_pid'} = $PID;
return 0;
}
sub GotLock($)
{
my ($self) = @_;
......@@ -2503,6 +2546,34 @@ sub ListForURN($$)
return @result;
}
#
# List of images for a Group
#
sub ListForGroup($$)
{
my ($class, $group) = @_;
my @result = ();
my $pid_idx = $group->pid_idx();
my $gid_idx = $group->gid_idx();
my $query_result =
DBQueryWarn("select imageid,version from image_versions ".
"where pid_idx='$pid_idx' and gid_idx='$gid_idx' and ".
" deleted is null and isdataset=0 ".
"order by imagename,version");
while (my ($imageid,$version) = $query_result->fetchrow_array()) {
# Want latest version.
my $image = Image->Lookup($imageid, $version);
next
if (!defined($image));
push(@result, $image);
}
return @result;
}
#
# Set to use the logfile. It becomes the "current" spew.
#
......
#!/usr/bin/perl -wT
#
# Copyright (c) 2007-2013, 2017 University of Utah and the Flux Group.
# Copyright (c) 2007-2019 University of Utah and the Flux Group.
#
# {{{EMULAB-LICENSE
#
......@@ -466,13 +466,31 @@ sub SetMetadata($$$)
DBQueryWarn("delete from logfile_metadata where logidx='$logidx'")
if ($purge);
foreach my $ref (@{$argref}) {
my ($key,$val) = @{$ref};
my $coderef = sub {
my ($key,$val) = @_;
$key = DBQuoteSpecial($key);
$val = DBQuoteSpecial($val);
return -1
if (! DBQueryWarn("replace into logfile_metadata set ".
" logidx='$logidx',metakey=$key,metaval=$val"));
return 0;
};
#
# Silly choice a long time ago.
#
if (ref($argref) eq "ARRAY") {
foreach my $ref (@{$argref}) {
return -1
if (&$coderef(@{$ref}));
}
}
else {
foreach my $key (keys(%{$argref})) {
return -1
if (&$coderef($key, $argref->{$key}));
}
}
return 0;
}
......
......@@ -608,6 +608,12 @@ sub GetCreator($)
return $self->image()->GetCreator();
}
sub GetUpdater($)
{
my ($self) = @_;
return $self->image()->GetUpdater();
}
#
# Load the group object for an image
......@@ -818,6 +824,13 @@ sub GotLock($)
return $self->image()->GotLock();
}
sub TakeLock($)
{
my ($self) = @_;
return $self->image()->TakeLock();
}
#
# Wait to get lock.
#
......@@ -918,6 +931,29 @@ sub ListForURN($$)
return @result;
}
#
# List of images in a project/group
#
sub ListForGroup($$)
{
my ($class, $group) = @_;
my @result = ();
my @images = Image->ListForGroup($group);
foreach my $image (@images) {
my $imageid = $image->imageid();
my $version = $image->version();
my $tmp = OSImage->Lookup($imageid, $version);
if (!defined($tmp)) {
print STDERR "Could not lookup image $imageid,$version\n";
next;
}
push(@result, $tmp);
}
return @result;
}
#
# Set to use the logfile. It becomes the "current" spew.
#
......
......@@ -600,6 +600,28 @@ sub IsLeader($$)
return $user->SameUser($self->GetLeader());
}
sub IsManager($$)
{
my ($self, $user) = @_;
# Must be a real reference.
return 0
if (! (ref($self) && ref($user)));
return TBMinTrust($self->Trust($user), PROJMEMBERTRUST_GROUPROOT());
}
sub IsMember($$)
{
my ($self, $user) = @_;
# Must be a real reference.
return 0
if (! (ref($self) && ref($user)));
return TBMinTrust($self->Trust($user), PROJMEMBERTRUST_USER());
}
#
# Return project group.
#
......
......@@ -1887,6 +1887,8 @@ sub GList($$)
print STDERR "*** Unexpected results from 'id -G $user_uid': $glist\n";
return undef;
}
return $glist
if (!defined($default));
#
# Remove current group from glist, then add gid twice at the front
......@@ -1973,6 +1975,35 @@ sub FlipTo($$)
return 0;
}
#
# Execute a command as user and then return to original.
#
sub ExecuteAs($$;$)
{
my ($self, $command, $default_gid) = @_;
my $current_uid = $UID;
my $current_euid = $EUID;
my $current_gid = $GID;
my $current_egid = $EGID;
my $USER = $ENV{'USER'};
my $LOGNAME = $ENV{'LOGNAME'};
$self->FlipTo($default_gid);
my $output = emutil::ExecQuiet($command);
my $status = $?;
$EUID = 0;
$GID = $current_gid;
$EGID = $current_egid;
$UID = $current_uid;
$EUID = $current_euid;
$ENV{'USER'} = $USER;
$ENV{'LOGNAME'} = $LOGNAME;
return ($status, $output);
}
#
# Update aggregate stats.
#
......
......@@ -37,6 +37,7 @@ sub usage() {
" -u - Generate lists for a user; add -m for new email address\n".
" -p - Generate lists for a project (includes subgroups)\n".
" -P - Generate lists for all projects (includes subgroups)\n".
" -T - Generate powder-announce\n".
" -t - Generate activity lists\n".
" -c - Generate just the current users list\n".
" -a - Generate all email lists; careful ...\n");
......@@ -49,14 +50,16 @@ sub RecentProjects();
sub RecentProjectLeaders();
sub ProjectLeaders();
sub ProjectLists($$);
sub PortalLists();
sub genelist($$$$);
my $optlist = "anu:p:tdmfcP";
my $optlist = "anu:p:tdmfcPT";
my $debug = 0;
my $all = 0;
my $update = 0;
my $activity= 0;
my $projects= 0;
my $portals = 0;
my $current = 0;
my $impotent= 0;
my $force = 0;
......@@ -76,6 +79,7 @@ my $MAILMANSUPPORT= @MAILMANSUPPORT@;
my $PROJECTMAILLISTS = @PROJECTMAILLISTS@;
my $MMPROG = "$TB/sbin/setmmlistmembers";
my $PGENISUPPORT= @PROTOGENI_SUPPORT@;
my $MAINSITE = @TBMAINSITE@;
# Note no -n option. We redirect stdin from the new exports file below.
my $SSH = "$TB/bin/sshtb -l root -host $USERS";
......@@ -96,6 +100,7 @@ use libdb;
use libtestbed;
use libtblog;
use User;
use Brand;
#
# We don't want to run this script unless its the real version.
......@@ -148,6 +153,9 @@ if (defined($options{"P"})) {
if (defined($options{"t"})) {
$activity = 1;
}
if (defined($options{"T"})) {
$portals = 1;
}
if (defined($options{"n"})) {
$impotent = 1;
}
......@@ -263,6 +271,9 @@ else {
$admin_address = $TBOPS;
}
PortalLists()
if ($all || $portals || $update);
ActiveUsers()
if ($all || $activity || $update || $current);
......@@ -499,6 +510,29 @@ sub ProjectLists($$)
}
}
sub PortalLists()
{
return
if (!$MAINSITE);
# Just the Powder portal.
print "Getting powder portal users\n" if $debug;
my $query_result =
DBQueryFatal("SELECT distinct u.usr_email ".
($MAILMANSUPPORT ?
", u.uid ,u.usr_name, u.mailman_password " : "") .
" from group_membership as p ".
"left join users as u on u.uid_idx=p.uid_idx ".
"left join projects on projects.pid=p.pid ".
"where p.gid=p.pid and ".
" p.trust!='none' and u.status='active' and ".
" (projects.portal='powder' or u.portal='powder') ".
"order by u.usr_email");
genelist($query_result, "$TBOPS", "powder-announce", 0);
}
#
# Generate and fire over a list.
#
......
......@@ -8098,6 +8098,13 @@ sub FlipToUser($$)
}
return undef
if (! (defined($project) && defined($group) && defined($creator)));
#
# If creator is frozen we need to use the project leader instead.
#
if ($creator->frozen()) {
$creator = $project->GetLeader();
}
$creator = GeniUser::LocalUser->Create($creator);
#
......
......@@ -909,7 +909,7 @@ sub DeleteSlice($)
}
if (!defined($aggregate)) {
# Easy. Force blocking off and cleanup.
$blocking = 1;
$blocking = 0;
goto cleanit;
}
my $slice_experiment = $slice->GetExperiment();
......@@ -921,10 +921,41 @@ sub DeleteSlice($)
if (defined($slice_experiment) &&
($slice_experiment->state() eq EXPTSTATE_PANICED() ||
$slice_experiment->paniced())) {
print STDERR "Refusing to terminate a paniced experiment\n";
$slice->UnLock();
return GeniResponse->Create(GENIRESPONSE_REFUSED(), undef,
"Refusing to terminate a paniced experiment");
#
# We are going to let the slice's SA clear the panic so it
# can terminate. We know that it is in level 1 or 3, so we
# can just clear it without rebooting, the nodes are going to
# go into reloading anyway.
#
my $caller = GeniHRN->new($credential->owner_urn());
if (! ($caller->IsSA() &&
$caller->domain() eq $slice->urn()->domain())) {
print STDERR "Refusing to terminate a paniced experiment\n";
$slice->UnLock();
return GeniResponse->Create(GENIRESPONSE_REFUSED(), undef,
"Refusing to terminate a paniced experiment");
}
if (! ($slice_experiment->paniced() == 1 ||
$slice_experiment->paniced() == 3)) {
return GeniResponse->Create(GENIRESPONSE_REFUSED(), undef,
"Paniced experiment is not at correct level");
}
#
# This operation has to be done as an admin person.
#
my $pid = $slice_experiment->pid();
my $eid = $slice_experiment->eid();
my $command = "$WAP $PANIC -c $pid $eid";
print STDERR "Clearing panic before termination\n";
GeniUtil::FlipToElabMan();
system($command);
if ($?) {
$slice->UnLock();
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Could not clear panic before termination");
}
$slice->ClearShutdown();
GeniUtil::FlipToGeniUser();
}
#
......@@ -4124,24 +4155,46 @@ sub DeleteImage($)
return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
"Not enough permission to delete image; wrong SA or user");
}
my $fliptouser = $user;
#
# New approach is a project credential which the Portal will grant
# to the project leader/managers. We leave the old checks in place.
#
if ($credential->target_urn()->IsProject()) {
if ($credential->target_urn()->authority() ne
$project->nonlocalurn()->authority()) {
return GeniResponse->BadArgsResponse(
"Project credential does not match image domain/project");
}
#
# If not the creator, operate as project leader. This can result
# in the email not providing the actual person doing the deletion
# unless we move the email here instead of in delete_image.
#
if (! (defined($creator_urn) &&
($creator_urn eq $user->urn() ||
$creator_urn eq $ENV{'REALGENIURN'}))) {
# fliptouser will flip to image project creator.
$fliptouser = undef;
}
}
#
# If not the creator, then require override to prevent
# accidental removal of images not belonging to current user.
# Note that not all images have the creator_urn set (yet).
#
if (!((defined($creator_urn) &&
!($creator_urn eq $user->urn() ||
$creator_urn eq $ENV{'REALGENIURN'})) ||
($user->IsLocal() &&
$image->AccessCheck($user->emulab_user(),
elsif (!((defined($creator_urn) &&
!($creator_urn eq $user->urn() ||
$creator_urn eq $ENV{'REALGENIURN'})) ||
($user->IsLocal() &&
$image->AccessCheck($user->emulab_user(),
EmulabConstants::TB_IMAGEID_DESTROY())))) {
return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
"Not your image; please specify original creator urn")