...
 
Commits (178)
......@@ -52,7 +52,7 @@ ifeq ($(STANDALONE_CLEARINGHOUSE),0)
SUBDIRS = \
clientside/lib \
db assign www @optional_subdirs@ clientside ipod security sensors \
pxe tbsetup account tmcd utils backend tip ipod vis \
pxe tbsetup account tmcd utils backend ipod vis \
sensors os xmlrpc autofs install/newnode_sshkeys \
tools/svn collab/exp-vis node_usage install
ifeq ($(ISMAINSITE),1)
......@@ -153,14 +153,12 @@ ops-install:
@$(MAKE) -C rc.d control-install
@$(MAKE) -C tbsetup control-install
@$(MAKE) -C security control-install
@$(MAKE) -C tip control-install
@$(MAKE) -C db control-install
@$(MAKE) -C utils control-install
@$(MAKE) -C clientside control-install
ifeq ($(EVENTSYS),1)
@$(MAKE) -C event control-install
endif
@$(MAKE) -C xmlrpc control-install
@$(MAKE) -C account control-install
ifeq ($(PELABSUPPORT),1)
@$(MAKE) -C pelab control-install
......@@ -211,7 +209,7 @@ just-builddirs:
tipserv-install:
-mkdir -p $(INSTALL_TOPDIR)/log/tiplogs
-mkdir -p $(INSTALL_TOPDIR)/etc
@$(MAKE) -C tip tipserv-install
@$(MAKE) -C clientside/tip tipserv-install
@$(MAKE) -C clientside/os/capture tipserv-install
@$(MAKE) -C tbsetup tipserv-install
......@@ -222,34 +220,22 @@ client-mkdirs:
client:
@$(MAKE) -C clientside client
@$(MAKE) -C os client
ifneq ($(SYSTEM),CYGWIN_NT-5.1)
@$(MAKE) -C tip client
endif
client-install: client client-mkdirs
@$(MAKE) -C clientside client-install
@$(MAKE) -C os client-install
ifneq ($(SYSTEM),CYGWIN_NT-5.1)
@$(MAKE) -C tip client-install
endif
subboss:
@$(MAKE) -C clientside subboss
@$(MAKE) -C tbsetup subboss
@$(MAKE) -C db subboss
@$(MAKE) -C os subboss
ifneq ($(SYSTEM),CYGWIN_NT-5.1)
@$(MAKE) -C tip client
endif
@$(MAKE) -C utils subboss
subboss-install: subboss
@$(MAKE) -C clientside subboss-install
@$(MAKE) -C tbsetup subboss-install
@$(MAKE) -C os subboss-install
ifneq ($(SYSTEM),CYGWIN_NT-5.1)
@$(MAKE) -C tip client-install
endif
@$(MAKE) -C utils subboss-install
@$(MAKE) -C db subboss-install
@$(MAKE) -C rc.d subboss-install
......
......@@ -70,6 +70,7 @@ my $TB = "@prefix@";
my $USERPATH = "$TB/bin";
my $WITHZFS = @WITHZFS@;
my $ZFS_NOEXPORT = @ZFS_NOEXPORT@;
my $OPSVM_ENABLE = @OPSVM_ENABLE@;
my $OURDOMAIN = "@OURDOMAIN@";
my $ZFS_ROOT = "@ZFS_ROOT@";
my $ZFS_QUOTA_USER = "@ZFS_QUOTA_USER@";
......@@ -88,6 +89,7 @@ my $CHPASS = "/usr/bin/chpass";
my $CHOWN = "/usr/sbin/chown";
my $CHMOD = "/bin/chmod";
my $MKDIR = "/bin/mkdir";
my $CHFLAGS = "/bin/chflags";
my $NOLOGIN = "/sbin/nologin";
my $MV = "/bin/mv";
my $ZFS = "/sbin/zfs";
......@@ -95,11 +97,23 @@ my $KEYGEN = "/usr/bin/ssh-keygen";
my $SKEL = "/usr/share/skel";
my $PIDFILE = "/var/run/mountd.pid";
my $TSFILE = "/var/run/mountd.ts";
my $USEFLAGS = 0;
# XXX
my $NOSUCHUSER = 67;
my $USEREXISTS = 65;
# We use flags to prevent deletion of certain dirs, on FreeBSD 10 or greater.
# Note that when OPSVM_ENABLE=1, the file systems are actually back over
# on boss, so cannot do the chflags here. Hmm.
if (!$OPSVM_ENABLE) {
if (`uname -r` =~ /^(\d+)\.(\d+)/) {
if ($1 >= 10) {
$USEFLAGS = 1;
}
}
}
#
# Testbed Support libraries
#
......@@ -118,6 +132,7 @@ my $FSPROJROOT = "@FSDIR_PROJ@";
my $FSGROUPROOT = "@FSDIR_GROUPS@";
my $FSSCRATCHROOT = "@FSDIR_SCRATCH@";
# These are duplicated in db/Project.pm.in ...
# Project subdir list
my @DIRLIST = ("exp", "images", "logs", "deltas", "tarfiles", "rpms",
"groups", "tiplogs", "images/sigs", "templates");
......@@ -148,6 +163,8 @@ sub MakeDir($$);
sub WhackDir($$);
sub mysystem($);
sub runBusyLoop($);
sub SetNoDelete($);
sub ClearNoDelete($);
#
# Check args.
......@@ -462,7 +479,7 @@ sub AddProject()
my $unix_uid = shift(@ARGV);
# Create the project unix group
if (mysystem("egrep -q -s '^${unix_name}:' /etc/group")) {
if (system("egrep -q -s '^${unix_name}:' /etc/group")) {
print "Adding group $unix_name ...\n";
if (runBusyLoop("$GROUPADD $unix_name -g $unix_gid")) {
......@@ -481,6 +498,9 @@ sub AddProject()
if (! chown($unix_uid, $unix_gid, "$path")) {
fatal("Could not chown '$path' to $unix_uid/$unix_gid: $!");
}
if (SetNoDelete($path)) {
fatal("Could not set no delete on '$path'!\n");
}
# Create required /proj subdirs
foreach my $dir (@DIRLIST) {
......@@ -494,6 +514,9 @@ sub AddProject()
if (! chown($unix_uid, $unix_gid, "$path")) {
fatal("Could not chown '$path' to $unix_uid/$unix_gid: $!");
}
if (SetNoDelete($path)) {
fatal("Could not set no delete on '$path'!\n");
}
}
# Create the /groups directory
......@@ -507,6 +530,9 @@ sub AddProject()
if (! chown($unix_uid, $unix_gid, "$path")) {
fatal("Could not chown '$path' to $unix_uid/$unix_gid: $!");
}
if (SetNoDelete($path)) {
fatal("Could not set no delete on '$path'!\n");
}
# Create a symlink for the default group
$path = "$GROUPROOT/$name/$name";
......@@ -515,6 +541,9 @@ sub AddProject()
fatal("Could not symlink $PROJROOT/$name to $path");
}
}
if (SetNoDelete($path)) {
fatal("Could not set no delete on '$path'!\n");
}
# Finally, create /scratch dir if supported
if ($SCRATCHROOT) {
......@@ -528,6 +557,9 @@ sub AddProject()
if (! chown($unix_uid, $unix_gid, "$path")) {
fatal("Could not chown '$path' to $unix_uid/$unix_gid: $!");
}
if (SetNoDelete($path)) {
fatal("Could not set no delete on '$path'!\n");
}
}
return 0;
......@@ -548,7 +580,7 @@ sub AddGroup()
my $projname = shift(@ARGV);
# Create the group unix group
if (mysystem("egrep -q -s '^${unix_name}:' /etc/group")) {
if (system("egrep -q -s '^${unix_name}:' /etc/group")) {
print "Adding group $unix_name ...\n";
if (runBusyLoop("$GROUPADD $unix_name -g $unix_gid")) {
......@@ -568,6 +600,9 @@ sub AddGroup()
if (! chown($unix_uid, $unix_gid, "$path")) {
fatal("Could not chown '$path' to $unix_uid/$unix_gid: $!");
}
if (SetNoDelete($path)) {
fatal("Could not set no delete on '$path'!\n");
}
# Create required /groups/gid subdirs
foreach my $dir (@GDIRLIST) {
......@@ -581,6 +616,9 @@ sub AddGroup()
if (! chown($unix_uid, $unix_gid, "$path")) {
fatal("Could not chown '$path' to $unix_uid/$unix_gid: $!");
}
if (SetNoDelete($path)) {
fatal("Could not set no delete on '$path'!\n");
}
}
return 0;
......@@ -931,6 +969,10 @@ sub WhackDir($$)
my ($fs,$dir) = @_;
my $zfsfs = "";
if (ClearNoDelete("$fs/$dir")) {
fatal("Could not clear no delete on '$fs/$dir'!\n");
}
if ($WITHZFS) {
my $path = "${ZFS_ROOT}${fs}/$dir";
$zfsfs = $path
......@@ -1098,3 +1140,30 @@ sub fatal($) {
print STDERR "$msg\n";
exit(-1);
}
#
# Use chflags on certain directories to prevent users from deleting things.
# Just a bandaid on the real problem.
#
sub SetNoDelete($)
{
my ($filename) = @_;
return 0
if (!$USEFLAGS);
system("$CHFLAGS sunlink $filename");
return ($? ? -1 : 0);
}
sub ClearNoDelete($)
{
my ($filename) = @_;
return 0
if (!$USEFLAGS);
# Do a recursive change here since we tend to do deletions on the
# top level directories.
system("$CHFLAGS -R nosunlink $filename");
return ($? ? -1 : 0);
}
#!/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
#
......@@ -298,13 +298,20 @@ if( defined( $oldkeyfile ) ) {
my $genopts =
($encrypted ? " -passout 'pass:${sh_password}' -des3 " : "");
system("$OPENSSL genrsa $genopts -out syscert_key.pem 1024")
== 0 or fatal("Could generate new key");
system("$OPENSSL req -text -new -config syscert.cnf ".
($encrypted ? " -passin 'pass:${sh_password}' " : "") .
" -key syscert_key.pem -out syscert_req.pem $outline") == 0
or fatal("Could not create certificate request");
my $output =
emutil::ExecQuiet("$OPENSSL genrsa $genopts -out syscert_key.pem 2048");
if ($?) {
print STDERR $output;
fatal("Could generate new key");
}
$output =
emutil::ExecQuiet("$OPENSSL req -text -new -config syscert.cnf ".
($encrypted ? " -passin 'pass:${sh_password}' " : "") .
" -key syscert_key.pem -out syscert_req.pem $outline");
if ($?) {
print STDERR $output;
fatal("Could not create certificate request");
}
}
#
......
......@@ -401,7 +401,7 @@ sub CreateNewCert() {
my $genopts =
($encrypted ? " -passout 'pass:${sh_password}' -des3 " : "");
system("$OPENSSL genrsa $genopts -out usercert_key.pem 1024")
system("$OPENSSL genrsa $genopts -out usercert_key.pem 2048")
== 0 or fatal("Could generate new key");
}
my $reqopts = ($encrypted ? "-passin 'pass:${sh_password}' " : "");
......
......@@ -44,6 +44,7 @@ my $impotent= 0;
my $silent = 0;
my $portal;
my $resend;
my %licenses = ();
#
# Configure variables
......@@ -53,6 +54,7 @@ my $TBOPS = "@TBOPSEMAIL@";
my $TBAUDIT = "@TBAUDITEMAIL@";
my $TBBASE = "@TBBASE@";
my $TBWWW = "@TBWWW@";
my $LICENSES = "$TB/sbin/manage_licenses";
#
# This script is setuid, so please do not run it as root. Hard to track
......@@ -233,12 +235,28 @@ if (exists($xmlparse->{'attribute'}->{"portal"})) {
fatal("Bad portal: $portal");
}
}
# Licenses. Save for later, but need to delete.
foreach my $key (keys(%{ $xmlparse->{'attribute'} })) {
if ($key =~ /^license_([-\w]+)$/) {
my $value = $xmlparse->{'attribute'}->{"$key"}->{'value'};
my $name = $1;
if (lc($value) eq "yes") {
system("$LICENSES show $name");
if ($?) {
fatal("Invalid license name: $name");
}
$licenses{$name} = $name;
print "requested license $name\n";
}
delete($xmlparse->{'attribute'}->{"$key"});
}
}
#
# Make sure all the required arguments were provided.
#
foreach my $key (keys(%required)) {
fatal("Missing required attribute '$key'")
if (! exists($xmlparse->{'attribute'}->{"$key"}));
}
......@@ -386,6 +404,18 @@ if (!defined($newproj)) {
}
my $new_idx = $newproj->pid_idx();
#
# Add any licenses.
#
if (keys(%licenses)) {
foreach my $name (keys(%licenses)) {
system("$LICENSES require $name $new_pid");
if ($?) {
fatal("Invalid license name: $name");
}
}
}
#
# See if we are in an initial Emulab setup. If so, no email sent.
#
......
......@@ -1051,7 +1051,7 @@ ScriptAlias /protogeni/gtw/pubxmlrpc @prefix@/devel/gtw/protogeni/pubxmlrpc/pubg
SSLRequireSSL
Order deny,allow
allow from all
SSLOptions +StdEnvVars +LegacyDNStringFormat
SSLOptions +StdEnvVars +ExportCertData +LegacyDNStringFormat
Options +ExecCGI +FollowSymLinks
SetHandler cgi-script
SetEnv USER "nobody"
......
......@@ -367,51 +367,6 @@ DocumentRoot "/usr/local/www/data"
Allow from all
</Directory>
#
# Twiki-related entries
#
<Directory "/usr/local/www/data/twiki/bin">
Options +ExecCGI
SetHandler cgi-script
Allow from all
SetEnv USER "www"
</Directory>
<Directory "/usr/local/www/data/twiki/pub">
Options +FollowSymLinks +Includes
AllowOverride None
Allow from all
</Directory>
<Directory /usr/local/www/data/twiki/data>
Options None
AllowOverride None
Order deny,allow
Deny from all
</Directory>
<Directory /usr/local/www/data/twiki/lib>
Options None
AllowOverride None
Order deny,allow
Deny from all
</Directory>
<Directory /usr/local/www/data/twiki/templates>
Options None
AllowOverride None
Order deny,allow
Deny from all
</Directory>
#
# CVSWEB
#
<Directory /usr/testbed/www/cvsweb>
Options +ExecCGI
SetHandler cgi-script
SetEnv USER "nobody"
AllowOverride None
Order allow,deny
Allow from all
</Directory>
#
# UserDir: The name of the directory that is appended onto a user's home
# directory if a ~user request is received.
......
#!/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
#
......@@ -80,7 +80,7 @@ sub Lookup($$)
if (!$query_result->numrows) {
DBQueryWarn("replace into apt_aggregate_status set ".
" urn=$safe_urn, status='down'");
" urn=$safe_urn, status='up'");
$query_result =
DBQueryWarn("select * from apt_aggregate_status ".
"where urn=$safe_urn");
......
#!/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
#
......@@ -775,6 +775,17 @@ sub GetGroup($)
return Group->Lookup($self->gid_idx());
}
#
# Map an instance to the local experiment (when its running locally)
#
sub LocalExperiment($)
{
my ($self) = @_;
require Experiment;
return Experiment->Lookup($self->slice_uuid());
}
#
# 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
......@@ -3145,9 +3156,9 @@ sub Lockdown($$$)
#
# Panic
#
sub Panic($$)
sub Panic($$$)
{
my ($self, $clear) = @_;
my ($self, $clear, $poweroff) = @_;
my $authority = $self->GetGeniAuthority();
my $slice = $self->instance()->GetGeniSlice();
my $context = APT_Geni::GeniContext();
......@@ -3165,6 +3176,8 @@ sub Panic($$)
};
$args->{"clear"} = 1
if ($clear);
$args->{"poweroff"} = 1
if ($poweroff);
my $cmurl = $authority->url();
$cmurl = devurl($cmurl) if ($usemydevtree);
......@@ -3632,5 +3645,42 @@ sub MaxExtension($$)
return $response;
}
#
# Turn on/off recovery mode for a sliver.
#
sub Recovery($$$)
{
my ($self, $sliver_urn, $clear) = @_;
my $authority = $self->GetGeniAuthority();
my $geniuser = $self->instance()->GetGeniUser();
my $slice = $self->instance()->GetGeniSlice();
my $context = APT_Geni::GeniContext();
return ContextError()
if (! (defined($geniuser) && defined($authority) &&
defined($slice) && defined($context)));
my ($slice_credential, $speaksfor_credential) =
APT_Geni::GenCredentials($slice, $geniuser, undef, 1);
return CredentialError()
if (!defined($slice_credential));
my $credentials = [$slice_credential->asString()];
if (defined($speaksfor_credential)) {
$credentials = [@$credentials, $speaksfor_credential->asString()];
}
my $args = {
"slice_urn" => $slice->urn(),
"sliver_urn" => $sliver_urn,
"credentials" => $credentials,
};
if ($clear) {
$args->{'clear'} = 1;
}
my $cmurl = $authority->url();
$cmurl = devurl($cmurl) if ($usemydevtree);
return Genixmlrpc::CallMethod($cmurl, $context, "Recovery", $args);
}
# _Always_ make sure that this 1 is at the end of the file...
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
#
......@@ -53,6 +53,7 @@ use GeniHRN;
use libtestbed;
use Project;
use Lease;
use Image;
use English;
use Data::Dumper;
use File::Basename;
......@@ -487,6 +488,8 @@ sub Create($$$$$$)
if (exists($argref->{'shared'}) && $argref->{'shared'});
$cquery .= ",topdog=1"
if (exists($argref->{'topdog'}) && $argref->{'topdog'});
$cquery .= ",project_write=1"
if (exists($argref->{'project_write'}) && $argref->{'project_write'});
# Create the main entry:
if (! DBQueryWarn("insert into apt_profiles set $cquery")) {
......@@ -649,7 +652,7 @@ sub UpdateMetaData($$)
# This is the only metadata we can update.
#
my %mods = ();
foreach my $key ("listed", "shared", "public", "topdog") {
foreach my $key ("listed", "shared", "public", "topdog", "project_write") {
if (exists($argref->{$key})) {
$mods{$key} = $argref->{$key};
}
......@@ -1473,7 +1476,7 @@ sub SetRepo($$$$$$)
#
my $owner = $geniuser->uid();
my $command = "cd /local && sudo chmod 777 . && umask 002 && ".
"rm -rf repository && ".
"sudo rm -rf repository && ".
"git clone -n '$repourl' repository && " .
"cd repository && " .
"git config --add core.sharedRepository group && ".
......
......@@ -36,7 +36,8 @@ BIN_SCRIPTS = manage_profile manage_instance manage_dataset \
manage_images rtecheck checkprofile manage_extensions \
create_slivers searchip
SBIN_SCRIPTS = apt_daemon aptevent_daemon portal_xmlrpc apt_checkup \
portal_monitor apt_scheduler portal_resources
portal_monitor apt_scheduler portal_resources \
manage_licenses
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 \
......@@ -44,7 +45,7 @@ WEB_BIN_SCRIPTS = webmanage_profile webmanage_instance webmanage_dataset \
webrspec2genilib webmanage_reservations webmanage_gitrepo \
webmanage_images webrtecheck websearchip
APACHEHOOKS = apt_gitrepo.hook
WEB_SBIN_SCRIPTS= webportal_xmlrpc
WEB_SBIN_SCRIPTS= webportal_xmlrpc webmanage_licenses
LIBEXEC_SCRIPTS = $(WEB_BIN_SCRIPTS) $(WEB_SBIN_SCRIPTS)
USERLIBEXEC = rungenilib.proxy genilib-jail genilib-iocage gitrepo.proxy
......
#!/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
#
......@@ -63,6 +63,7 @@ my $SUDO = "/usr/local/bin/sudo";
my $WGET = "/usr/local/bin/wget";
my $SLEEP_INTERVAL = 300;
my $DAILY_INTERVAL = 24 * 3600;
my $HOURLY_INTERVAL = 3600;
my $OPENSTACK_INTERVAL = 600;
# un-taint path
......@@ -571,16 +572,19 @@ sub GatherOpenstackUtilization()
}
#
# Kill off stale datasets (that were deleted at the cluster). They are
# gone, no point in keeping them around.
# Refresh/Kill datasets. Once a day we check all datasets. Hourly we
# check only expired datasets.
#
sub KillStaleDatasets()
sub RefreshDatasets($)
{
my ($doall) = @_;
my $query_result =
DBQueryWarn("select uuid,expires from apt_datasets as d ".
"where (type='stdataset' or type='ltdataset') and ".
" (UNIX_TIMESTAMP(now()) > ".
" UNIX_TIMESTAMP(expires))");
"where (type='stdataset' or type='ltdataset') ".
($doall ? "" :
" and (UNIX_TIMESTAMP(now()) > ".
" UNIX_TIMESTAMP(expires))"));
return
if (!$query_result);
......@@ -590,11 +594,18 @@ sub KillStaleDatasets()
print STDERR "No such dataset $uuid\n";
next;
}
my $pid = $dataset->pid();
my $id = $dataset->dataset_id();
my $agg = $dataset->aggregate_urn();
print STDERR "Dataset $pid/$id at $agg expired at $expires. ".
"Asking for new info ...\n";
my $pid = $dataset->pid();
my $id = $dataset->dataset_id();
my $agg = $dataset->aggregate_urn();
my $state = $dataset->state();
if ($dataset->IsExpired()) {
print STDERR "Dataset $pid/$id at $agg expired at $expires.\n";
}
if ($impotent) {
print STDERR "Would try to refresh $dataset (state:$state)\n";
next;
}
#
# Try to refresh the dataset. We might get back a new expiration,
......@@ -608,12 +619,19 @@ sub KillStaleDatasets()
#
if (!$?) {
$dataset->Refresh();
if ($dataset->IsExpired()) {
# Still expired, not sure what to do here.
print STDERR "Dataset is still expired after refresh?\n";
if (!$doall) {
if ($dataset->IsExpired()) {
# Still expired, not sure what to do here.
print STDERR "Dataset is still expired after refresh?\n";
}
else {
print STDERR "Dataset expires at ".
$dataset->expires() . "\n";
}
}
else {
print STDERR "Dataset is no longer expired after refresh.\n";
if ($state ne $dataset->state()) {
print STDERR "State changed from $state to ".
$dataset->state() . "\n";
}
next;
}
......@@ -638,32 +656,25 @@ sub KillStaleDatasets()
}
if ($oneshot) {
KillInstances();
KillStaleDatasets();
RefreshDatasets(0);
exit(0);
}
# Wait a bit before making a bunch of noise.
sleep($SLEEP_INTERVAL);
my $reportcounter = 0;
my $openstackcounter = 0;
# Do this once at startup
if (! NoLogins()) {
ReportLockdownExpired();
}
my $lastdaily = 0;
my $lasthourly = 0;
while (1) {
if (NoLogins()) {
sleep(5);
next;
}
$reportcounter += $SLEEP_INTERVAL;
$openstackcounter += $SLEEP_INTERVAL;
print "Running at ".
POSIX::strftime("20%y-%m-%d %H:%M:%S", localtime()) . "\n";
KillInstances();
KillStaleDatasets();
FixFailedImaging();
ExpireInstances();
if ($MAINSITE) {
......@@ -671,13 +682,19 @@ while (1) {
}
PushUpdates();
if ($reportcounter >= $DAILY_INTERVAL) {
if (time() - $lastdaily > $DAILY_INTERVAL) {
ReportLockdownExpired();
$reportcounter = 0;
RefreshDatasets(1);
$lastdaily = time();
}
if (time() - $lasthourly > $HOURLY_INTERVAL) {
RefreshDatasets(0);
$lasthourly = time();
}
exit(0)
if ($oneshot);
print "Waiting for $SLEEP_INTERVAL seconds ...\n";
sleep($SLEEP_INTERVAL);
}
exit(0);
......
#!/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
#
......@@ -655,8 +655,8 @@ if ($localuser) {
$gid = $group->gid();
# Hack for Kobus' class, generalize someday.
if (0 && $pid eq "CS4480-2018") {
my $termination = str2time("2018-05-02");
if (1 && $pid eq "CS4480-2019") {
my $termination = str2time("2018-03-28");
# convert to hours till then
$duration = int(($termination - time()) / 3600);
}
......@@ -885,7 +885,8 @@ foreach my $aggregate_urn (@aggregate_urns) {
}
}
if ($aptaggregate->adminonly() &&
!(defined($this_user) && $this_user->IsAdmin())) {
!(defined($this_user) &&
($this_user->IsAdmin() || $this_user->stud()))) {
$slice->Delete();
$instance->Delete();
UserError("Only administrators may use the $aggregate_name cluster.");
......
#!/usr/bin/perl -w
#
# Copyright (c) 2015 University of Utah and the Flux Group.
# Copyright (c) 2015-2019 University of Utah and the Flux Group.
#
# {{{EMULAB-LICENSE
#
......@@ -115,6 +115,11 @@ my $TBROOT = "@prefix@";
my $GENILIB = "$TBROOT/lib/geni-lib/";
my $debug = 0;
# Watch for this being defined in the calling environment and use that.
if (exists($ENV{"PYTHONPATH"})) {
$GENILIB = $ENV{"PYTHONPATH"};
}
#
# Turn off line buffering on output
#
......
#!/usr/bin/perl -w
#
# Copyright (c) 2015-2017 University of Utah and the Flux Group.
# Copyright (c) 2015-2019 University of Utah and the Flux Group.
#
# {{{EMULAB-LICENSE
#
......@@ -111,6 +111,11 @@ my $TBROOT = "@prefix@";
my $GENILIB = "$TBROOT/lib/geni-lib/";
my $debug = 0;
# Watch for this being defined in the calling environment and use that.
if (exists($ENV{"PYTHONPATH"})) {
$GENILIB = $ENV{"PYTHONPATH"};
}
#
# Turn off line buffering on output
#
......
......@@ -279,8 +279,8 @@ sub DoCreate()
if ($size < 0) {
fatal("Could not parse size.");
}
if ($size <= 5) {
fatal("Size too small; minimum is 5MiB");
if ($size <= 4.5) {
UserError("Size too small; minimum is 5MB");
}
}
else {
......
#!/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
#
......@@ -44,6 +44,7 @@ sub usage()
print("Usage: manage_instance refresh instance\n");
print("Usage: manage_instance reboot instance node_id ...\n");
print("Usage: manage_instance reload instance node_id ...\n");
print("Usage: manage_instance recovery instance [-c] node_id\n");
print("Usage: manage_instance deletenodes instance node_id ...\n");
print("Usage: manage_instance monitor instance\n");
print("Usage: manage_instance lockdown instance set|clear user|admin\n");
......@@ -132,6 +133,7 @@ sub DoDenyOrMoreInfo($);
sub DoRefresh();
sub DoReboot();
sub DoReload();
sub DoRecovery();
sub DoLockdown();
sub DoPanic();
sub DoManifests();
......@@ -151,6 +153,7 @@ sub StartMonitor();
sub StartMonitorInternal(;$);
sub DoImageTrackerStuff($$$$$$$);
sub DoWarn();
sub DoDelete();
sub DenyExtensionInternal($);
sub ExtendInternal($$$$$);
sub CallMethodOnAggregates($$$@);
......@@ -244,6 +247,9 @@ elsif ($action eq "reboot") {
elsif ($action eq "reload") {
DoReload()
}
elsif ($action eq "recovery") {
DoRecovery()
}
elsif ($action eq "monitor") {
StartMonitor()
}
......@@ -286,6 +292,9 @@ elsif ($action eq "checkautoapprove") {
elsif ($action eq "applyextensionpolicy") {
DoApplyExtensionPolicy()
}
elsif ($action eq "delete") {
DoDelete()
}
else {
usage();
}
......@@ -443,7 +452,9 @@ sub DoSnapshot()
fatal("Could not parse manifest for $agg");
}
foreach my $ref (GeniXML::FindNodes("n:node",
$manifest)->get_nodelist()) {
$manifest)->get_nodelist(),
GeniXML::FindNodesNS("n:vhost", $manifest,
$GeniXML::EMULAB_NS)->get_nodelist()) {
$nodecount++;
my $client_id = GeniXML::GetVirtualId($ref);
......@@ -1423,22 +1434,29 @@ sub DoTerminate()
}
#
# Delete Do not use this!
# Delete. Do not use this unless you know what you are doing! It is
# for killing off instances that got into whacked out state cause of
# earlier errors or boss crashing, etc.
#
sub DoDelete()
{
my $expired = $RECORDHISTORY_TERMINATED;
my $force = 0;
if (@ARGV) {
my $arg = shift(@ARGV);
if ($arg eq "-e") {
$expired = $RECORDHISTORY_EXPIRED;
}
else {
usage();
}
my $optlist = "Fe";
my %options = ();
if (! getopts($optlist, \%options)) {
usage();
}
if (defined($options{"F"})) {
$force = 1;
}
if (defined($options{"e"})) {
$expired = $RECORDHISTORY_EXPIRED;
}
if (!$force) {
fatal("Refusing to do this, use the -F option if you really mean it");
}
my $slice = $instance->GetGeniSlice();
if (!defined($slice)) {
#
......@@ -2524,6 +2542,90 @@ sub DoRebootOrReload($)
sub DoReboot() { return DoRebootOrReload("reboot"); }
sub DoReload() { return DoRebootOrReload("reload"); }
#
# Recovery mode.
#
sub DoRecovery()
{
my ($errmsg, $exitcode, $errcode);
my $clear = 0;
my $optlist = "c";
my %options = ();
if (! getopts($optlist, \%options)) {
usage();
}
if (defined($options{"c"})) {
$clear = 1;
}
usage()
if (!@ARGV);
my $node_id = shift(@ARGV);
#
# Sanity check to make sure the node is really in the rspec, since
# we need its sliver urn.
#
my $sliver_urn;
my $sliver;
foreach my $obj ($instance->AggregateList()) {
my $manifest = GeniXML::Parse($obj->manifest());
if (! defined($manifest)) {
fatal("Could not parse manifest for $obj");
}
my @nodes = (GeniXML::FindNodes("n:node", $manifest)->get_nodelist(),
GeniXML::FindNodesNS("n:vhost", $manifest,
$GeniXML::EMULAB_NS)->get_nodelist());
foreach my $node (@nodes) {
my $client_id = GeniXML::GetVirtualId($node);
my $urn = GeniXML::GetSliverId($node);
my $manager_urn = GetManagerId($node);
# No sliver urn or a different aggregate.
next
if (! (defined($urn) &&
defined($manager_urn) &&
$manager_urn eq $obj->aggregate_urn()));
if ($node_id eq $client_id) {
$sliver_urn = $urn;
$sliver = $obj;
}
}
}
if (!defined($sliver_urn)) {
fatal("Could not find node '$node_id' in manifest");
}
if ($sliver->GetAptAggregate()->CheckStatus(\$errmsg)) {
print STDERR "$errmsg\n";
if (defined($webtask)) {
$webtask->output($errmsg);
$webtask->Exited(GENIRESPONSE_SERVER_UNAVAILABLE);
}
exit(1);
}
my $response = $sliver->Recovery($sliver_urn, $clear);
if ($response->code() != GENIRESPONSE_SUCCESS) {
$errcode = $response->code();
($exitcode,$errmsg) = ResponseErrorMessage($sliver, $response);
# Important to tell web user about this
if ($response->code() == GENIRESPONSE_FORBIDDEN) {
$exitcode = 1;
}
goto bad;
}
exit(0);
bad:
print STDERR "$errmsg\n";
if (defined($errmsg) && defined($webtask)) {
$webtask->Exited($errcode);
$webtask->output($errmsg);
}
exit($exitcode);
}
#
#
#
......@@ -3157,10 +3259,12 @@ sub DoPanic()
my $errmsg;
my $errcode = -1;
my $exitcode = -1;
my $takelock = 0;
my $response;
my $optlist = "L";
my $optlist = "Lp";
my $takelock = 0;
my $poweroff = 0;
my %options = ();
if (! getopts($optlist, \%options)) {
usage();
......@@ -3168,6 +3272,9 @@ sub DoPanic()
if (defined($options{"L"})) {
$takelock = 1;
}
if (defined($options{"p"})) {
$poweroff = 1;
}
usage()
if (@ARGV != 1);
......@@ -3191,6 +3298,22 @@ sub DoPanic()
$exitcode = 1;
goto bad;
}
# Check the panic flag after locking, in case someone beat us to it.
$instance->Refresh();
if ($setclr eq "set") {
if ($instance->paniced()) {
print "Already in a panic!\n";
$slice->UnLock();
exit(0);
}
}
else {
if (!$instance->paniced()) {
print "No longer in a panic!\n";
$slice->UnLock();
exit(0);
}
}
#
# No panic at stitching aggregates, so look to see if we cross any.
......@@ -3214,7 +3337,7 @@ sub DoPanic()
my $coderef = sub {
my ($sliver) = @_;
return $sliver->Panic(($setclr eq "clear" ? 1 : 0));
return $sliver->Panic(($setclr eq "clear" ? 1 : 0), $poweroff);
};
# Invoke on all clusters
......@@ -3555,7 +3678,7 @@ sub DoUpdateKeys()
};
# Invoke on all clusters
$errcode = CallMethodOnAggregates($coderef, 10, \$response, @aggregates);
$errcode = CallMethodOnAggregates($coderef, 1, \$response, @aggregates);
if ($errcode) {
$errmsg = $response;
goto bad;
......@@ -3651,7 +3774,7 @@ sub DoUtilization()
}
# Invoke on all clusters
$errcode = CallMethodOnAggregates("Utilization", 2,
$errcode = CallMethodOnAggregates("Utilization", 1,
\$response, @aggregates);
if ($errcode) {
$errmsg = $response;
......@@ -3667,7 +3790,13 @@ sub DoUtilization()
if ($code != GENIRESPONSE_SUCCESS) {
$errcode = $code;
($exitcode, $errmsg) = ResponseErrorMessage($agg, $response);
if ($code == GENIRESPONSE_REFUSED) {
$exitcode = 1;
$errmsg = $response->error();
}
else {
($exitcode, $errmsg) = ResponseErrorMessage($agg, $response);
}
next;
}
my $blob = $response->value();
......@@ -3849,7 +3978,13 @@ sub DoIdleData()
if ($code != GENIRESPONSE_SUCCESS) {
$errcode = $code;
($exitcode, $errmsg) = ResponseErrorMessage($agg, $response);
if ($code == GENIRESPONSE_REFUSED) {
$exitcode = 1;
$errmsg = $response->error();
}
else {
($exitcode, $errmsg) = ResponseErrorMessage($agg, $response);
}
next;
}
}
......@@ -4356,6 +4491,7 @@ sub DoWarn()
my $freeze = 0;
my $terminate = 0;
my $panic = 0;
my $poweroff = 0;
my $errmsg;
my $reason;
my $logfile;
......@@ -4368,7 +4504,7 @@ sub DoWarn()
my $slice_uuid = $slice->uuid();
my $weburl = $instance->webURL();
my $optlist = "f:FTQ";
my $optlist = "f:FTQP";
my %options = ();
if (! getopts($optlist, \%options)) {
usage();
......@@ -4381,6 +4517,9 @@ sub DoWarn()
}
elsif (defined($options{"Q"})) {
$panic = 1;
if (defined($options{"P"})) {
$poweroff = 1;
}
}
if (defined($options{"f"})) {
my $filename = $options{"f"};
......@@ -4465,8 +4604,10 @@ sub DoWarn()
# No free time.
$instance->Update({"extension_disabled" => 1});
# Expiration is now.
$slice->SetExpiration(time());
# Expiration is now, if terminating.
if ($terminate) {
$slice->SetExpiration(time());
}
# Now we can clear this.
if ($instance->user_lockdown()) {
......@@ -4501,7 +4642,7 @@ sub DoWarn()
# We pass the lock through.
system("$MANAGEINSTANCE " .
(defined($webtask) ? "-t $webtask_id " : "").
" -d -- panic $uuid -L set");
" -d -- panic $uuid -L " . ($poweroff ? "-p " : "") . "set");
}
else {
# We pass the lock through.
......@@ -4782,7 +4923,7 @@ sub CallMethodOnAggregates($$$@)
"$sliver");
last;
}
print Dumper($response);
#print Dumper($response);
# We can keep trying for these, but not an RPC error.
last
......
This diff is collapsed.
#!/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
#
......@@ -58,6 +58,8 @@ my %modifiers = ();
my $rspec;
my $script;
my $project;
# Temporary testing.
my $usenewgenilib = 0;
#
# Configure variables
......@@ -92,6 +94,7 @@ use libEmulab;
use libtestbed;
use User;
use Project;
use Group;
use APT_Profile;
use APT_Instance;
use APT_Aggregate;
......@@ -115,6 +118,7 @@ sub ListImages();
sub GetScriptParameters($$);
sub VerifyXML($$);
sub ModifyProfileInternal($$$);
sub UseNewGenilib($);
# The web interface (and in the future the xmlrpc interface) sets this.
my $this_user = User->ImpliedUser();
......@@ -174,6 +178,7 @@ my %xmlfields =
"profile_listed" => ["listed", $SLOT_OPTIONAL|$SLOT_UPDATE],
"profile_public" => ["public", $SLOT_OPTIONAL|$SLOT_UPDATE],
"profile_shared" => ["shared", $SLOT_OPTIONAL|$SLOT_UPDATE],
"profile_project_write"=>["project_write", $SLOT_OPTIONAL|$SLOT_UPDATE],
"profile_topdog" => ["topdog", $SLOT_OPTIONAL|
$SLOT_UPDATE|$SLOT_ADMINONLY],
"profile_disabled" => ["disabled", $SLOT_OPTIONAL|
......@@ -275,6 +280,8 @@ sub CreateProfile()
elsif (!$project->AccessCheck($this_user, TB_PROJECT_MAKEIMAGEID())) {
UserError({"profile_pid" => "Not enough permission in this project"});
}
$usenewgenilib = UseNewGenilib($project);
# Check datasets.
if (defined($rspec)) {
my $errmsg = "Bad dataset";
......@@ -617,6 +624,10 @@ sub ModifyProfile()
if (!defined($profile)) {
fatal("Could not lookup profile for update $uuid");
}
my $creator = User->Lookup($profile->creator_idx());
if (!defined($creator)) {
fatal("Could not lookup creator for $profile");
}
# This will exit if there are any errors.
VerifyXML($xmlfile, 1);
......@@ -629,8 +640,28 @@ sub ModifyProfile()
if (!defined($project)) {
UserError({"profile_pid" => "No such project exists"});
}
elsif (!$project->AccessCheck($this_user, TB_PROJECT_MAKEIMAGEID())) {
UserError({"profile_pid" => "Not enough permission in this project"});
#
# Project leader can always update profiles in the project. Other
# members can update the profile when the project_write bit has been
# set.
#
if (! ($this_user->IsAdmin() ||
$this_user->SameUser($creator) ||
$project->IsLeader($this_user) ||
$profile->project_write())) {
UserError({"profile_pid" =>
"Not enough permission to modify profile"});
}
#
# Slightly different test when changing the project_write bit.
#
if (exists($update_args{"project_write"}) &&
$update_args{"project_write"} != $profile->project_write() &&
!($this_user->IsAdmin() ||
$this_user->SameUser($creator) ||
$project->IsLeader($this_user))) {
UserError({"profile_pid" =>
"Not enough permission change project write flag"});
}
if ($profile->Lock()) {
UserError("Profile is busy, cannot lock it.");
......@@ -653,6 +684,7 @@ sub ModifyProfileInternal($$$)
my ($profile, $project, $pmsg) = @_;
my %errors = ();
my $fromrepo = 0;
$usenewgenilib = UseNewGenilib($project);
# Check datasets.
if (defined($rspec)) {
......@@ -915,6 +947,7 @@ sub UpdateProfileFromRepo()
print STDERR "Profile is busy, cannot lock it.\n";
exit(1);
}
$usenewgenilib = UseNewGenilib($project);
#
# We want to update the profile from its URL, and get back the
......@@ -944,8 +977,9 @@ sub UpdateProfileFromRepo()
$profile->Unlock();
fatal("Could not open temporary file for script");
}
my $opts = ($usenewgenilib ? "-N" : "");
print $fh $script;
$output = emutil::ExecQuiet("$RUNGENILIB $filename");
$output = emutil::ExecQuiet("$RUNGENILIB $opts $filename");
if ($?) {
print STDERR $output;
$profile->Unlock();
......@@ -1001,9 +1035,10 @@ sub GetScriptParameters($$)
$$pref = "Could not open temporary file for script";
return -1;
}
my $opts = ($usenewgenilib ? "-N" : "");
print $fh $script;
my $output = emutil::ExecQuiet("$RUNGENILIB -p $filename");
my $output = emutil::ExecQuiet("$RUNGENILIB $opts -p $filename");
if ($?) {
$$pref = $output;
return $? >> 8;
......@@ -1629,3 +1664,16 @@ sub CanDelete($$)
if ($user->SameUser($project->GetLeader()));