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($$)
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;
}
......
......@@ -13,6 +13,13 @@ use vars qw(@ISA @EXPORT);
@ISA = "Exporter";
@EXPORT = qw();
# Configure variables
my $TB = "@prefix@";
my $BOSSNODE = "@BOSSNODE@";
my $EVENTSYS = @EVENTSYS@;
# XXX stinky hack detection
my $ISUTAH = @TBMAINSITE@;
# Must come after package declaration!
use lib '@prefix@/lib';
use libdb;
......@@ -24,15 +31,12 @@ require OSinfo;
use English;
use Data::Dumper;
use overload ('""' => 'Stringify');
if ($EVENTSYS) {
require event;
import event;
}
use vars qw($NODEROLE_TESTNODE @EXPORT_OK);
# Configure variables
my $TB = "@prefix@";
my $BOSSNODE = "@BOSSNODE@";
my $EVENTSYS = @EVENTSYS@;
# XXX stinky hack detection
my $ISUTAH = @TBMAINSITE@;
# Exported defs
$NODEROLE_TESTNODE = 'testnode';
......@@ -99,6 +103,7 @@ sub eventstate($) { return field($_[0], 'eventstate'); }
sub jailflag($) { return field($_[0], 'jailflag'); }
sub phys_nodeid($) { return field($_[0], 'phys_nodeid'); }
sub def_boot_osid($) { return field($_[0], 'def_boot_osid'); }
sub pxe_boot_path($) { return field($_[0], 'pxe_boot_path'); }
#
# Create a new node.
......@@ -322,7 +327,7 @@ sub IsReserved($)
{
my ($self) = @_;
return -1
return 0
if (! ref($self));
if (! defined($self->{"RSRV"})) {
......@@ -331,7 +336,7 @@ sub IsReserved($)
my $query_result =
DBQueryWarn("select * from reserved " .
"where node_id='$nodeid'");
return -1
return 0
if (!$query_result);
return 0
if (!$query_result->numrows);
......@@ -342,6 +347,69 @@ sub IsReserved($)
return 1;
}
#
# Determine if a node can be allocated to a project.
#
sub NodeAllocCheck($$)
{
my ($self, $pid) = @_;
# Must be a real reference.
return 0
if (! ref($self));
my $node_id = $self->node_id();
#
# 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 "NodeAllocCheck: 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;
}
#
# Equality test for two experiments.
# Not strictly necessary in perl, but good form.
#
sub SameExperiment($$)
{
my ($self, $other) = @_;
# Must be a real reference.
return -1
if (! (ref($self) && ref($other)));
return $self->idx() == $other->idx();
}
#
# Get the experiment this node is reserved too, or null.
#
......@@ -355,8 +423,206 @@ sub Reservation($)
return undef
if (! $self->IsReserved());
return Experiment->Lookup($self->{"RSRV"}->{'pid'},
$self->{"RSRV"}->{'eid'});
return Experiment->Lookup($self->{"RSRV"}->{'exptidx'});
}
#
# Return just the ID of the reservation experiment. Avoids locking problems
# within nalloc and nfree.
#
sub ReservationID($)
{
my ($self) = @_;
return undef
if (! ref($self));
return undef
if (! $self->IsReserved());
return $self->{"RSRV"}->{'exptidx'};
}
#
# Get the NEXT experiment this node is reserved too, or null.
#
sub NextReservation($)
{
my ($self) = @_;
return undef
if (! ref($self));
my $node_id = $self->node_id();
my $query_result =
DBQueryFatal("select pid,eid from next_reserve ".
"where node_id='$node_id'");
return undef
if (!$query_result || !$query_result->numrows);
my ($pid,$eid) = $query_result->fetchrow_array();
return Experiment->Lookup($pid, $eid);
}
#
# Move a node from its experiment to another. Must treat oldreserved special.
#
sub MoveReservation($$)
{
my ($self, $newexperiment) = @_;
return -1
if (! (ref($self) && ref($newexperiment)));
return -1
if (! $self->IsReserved());
my $node_id = $self->node_id();
my $newpid = $newexperiment->pid();
my $neweid = $newexperiment->eid();
my $newidx = $newexperiment->idx();
my $oldpid = "";
my $oldeid = "";
my $oldidx = 0;
# Must remember old reservation when moving to new oldreserved.
if ($newpid eq OLDRESERVED_PID() && $neweid eq OLDRESERVED_EID()) {
#
# Cannot do an experiment Lookup cause reserved table may be locked.
# IsReserved() will load the reserved table entry only.
#
return -1
if (!$self->IsReserved());
$oldpid = $self->{"RSRV"}->{'pid'};
$oldeid = $self->{"RSRV"}->{'eid'};
$oldidx = $self->{"RSRV"}->{'exptidx'};
}
DBQueryWarn("update reserved set " .
" vname='$node_id', ".
" exptidx=$newidx, ".
" pid='$newpid', ".
" eid='$neweid', ".
" old_exptidx=$oldidx, ".
" old_pid='$oldpid', ".
" old_eid='$oldeid' ".
"where node_id='$node_id'")
or return -1;
return 0;
}
#
# Change reservation table for a node.
#
sub ModifyReservation($$)
{
my ($self, $argref) = @_;
return -1
if (! (ref($self) && ref($argref)));
return -1
if (! $self->IsReserved());
my $node_id = $self->node_id();
my $query = "update reserved set ".
join(",", map("$_='" . $argref->{$_} . "'", keys(%{$argref})));
$query .= " where node_id='$node_id'";
return -1
if (! DBQueryWarn($query));
return 0;
}
#
# Map nodeid to its pid/eid in the oldreserved holding reservation
#
sub OldReservation($)
{
my ($self) = @_;
return undef
if (! ref($self));
my $nodeid = $self->node_id();
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'");
return undef
if (! $query_result || !$query_result->num_rows);
my ($pid,$eid) = $query_result->fetchrow_array();
return Experiment->Lookup($pid, $eid);
}
sub OldReservationID($)
{
my ($self) = @_;
return undef
if (! ref($self));
my $nodeid = $self->node_id();
my $oldreserved_pid = OLDRESERVED_PID;
my $oldreserved_eid = OLDRESERVED_EID;
my $query_result =
DBQueryWarn("select old_exptidx from reserved ".
"where node_id='$nodeid' and pid='$oldreserved_pid' ".
"and eid='$oldreserved_eid'");
return undef
if (! $query_result || !$query_result->num_rows);
my ($idx) = $query_result->fetchrow_array();
return $idx;
}
#
# Return the tip server (and tipname) for a node.
#
sub TipServer($$;$)
{
my ($self, $pserver, $ptipname) = @_;
return -1
if (! ref($self));
$$pserver = undef;
$$ptipname = undef
if (defined($ptipname));
my $nodeid = $self->node_id();
my $query_result =
DBQueryWarn("select server,tipname from tiplines " .
"where node_id='$nodeid'");
return -1
if (!$query_result);
return 0
if (!$query_result->numrows);
my ($server, $tipname) = $query_result->fetchrow_array();
$$pserver = $server;
$$ptipname = $tipname
if (defined($ptipname));
return 0;
}
#
......@@ -375,6 +641,46 @@ sub ReservedTableEntry($)
return $self->{"RSRV"};
}
#
# Return a list of virtual nodes on the given physical node.
#
sub VirtualNodes($$)
{
my ($self, $plist) = @_;
return -1
if (! ref($self));
my $reservation = $self->Reservation();
my $node_id = $self->node_id();
my $exptidx = $reservation->idx();
my @result = ();
@$plist = ();
my $query_result =
DBQueryWarn("select r.node_id from reserved as r ".
"left join nodes as n ".
"on r.node_id=n.node_id ".
"where n.phys_nodeid='$node_id' and ".
" n.node_id!=n.phys_nodeid and exptidx='$exptidx'");
return -1
if (!$query_result);
return 0
if (!$query_result->numrows);
while (my ($node_id) = $query_result->fetchrow_array()) {
my $node = Node->Lookup($node_id);
if (!defined($node)) {
print STDERR "*** VirtualNodes: no such virtual node $node_id!\n";
return -1;
}
push(@result, $node);
}
@$plist = @result;
return 0;
}
# Need to create a set of access methods for the reservation.
sub vname($)
{
......@@ -485,11 +791,17 @@ sub Update($$)
if (! ref($self));
my $nodeid = $self->node_id();
my @sets = ();
my $query = "update nodes set ".
join(",", map("$_='" . $argref->{$_} . "'", keys(%{$argref})));
foreach my $key (keys(%{$argref})) {
my $val = $argref->{$key};
# Treat NULL special.
push (@sets, "${key}=" . ($val eq "NULL" ? "NULL" : "'$val'"));
}
$query .= " where node_id='$nodeid'";
my $query = "update nodes set " . join(",", @sets) .
" where node_id='$nodeid'";
return -1
if (! DBQueryWarn($query));
......@@ -524,6 +836,31 @@ sub InsertNodeLogEntry($$$$)
return 0;
}
#
# Clear the experimental interfaces for a node.
#
#
# Insert a Log entry for a node.
#
sub ClearInterfaces($)
{
my ($self) = @_;
# Must be a real reference.
return -1
if (! ref($self));
my $node_id = $self->node_id();
DBQueryWarn("update interfaces set IP='',IPaliases=NULL,mask=NULL,".
" rtabid='0',vnode_id=NULL,current_speed='0' ".
"where node_id='$node_id' and ".
" role='" . TBDB_IFACEROLE_EXPERIMENT() . "'")
or return -1;
return 0;
}
#
# Mark a node for an update.
#
......@@ -624,6 +961,33 @@ sub GetBootLog($$)
return 0;
}
#
# Set event state for a node.
#
sub SetEventState($$)
{
my ($self, $state) = @_;
# Must be a real reference.
return -1
if (! ref($self));
my $node_id = $self->node_id();
#
# If using the event system, we send out an event for the state daemon to
# pick up. Otherwise, we just set the state in the database ourselves
#
if ($EVENTSYS) {
return EventSendFatal(objtype => TBDB_TBEVENT_NODESTATE,
objname => $node_id,
eventtype => $state,
host => $BOSSNODE);
}
return $self->Update({"eventstate" => $state,
"state_timestamp" => time()});
}
#
# Create new vnodes. This routine obviously cannot be called on a specific
# instance since it does not exist! The argument is still a reference; to a
......@@ -989,6 +1353,32 @@ sub SetNodeHistory($$$$)
" stamp=$now, exptidx=$exptidx");
}
#
# Set the scheduled_reloads for a node. Type is optional and defaults to
# testbed default load type. See above.
#
sub SetSchedReload($$;$)
{
my ($self, $image, $type) = @_;
# Must be a real reference.
return -1
if (! ref($self));
my $node_id = $self->node_id();
my $imageid = $image->imageid();
$type = TB_DEFAULT_RELOADTYPE
if (!defined($type));
return -1
if (! DBQueryWarn("replace into scheduled_reloads ".
"(node_id, image_id, reload_type) values ".
"('$node_id', '$imageid', '$type')"));
return 0;
}
# _Always_ make sure that this 1 is at the end of the file...
1;
......@@ -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.
#