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

A round of clean up.

parent 726fac05
......@@ -2344,16 +2344,55 @@ sub LocalNodeListNames($$)
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)
#
sub NodeList($;$)
sub NodeList($;$$)
{
my ($self, $namesonly) = @_;
my ($self, $namesonly, $includevirtual) = @_;
my @nodenames = ();
# Must be a real reference.
return -1
return undef
if (! ref($self));
my $pid = $self->pid();
......@@ -2373,6 +2412,14 @@ sub NodeList($;$)
return undef;
}
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;
}
......
This diff is collapsed.
......@@ -138,6 +138,7 @@ sub field($$) { return ((! ref($_[0])) ? -1 : $_[0]->{'USER'}->{$_[1]}); }
sub uid_idx($) { return field($_[0], "uid_idx"); }
sub dbid($) { return field($_[0], "uid_idx"); }
sub uid($) { return field($_[0], "uid"); }
sub uuid($) { return field($_[0], "uid_uuid"); }
sub created($) { return field($_[0], "usr_created"); }
sub expires($) { return field($_[0], "usr_expires"); }
sub modified($) { return field($_[0], "usr_modified"); }
......@@ -1284,6 +1285,37 @@ sub 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.
#
......
......@@ -158,15 +158,15 @@ use vars qw(@ISA @EXPORT);
TBAdmin TBOpsGuy TBProjAccessCheck TBNodeAccessCheck
TBExptAccessCheck MarkNodeDown
SetNodeBootStatus OSFeatureSupported NodeidToExp NodeidToExpOldReserved
UserDBInfo DBQuery DBQueryFatal DBQueryWarn DBWarn DBFatal DBErr
SetNodeBootStatus OSFeatureSupported NodeidToExp
DBQuery DBQueryFatal DBQueryWarn DBWarn DBFatal DBErr
NewTBDBHandle DBQueryN DBQueryFatalN DBQueryWarnN DBErrN
DBQuoteSpecial ExpState
ExpNodes ExpNodeVnames ExpNodesOldReserved
DBDateTime DefaultImageID TBGroupUnixInfo
TBValidNodeName TBSetNodeLogEntry
TBSetSchedReload MapNodeOSID
TBUnixGroupList TBOSID TBOSMaxConcurrent TBOSCountInstances
DBDateTime DefaultImageID
TBSetNodeLogEntry
MapNodeOSID
TBOSID TBOSMaxConcurrent TBOSCountInstances
TBResolveNextOSID TBOsidToPid TBOSIDRebootWaittime
TBOSLoadMaxOkay TBImageLoadMaxOkay TBImageID
TBdbfork TBDBDisconnect VnameToNodeid
......@@ -177,7 +177,7 @@ use vars qw(@ISA @EXPORT);
TBSaveExpLogFiles TBExptWorkDir TBExptUserDir TBExptLogDir
TBIPtoNodeID TBNodeBootReset TBNodeStateWait
TBExptSetSwapUID TBExptSetThumbNail
TBNodeAllocCheck TBPlabNodeUsername MarkPhysNodeDown
TBPlabNodeUsername MarkPhysNodeDown
TBExptIsElabInElab TBExptIsPlabInElab
TBExptPlabInElabPLC TBExptPlabInElabNodes
TBBatchUnLockExp TBExptIsBatchExp
......@@ -1056,59 +1056,6 @@ sub TBNodeAccessCheck($$@)
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.
#
......@@ -1200,52 +1147,6 @@ sub TBGetCancelFlag($$$)
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.
#
......@@ -1474,34 +1375,6 @@ sub TBBootWhat($;$)
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.
#
......@@ -1882,75 +1755,6 @@ sub TBImageLoadMaxOkay($$;@)
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.
#
......@@ -1970,50 +1774,6 @@ sub TBSetNodeLogEntry($$$$)
$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.
#
......
......@@ -4,6 +4,7 @@
# Copyright (c) 2000-2005, 2007 University of Utah and the Flux Group.
# All rights reserved.
#
use strict;
use English;
use Getopt::Std;
......@@ -16,9 +17,9 @@ use Getopt::Std;
#
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".
" -v enables debugging output\n");
" -d enables debugging output\n");
exit(-1);
}
my $optlist = "dp";
......@@ -38,6 +39,10 @@ my $exportsetup = "$TB/sbin/exports_setup";
use lib '@prefix@/lib';
use libdb;
use libtestbed;
use Experiment;
use Project;
use User;
use Node;
#
# Turn off line buffering on output
......@@ -51,7 +56,8 @@ $| = 1;
# Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments.
#
%options = ();
my %options = ();
if (! getopts($optlist, \%options)) {
usage();
}
......@@ -73,39 +79,40 @@ my @node_names = @ARGV;
#
my $error = 0;
my $noalloc = 0;
my @newvals = ();
my @oldnodes = ();
my @nodes = ();
my @need_consetup = 0;
my $need_consetup = 0;
my @need_history = ();
my @need_clearbl = ();
TBDebugTimeStamp("nalloc started");
#
# Experiment must exist.
#
if (!ExpState($pid,$eid)) {
warn "There is no experiment $eid in project $pid\n";
exit -1;
my $experiment = Experiment->Lookup($pid, $eid);
if (! $experiment) {
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.
#
if ($UID) {
if (!TBExptAccessCheck($UID, $pid, $eid, TB_EXPT_MODIFY)) {
warn("*** You do not have permission to allocate nodes in ".
"$pid/$eid!\n");
exit -1;
}
my $this_user = User->ThisUser();
if (! defined($this_user)) {
die("*** $0:\n".
" You ($UID) do not exist in the Emulab DB!\n");
}
TBDebugTimeStamp("nalloc checked exp permission");
my $exptidx;
if (!TBExptIDX($pid, $eid, \$exptidx)) {
print "*** WARNING: No such experiment $pid/$eid!\n";
exit -1;
if (!$experiment->AccessCheck($this_user, TB_EXPT_MODIFY)) {
die("*** $0:\n".
" You do not have permission to allocate nodes in $pid/$eid\n");
}
#
......@@ -113,18 +120,15 @@ if (!TBExptIDX($pid, $eid, \$exptidx)) {
# is allowed to allocate the nodes, by type/class, plus other checks.
#
foreach my $n (@node_names) {
# Make sure a valid node name first!
if (! TBValidNodeName($n)) {
warn("*** $0:\n".
" No such node $n!\n");
exit -1;
my $node = Node->Lookup($n);
if (!defined($node)) {
die("*** $0:\n".
" No such node $n!\n");
}
# Project allowed to allocated this node type/class?
if (! TBNodeAllocCheck($pid, $n)) {
warn("*** $0:\n".
" You are not allowed to allocate $n to project $pid!\n");
exit -1;
# Project allowed to allocate this node type/class?
if (!$this_user->IsAdmin() && !$node->AllocCheck($project)) {
die("*** $0:\n".
" You are not allowed to allocate $n to project $pid!\n");
}
# XXX
......@@ -132,15 +136,12 @@ foreach my $n (@node_names) {
# console_setup. We want to avoid calling console_setup if all we
# got is a zillion virtual nodes on the command line; wasted work.
#
my $tiplines_result =
DBQueryFatal("select tipname,server from tiplines ".
"where node_id='$n'");
if ($tiplines_result->numrows) {
my $tipserver;
if ($node->TipServer(\$tipserver) == 0 && defined($tipserver)) {
$need_consetup++;
}
}
TBDebugTimeStamp("nalloc checked node permission ");
TBDebugTimeStamp("nalloc checked all node permissions");
# Must lock this table!
DBQueryFatal("lock tables reserved write");
......@@ -148,65 +149,81 @@ TBDebugTimeStamp("nalloc locked tables");
# Make a list of nodes to reserve.
foreach my $n (@node_names) {
my ($r_pid, $r_eid);
if (NodeidToExp($n, \$r_pid, \$r_eid)) {
my $node = Node->Lookup($n);
if (!defined($node)) {
die("*** $0:\n".
" No such node $n!\n");
}
my $reserved_experiment = $node->ReservationID();
if ($reserved_experiment) {
# Someone has already reserved this node
if (($r_pid eq $pid) && ($r_eid eq $eid)) {
print "Already reserved: '$n'\n";
if ($reserved_experiment == $experiment->idx()) {
print "$node already reserved to $experiment.\n";
# Do not increment error code since that throws off caller.
next;
}
elsif (NodeidToExpOldReserved($n, \$r_pid, \$r_eid) &&
(($r_pid eq $pid) && ($r_eid eq $eid))) {
print "Already reserved in holding reservation: '$n'\n";
push(@oldnodes, $n);
my $oldreserved_experiment = $node->OldReservationID();
if ($oldreserved_experiment &&
$oldreserved_experiment eq $experiment->idx()) {
print "$node already reserved in holding reservation.\n";
push(@oldnodes, $node);
next;
}
else {
print "Someone else has already reserved node '$n'.\n";
print "Someone else has already reserved node $node.\n";
$noalloc++;
next;
}
}
else {
# Freshly allocated nodes need a history entry.
push(@need_history, $n);
push(@need_history, $node);
# ... and need to have their bootlogs purged.
push(@need_clearbl, $n);
push(@need_clearbl, $node);
}
#
# Add info the list of nodes to reserve; done in a single query below.
#
push(@newvals, "('$n',$exptidx,'$pid','$eid','$n','','')");
push(@nodes, "$n");
push(@nodes, $node);
}
TBDebugTimeStamp("nalloc checked all nodes");
if ($debug) {
print "List Ready: @newvals\nError=$error\n";
print "List Ready: @nodes\nError=$error\n";
}
# Now make the reservations in the DB.
if ((!$noalloc || $partial) && (@newvals || @oldnodes)) {
if ((!$noalloc || $partial) && (@nodes || @oldnodes)) {
print "Reserving nodes...\n"
if ($debug);
if (@newvals &&
! DBQueryWarn("replace into reserved ".
" (node_id,exptidx,pid,eid,vname,old_pid,old_eid) ".
"values ". join(",",@newvals))) {
$error++;
# Generate strings for a single query. Could use perl map().
if (@nodes) {
my @values = ();
foreach my $node (@nodes) {
my $node_id = $node->node_id();
push(@values,
"('$node_id',$exptidx,'$pid','$eid','$node_id','','')");
}
if (! DBQueryWarn("replace into reserved ".
" (node_id,exptidx,pid,eid,vname,old_pid,old_eid) ".
"values ". join(",",@values))) {
$error++;
}
}
# Do this instead of creating new entries so as not to lose any
# other info in the reserved table entries. I think this might be;
# wrong; might need to rethink this.
foreach my $node (@oldnodes) {
my $node_id = $node->node_id();
if (!DBQueryWarn("update reserved " .
"set exptidx=$exptidx,pid='$pid',eid='$eid', ".
" old_exptidx=0, old_pid='', old_eid='' ".
"where node_id='$node'")) {
"where node_id='$node_id'")) {
$error++;
}
}
......@@ -215,7 +232,6 @@ TBDebugTimeStamp("nalloc allocated all nodes");
# Unlock tables.
DBQueryFatal("unlock tables");
TBDebugTimeStamp("nalloc unlocked tables");
# Okay, not safe to do this
......@@ -225,27 +241,30 @@ if (!$error && (!$noalloc || $partial) && @nodes) {
if ($debug);
# It isn't an error if this fails...
DBQueryWarn("update node_activity set last_ext_act=now() ".
"where " . join(" or ",map("node_id='$_'", @nodes)));
DBQueryWarn("update node_activity set last_ext_act=now() where ".
join(" or ",
map("node_id='" . $_->node_id() . "'", @nodes)));
TBDebugTimeStamp("nalloc updated node_activity table");
foreach my $n (@need_history) {
TBSetNodeHistory($n, TB_NODEHISTORY_OP_ALLOC, $UID, $pid, $eid);
foreach my $node (@need_history) {
$node->SetNodeHistory(TB_NODEHISTORY_OP_ALLOC,
$this_user, $experiment);
}
# Clear boot logs - maybe this should be done before alloc?
# - only a small window of opportunity at any rate.
# This is sort of wasteful as it should be the same set of nodes
# as in the node history loop above, but that could change at some point.
foreach my $n (@need_clearbl) {
DBQueryWarn("delete from node_bootlogs where node_id='$n'");
foreach my $node (@need_clearbl) {
$node->ClearBootLog();
}
}
TBDebugTimeStamp("updated node_activity, history, and bootlogs");
# Now setup consoles if needed.
if ($need_consetup && !$error && @nodes) {
system("$consetup @nodes") == 0 or
my @nodeids = map($_->node_id(), @nodes);
system("$consetup @nodeids") == 0 or
print STDERR "WARNING: $consetup @nodes failed!\n";
TBDebugTimeStamp("nalloc finished console setup");
}
......
......@@ -287,9 +287,6 @@ for ($i = 1; $i < 9; $i++) {
my $priority = ($nextpri * 100) + $i;
$nodevname = "v${nodename}-${i}";
if (TBValidNodeName($nodevname)) {
next;
}
print "Creating widearea virtual node $nodevname ...\n";
DBQueryFatal("insert into nodes ".
"(node_id, type, phys_nodeid, role, priority, ".
......
This diff is collapsed.
#!/usr/bin/perl -w
#
# EMULAB-COPYRIGHT
# Copyright (c) 2000-2002, 2007 University of Utah and the Flux Group.
# All rights reserved.
#
use lib '/usr/testbed/lib';
use libdb;
use Project;
use English;
use Getopt::Long;
use strict;
# Getopts stuff goes here...
sub usage() {
print << "END";
Usage: $0 -h
$0 -a [-s]
$0 -p <pid>[,<eid>] [-s] [-m <metric>[,<metric>]]
$0 [-s] <vnode1> [... <vnodeN>]
-h Prints this message
-a Print information on all reserved nodes in the testbed.
-p Restrict output to project 'pid' and optionally experiment 'eid'