All new accounts created on Gitlab now require administrator approval. If you invite any collaborators, please let Flux staff know so they can approve the accounts.

Commit 462035f1 authored by Leigh B. Stoller's avatar Leigh B. Stoller

A round of clean up.

parent 726fac05
...@@ -2344,16 +2344,55 @@ sub LocalNodeListNames($$) ...@@ -2344,16 +2344,55 @@ sub LocalNodeListNames($$)
return 0; return 0;
} }
#
# Return list of experiment nodes in the old reserved experiment.
#
sub OldReservedNodeList($$)
{
my ($self, $plist) = @_;
# Must be a real reference.
return -1
if (! ref($self));
@$plist = ();
my @result = ();
my $exptidx = $self->idx();
my $oldreserved_pid = OLDRESERVED_PID;
my $oldreserved_eid = OLDRESERVED_EID;
my $query_result =
DBQueryWarn("select r.node_id from reserved as r ".
"left join nodes as n on n.node_id=r.node_id ".
"where r.pid='$oldreserved_pid' and ".
" r.eid='$oldreserved_eid' and ".
" r.old_exptidx='$exptidx'");
return -1
if (!$query_result);
while (my ($nodeid) = $query_result->fetchrow_array()) {
my $node = Node->Lookup($nodeid);
if (!defined($node)) {
print STDERR "*** Could not map $nodeid to its object\n";
return -1;
}
push(@result, $node);
}
@$plist = @result;
return 0;
}
# #
# Return list of experiment nodes (objects or just names) # Return list of experiment nodes (objects or just names)
# #
sub NodeList($;$) sub NodeList($;$$)
{ {
my ($self, $namesonly) = @_; my ($self, $namesonly, $includevirtual) = @_;
my @nodenames = (); my @nodenames = ();
# Must be a real reference. # Must be a real reference.
return -1 return undef
if (! ref($self)); if (! ref($self));
my $pid = $self->pid(); my $pid = $self->pid();
...@@ -2373,6 +2412,14 @@ sub NodeList($;$) ...@@ -2373,6 +2412,14 @@ sub NodeList($;$)
return undef; return undef;
} }
push(@nodes, $node); push(@nodes, $node);
if (defined($includevirtual) && $includevirtual) {
my @virtuals = ();
if ($node->VirtualNodes(\@virtuals) != 0) {
print STDERR "*** Could not get virtual node list for $node\n";
}
push(@nodes, @virtuals)
if (@virtuals);
}
} }
return @nodes; return @nodes;
} }
......
This diff is collapsed.
...@@ -138,6 +138,7 @@ sub field($$) { return ((! ref($_[0])) ? -1 : $_[0]->{'USER'}->{$_[1]}); } ...@@ -138,6 +138,7 @@ sub field($$) { return ((! ref($_[0])) ? -1 : $_[0]->{'USER'}->{$_[1]}); }
sub uid_idx($) { return field($_[0], "uid_idx"); } sub uid_idx($) { return field($_[0], "uid_idx"); }
sub dbid($) { return field($_[0], "uid_idx"); } sub dbid($) { return field($_[0], "uid_idx"); }
sub uid($) { return field($_[0], "uid"); } sub uid($) { return field($_[0], "uid"); }
sub uuid($) { return field($_[0], "uid_uuid"); }
sub created($) { return field($_[0], "usr_created"); } sub created($) { return field($_[0], "usr_created"); }
sub expires($) { return field($_[0], "usr_expires"); } sub expires($) { return field($_[0], "usr_expires"); }
sub modified($) { return field($_[0], "usr_modified"); } sub modified($) { return field($_[0], "usr_modified"); }
...@@ -1284,6 +1285,37 @@ sub GList($$) ...@@ -1284,6 +1285,37 @@ sub GList($$)
return $glist; return $glist;
} }
#
# Return a list of the additional Unix groups a user is in. These are
# returned as plain integers.
#
sub UnixGroupList($$)
{
my ($self, $prval) = @_;
# Must be a real reference.
return -1
if (! ref($self));
my $user_uid = $self->uid();
my @glist = ();
@$prval = ();
my $query_result =
DBQueryWarn("select gid from unixgroup_membership ".
"where uid='$user_uid'");
return -1
if (!defined($query_result));
return 0
if (!$query_result->numrows);
while (my ($gid) = $query_result->fetchrow_array()) {
push(@glist, $gid)
}
@$prval = @glist;
return 0;
}
# #
# Flip to user, with the provided group as the default. # Flip to user, with the provided group as the default.
# #
......
...@@ -158,15 +158,15 @@ use vars qw(@ISA @EXPORT); ...@@ -158,15 +158,15 @@ use vars qw(@ISA @EXPORT);
TBAdmin TBOpsGuy TBProjAccessCheck TBNodeAccessCheck TBAdmin TBOpsGuy TBProjAccessCheck TBNodeAccessCheck
TBExptAccessCheck MarkNodeDown TBExptAccessCheck MarkNodeDown
SetNodeBootStatus OSFeatureSupported NodeidToExp NodeidToExpOldReserved SetNodeBootStatus OSFeatureSupported NodeidToExp
UserDBInfo DBQuery DBQueryFatal DBQueryWarn DBWarn DBFatal DBErr DBQuery DBQueryFatal DBQueryWarn DBWarn DBFatal DBErr
NewTBDBHandle DBQueryN DBQueryFatalN DBQueryWarnN DBErrN NewTBDBHandle DBQueryN DBQueryFatalN DBQueryWarnN DBErrN
DBQuoteSpecial ExpState DBQuoteSpecial ExpState
ExpNodes ExpNodeVnames ExpNodesOldReserved ExpNodes ExpNodeVnames ExpNodesOldReserved
DBDateTime DefaultImageID TBGroupUnixInfo DBDateTime DefaultImageID
TBValidNodeName TBSetNodeLogEntry TBSetNodeLogEntry
TBSetSchedReload MapNodeOSID MapNodeOSID
TBUnixGroupList TBOSID TBOSMaxConcurrent TBOSCountInstances TBOSID TBOSMaxConcurrent TBOSCountInstances
TBResolveNextOSID TBOsidToPid TBOSIDRebootWaittime TBResolveNextOSID TBOsidToPid TBOSIDRebootWaittime
TBOSLoadMaxOkay TBImageLoadMaxOkay TBImageID TBOSLoadMaxOkay TBImageLoadMaxOkay TBImageID
TBdbfork TBDBDisconnect VnameToNodeid TBdbfork TBDBDisconnect VnameToNodeid
...@@ -177,7 +177,7 @@ use vars qw(@ISA @EXPORT); ...@@ -177,7 +177,7 @@ use vars qw(@ISA @EXPORT);
TBSaveExpLogFiles TBExptWorkDir TBExptUserDir TBExptLogDir TBSaveExpLogFiles TBExptWorkDir TBExptUserDir TBExptLogDir
TBIPtoNodeID TBNodeBootReset TBNodeStateWait TBIPtoNodeID TBNodeBootReset TBNodeStateWait
TBExptSetSwapUID TBExptSetThumbNail TBExptSetSwapUID TBExptSetThumbNail
TBNodeAllocCheck TBPlabNodeUsername MarkPhysNodeDown TBPlabNodeUsername MarkPhysNodeDown
TBExptIsElabInElab TBExptIsPlabInElab TBExptIsElabInElab TBExptIsPlabInElab
TBExptPlabInElabPLC TBExptPlabInElabNodes TBExptPlabInElabPLC TBExptPlabInElabNodes
TBBatchUnLockExp TBExptIsBatchExp TBBatchUnLockExp TBExptIsBatchExp
...@@ -1056,59 +1056,6 @@ sub TBNodeAccessCheck($$@) ...@@ -1056,59 +1056,6 @@ sub TBNodeAccessCheck($$@)
return 1; return 1;
} }
#
# Determine if a node can be allocated to a project.
#
# Usage: TBNodeAllocCheck($pid, $node_id)
# returns 0 if not allowed or error.
# returns 1 if allowed.
#
sub TBNodeAllocCheck($$)
{
my ($pid, $node_id) = @_;
#
# Admins do whatever they want!
#
if (TBAdmin()) {
return 1;
}
#
# Hmm. The point of this join is to find rows in the permissions table
# with the corresponding type of the node. If no rows come back, its
# a non-existent node! If the values are NULL, then there are no rows
# with that type/class, and thus the type/class is free to be allocated
# by anyone. Otherwise we get the list of projects that are allowed,
# and so we have to look at those.
#
my $query_result =
DBQueryFatal("select distinct p.* from nodes as n ".
"left join node_types as nt on n.type=nt.type ".
"left join nodetypeXpid_permissions as p on ".
" (p.type=nt.type or p.type=nt.class) ".
"where node_id='$node_id'");
if (!$query_result->numrows) {
print STDERR "TBNodeAllocCheck: No such node $node_id!\n";
return 0;
}
my ($ptype,$ppid) = $query_result->fetchrow_array();
# No rows, or a pid match.
if (!defined($ptype) || $ppid eq $pid) {
return 1;
}
# Okay, must be rows in the permissions table. Check each pid for a match.
while (my ($ptype,$ppid) = $query_result->fetchrow_array()) {
if ($ppid eq $pid) {
return 1;
}
}
return 0;
}
# #
# Return Experiment state. # Return Experiment state.
# #
...@@ -1200,52 +1147,6 @@ sub TBGetCancelFlag($$$) ...@@ -1200,52 +1147,6 @@ sub TBGetCancelFlag($$$)
return 1; return 1;
} }
#
# Return a list of all the nodes in an experiment
# that were moved to OLDRESERVED_PID/OLDRESERVED_EID
# holding reservation
#
# usage: ExpNodesOldReserved(char *pid, char *eid)
# returns the list if a valid pid/eid.
# returns 0 if an invalid pid/eid or if an error.
#
sub ExpNodesOldReserved($$)
{
my($pid, $eid) = @_;
my(@row);
my(@nodes);
my $oldreserved_pid = OLDRESERVED_PID;
my $oldreserved_eid = OLDRESERVED_EID;
my $query_result =
DBQueryWarn("select r.node_id from reserved as r ".
"left join nodes as n on n.node_id=r.node_id ".
"where (r.pid='$oldreserved_pid' and r.old_pid='$pid') ".
"and (r.pid='$oldreserved_eid' and r.old_eid='$eid') ");
if (! $query_result or
$query_result->numrows == 0) {
return ();
}
while (@row = $query_result->fetchrow_array()) {
my $node = $row[0];
#
# Taint check. I do not understand this sillyness, but if I
# taint check these node names, I avoid warnings throughout.
#
if ($node =~ /^([-\w]+)$/) {
$node = $1;
push(@nodes, $node);
}
else {
print "*** $0: WARNING: Bad node name: $node.\n";
}
}
return @nodes;
}
# #
# Return a list of all the nodes in an experiment. # Return a list of all the nodes in an experiment.
# #
...@@ -1474,34 +1375,6 @@ sub TBBootWhat($;$) ...@@ -1474,34 +1375,6 @@ sub TBBootWhat($;$)
return undef; return undef;
} }
#
# Map nodeid to its pid/eid in the oldreserved holding reservation
#
# usage: NodeidToExpOldReserved(char *nodeid, \$pid, \$eid, \$vname)
# returns 1 if the node is reserved.
# returns 0 if the node is not reserved.
#
sub NodeidToExpOldReserved ($$$) {
my($nodeid, $pid, $eid) = @_;
my $oldreserved_pid = OLDRESERVED_PID;
my $oldreserved_eid = OLDRESERVED_EID;
my $query_result =
DBQueryWarn("select old_pid,old_eid from reserved ".
"where node_id='$nodeid' and pid='$oldreserved_pid' ".
"and eid='$oldreserved_eid'");
if (! $query_result ||
! $query_result->num_rows) {
return 0;
}
my @row = $query_result->fetchrow_array();
$$pid = $row[0];
$$eid = $row[1];
return 1;
}
# #
# Map nodeid to its pid/eid/vname. vname is optional. # Map nodeid to its pid/eid/vname. vname is optional.
# #
...@@ -1882,75 +1755,6 @@ sub TBImageLoadMaxOkay($$;@) ...@@ -1882,75 +1755,6 @@ sub TBImageLoadMaxOkay($$;@)
return 1; return 1;
} }
#
# Map login (db uid) to a user_name and user_email.
#
# usage: UserDBInfo(char *dbuid, \$name, \$email)
# returns 1 if the UID is okay.
# returns 0 if the UID is bogus.
#
sub UserDBInfo($$$)
{
my ($dbuid, $username, $useremail) = @_;
my $target_user = User->Lookup($dbuid);
return 0
if (! defined($target_user));
$$username = $target_user->name();
$$useremail = $target_user->email();
return 1;
}
#
# Map pid,gid to its unix_gid and unix_name.
#
# usage: TBGroupUnixInfo(char $pid, char *gid, \$unix_gid, \$unix_name)
# returns 1 if okay.
# returns 0 if bogus.
#
sub TBGroupUnixInfo ($$$$) {
my($pid, $gid, $unix_gid, $unix_name) = @_;
my $query_result =
DBQueryFatal("select unix_gid,unix_name from groups ".
"where pid='$pid' and gid='$gid'");
if ($query_result->num_rows < 1) {
return 0;
}
my @row = $query_result->fetchrow_array();
$$unix_gid = $row[0];
$$unix_name = $row[1];
return 1;
}
#
# Return a list of the additional Unix groups a user is in.
#
# usage: TBUnixGroupList(char $dbuid)
# returns list if there is one.
# returns () if failed or no list.
#
sub TBUnixGroupList ($) {
my($dbuid) = @_;
my @glist = ();
my $query_result =
DBQueryFatal("select gid from unixgroup_membership ".
"where uid='$dbuid'");
if ($query_result->num_rows == 0) {
return ();
}
while (my @row = $query_result->fetchrow_array()) {
push(@glist, $row[0]);
}
return @glist;
}
# #
# Insert a Log entry for a node. # Insert a Log entry for a node.
# #
...@@ -1970,50 +1774,6 @@ sub TBSetNodeLogEntry($$$$) ...@@ -1970,50 +1774,6 @@ sub TBSetNodeLogEntry($$$$)
$type, $message) == 0 ? 1 : 0); $type, $message) == 0 ? 1 : 0);
} }
#
# Validate a node name.
#
# usage: TBValidNodeName(char *name)
# Returns 1 if the node is valid.
# Returns 0 if not.
#
sub TBValidNodeName($)
{
my($node) = @_;
my $query_result =
DBQueryWarn("select node_id from nodes where node_id='$node'");
if ($query_result->numrows == 0) {
return 0;
}
return 1;
}
#
# Set the scheduled_reloads for a node. Type is optional and defaults to
# testbed default load type. See above.
#
# usage: TBSetSchedReload(char *node, char *imageid, [char *reload_type])
# Returns 1 if okay.
# Returns 0 if failed.
#
sub TBSetSchedReload($$;$)
{
my ($node, $imageid, $type) = @_;
if (!defined($type)) {
$type = TB_DEFAULT_RELOADTYPE;
}
if (DBQueryWarn("replace into scheduled_reloads ".
"(node_id, image_id, reload_type) values ".
"('$node', '$imageid', '$type')")) {
return 1;
}
return 0;
}
# #
# Set event state for a node. # Set event state for a node.
# #
......
...@@ -4,6 +4,7 @@ ...@@ -4,6 +4,7 @@
# Copyright (c) 2000-2005, 2007 University of Utah and the Flux Group. # Copyright (c) 2000-2005, 2007 University of Utah and the Flux Group.
# All rights reserved. # All rights reserved.
# #
use strict;
use English; use English;
use Getopt::Std; use Getopt::Std;
...@@ -16,9 +17,9 @@ use Getopt::Std; ...@@ -16,9 +17,9 @@ use Getopt::Std;
# #
sub usage() sub usage()
{ {
print("Usage: nalloc [-v] [-p] <pid> <eid> <node> <node> <...>\n". print("Usage: nalloc [-d] [-p] <pid> <eid> <node> <node> <...>\n".
" -p enables partial allocation mode\n". " -p enables partial allocation mode\n".
" -v enables debugging output\n"); " -d enables debugging output\n");
exit(-1); exit(-1);
} }
my $optlist = "dp"; my $optlist = "dp";
...@@ -38,6 +39,10 @@ my $exportsetup = "$TB/sbin/exports_setup"; ...@@ -38,6 +39,10 @@ my $exportsetup = "$TB/sbin/exports_setup";
use lib '@prefix@/lib'; use lib '@prefix@/lib';
use libdb; use libdb;
use libtestbed; use libtestbed;
use Experiment;
use Project;
use User;
use Node;
# #
# Turn off line buffering on output # Turn off line buffering on output
...@@ -51,7 +56,8 @@ $| = 1; ...@@ -51,7 +56,8 @@ $| = 1;
# Parse command arguments. Once we return from getopts, all that should be # Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments. # left are the required arguments.
# #
%options = (); my %options = ();
if (! getopts($optlist, \%options)) { if (! getopts($optlist, \%options)) {
usage(); usage();
} }
...@@ -73,39 +79,40 @@ my @node_names = @ARGV; ...@@ -73,39 +79,40 @@ my @node_names = @ARGV;
# #
my $error = 0; my $error = 0;
my $noalloc = 0; my $noalloc = 0;
my @newvals = ();
my @oldnodes = (); my @oldnodes = ();
my @nodes = (); my @nodes = ();
my @need_consetup = 0; my $need_consetup = 0;
my @need_history = (); my @need_history = ();
my @need_clearbl = (); my @need_clearbl = ();
TBDebugTimeStamp("nalloc started"); TBDebugTimeStamp("nalloc started");
# #
# Experiment must exist. # Experiment must exist.
# #
if (!ExpState($pid,$eid)) { my $experiment = Experiment->Lookup($pid, $eid);
warn "There is no experiment $eid in project $pid\n"; if (! $experiment) {
exit -1; die("*** $0:\n".
" No such experiment $pid/$eid in the Emulab Database.\n");
} }
TBDebugTimeStamp("nalloc checked exp state"); my $exptidx = $experiment->idx();
my $project = $experiment->GetProject();
if (!defined($project)) {
die("*** $0:\n".
" Could not get project for experiment $experiment!\n");
}
# #
# User must have permission to modify the experiment. # User must have permission to modify the experiment.
# #
if ($UID) { my $this_user = User->ThisUser();
if (!TBExptAccessCheck($UID, $pid, $eid, TB_EXPT_MODIFY)) { if (! defined($this_user)) {
warn("*** You do not have permission to allocate nodes in ". die("*** $0:\n".
"$pid/$eid!\n"); " You ($UID) do not exist in the Emulab DB!\n");
exit -1;
}
} }
TBDebugTimeStamp("nalloc checked exp permission"); if (!$experiment->AccessCheck($this_user, TB_EXPT_MODIFY)) {
die("*** $0:\n".
my $exptidx; " You do not have permission to allocate nodes in $pid/$eid\n");
if (!TBExptIDX($pid, $eid, \$exptidx)) {
print "*** WARNING: No such experiment $pid/$eid!\n";
exit -1;
} }
# #
...@@ -113,18 +120,15 @@ if (!TBExptIDX($pid, $eid, \$exptidx)) { ...@@ -113,18 +120,15 @@ if (!TBExptIDX($pid, $eid, \$exptidx)) {
# is allowed to allocate the nodes, by type/class, plus other checks. # is allowed to allocate the nodes, by type/class, plus other checks.
# #
foreach my $n (@node_names) { foreach my $n (@node_names) {
# Make sure a valid node name first! my $node = Node->Lookup($n);
if (! TBValidNodeName($n)) { if (!defined($node)) {
warn("*** $0:\n". die("*** $0:\n".
" No such node $n!\n"); " No such node $n!\n");
exit -1;
} }
# Project allowed to allocate this node type/class?
# Project allowed to allocated this node type/class? if (!$this_user->IsAdmin() && !$node->AllocCheck($project)) {
if (! TBNodeAllocCheck($pid, $n)) { die("*** $0:\n".
warn("*** $0:\n". " You are not allowed to allocate $n to project $pid!\n");
" You are not allowed to allocate $n to project $pid!\n");
exit -1;
} }
# XXX # XXX
...@@ -132,15 +136,12 @@ foreach my $n (@node_names) { ...@@ -132,15 +136,12 @@ foreach my $n (@node_names) {
# console_setup. We want to avoid calling console_setup if all we # console_setup. We want to avoid calling console_setup if all we
# got is a zillion virtual nodes on the command line; wasted work. # got is a zillion virtual nodes on the command line; wasted work.
# #
my $tiplines_result = my $tipserver;
DBQueryFatal("select tipname,server from tiplines ". if ($node->TipServer(\$tipserver) == 0 && defined($tipserver)) {
"where node_id='$n'");
if ($tiplines_result->numrows) {
$need_consetup++; $need_consetup++;
} }
} }
TBDebugTimeStamp("nalloc checked node permission "); TBDebugTimeStamp("nalloc checked all node permissions");
# Must lock this table!