#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
# Copyright (c) 2005-2007 University of Utah and the Flux Group.
# All rights reserved.
#
package Node;

use strict;
use Exporter;
use vars qw(@ISA @EXPORT);

@ISA    = "Exporter";
@EXPORT = qw();

# Must come after package declaration!
use lib '@prefix@/lib';
use libdb;
use libtestbed;
require NodeType;
require Interface;
require Experiment;
require OSinfo;
use English;
use Data::Dumper;
use overload ('""' => 'Stringify');
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';

# Why, why, why?
@EXPORT_OK = qw($NODEROLE_TESTNODE);

# Defaults
#
# MFS to boot the nodes into initially
my $MFS_INITIAL = TB_OSID_FREEBSD_MFS();
# Initial event system state to put the nodes into
my $STATE_INITIAL = TBDB_NODESTATE_SHUTDOWN;

# Cache of instances to avoid regenerating them.
my %nodes	= ();
my $debug	= 0;

# Little helper and debug function.
sub mysystem($)
{
    my ($command) = @_;

    print STDERR "Running '$command'\n"
	if ($debug);
    return system($command);
}

#
# Lookup a (physical) node and create a class instance to return.
#
sub Lookup($$)
{
    my ($class, $nodeid) = @_;

    # Look in cache first
    return $nodes{$nodeid}
        if (exists($nodes{$nodeid}));

    return undef
	if (! ($nodeid =~ /^[-\w]+$/));

    my $query_result =
	DBQueryWarn("select * from nodes as n ".
		    "where n.node_id='$nodeid'");

    return undef
	if (!$query_result || !$query_result->numrows);

    my $self            = {};
    $self->{"DBROW"}    = $query_result->fetchrow_hashref();
    $self->{"RSRV"}     = undef;
    $self->{"TYPEINFO"} = undef;
    bless($self, $class);

    # Add to cache.
    $nodes{$nodeid} = $self;
    return $self;
}
# accessors
sub field($$)  { return ((! ref($_[0])) ? -1 : $_[0]->{'DBROW'}->{$_[1]}); }
sub node_id($)       { return field($_[0], 'node_id'); }
sub type($)          { return field($_[0], 'type'); }
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'); }

#
# Create a new node.
#
sub Create($$$$)
{
    my ($class, $node_id, $experiment, $argref) = @_;
    my ($control_iface,$virtnode_capacity,$adminmfs,$adminmfs_osid);
    my ($priority, $osid, $opmode, $state);

    my $type = $argref->{'type'};
    my $role = $argref->{'role'};

    my $typeinfo = NodeType->Lookup($type);
    return undef
	if (!defined($typeinfo));

    my $isremote = $typeinfo->isremotenode();

    if ($typeinfo->virtnode_capacity(\$virtnode_capacity)) {
	print STDERR "*** No virtnode_capacity for $type! Using zero.\n";
	$virtnode_capacity = 0;
    }
    if ($typeinfo->adminmfs_osid(\$adminmfs_osid)) {
	print STDERR "*** No adminmfs osid for $type!\n";
	return undef;
    }
    # Find object for the adminfs.
    if (defined($adminmfs_osid)) {
	$adminmfs = OSinfo->Lookup($adminmfs_osid);
    }
    else {
	$adminmfs = OSinfo->Lookup(TBOPSPID(), $MFS_INITIAL);
    }
    if (!defined($adminmfs)) {
	print STDERR "*** Could not find OSinfo object for adminmfs!\n";
	return undef;
    }
    $osid   = $adminmfs->osid();
    $opmode = $adminmfs->op_mode();
    $state  = $STATE_INITIAL;
    
    #
    # Make up a priority (just used for sorting)
    #
    if ($node_id =~ /^(.*\D)(\d+)$/) {
	$priority = $2;
    }
    else {
	$priority = 1;
    }
    # The list of table we have to clear if anything goes wrong.
    my @cleantables = ("nodes", "node_hostkeys", "node_status",
		       "node_activity", "node_utilization",
		       "node_auxtypes", "reserved");

    DBQueryWarn("insert into nodes set ".
		"  node_id='$node_id', type='$type', " .
		"  phys_nodeid='$node_id', role='$role', ".
		"  priority=$priority, " .
		"  eventstate='$state', op_mode='$opmode', " .
		"  def_boot_osid='$osid', " .
		"  inception=now(), ".
		"  state_timestamp=unix_timestamp(NOW()), " .
		"  op_mode_timestamp=unix_timestamp(NOW())")
	or goto bad;

    DBQueryWarn("insert into node_hostkeys (node_id) ".
		"values ('$node_id')")
	or goto bad;
	
    DBQueryWarn("insert into node_status ".
		"(node_id, status, status_timestamp) ".
		"values ('$node_id', 'down', now()) ")
	or goto bad;
    
    DBQueryWarn("insert into node_activity ".
		"(node_id) values ('$node_id')")
	or goto bad;
	
    DBQueryWarn("insert into node_utilization ".
		"(node_id) values ('$node_id')")
	or goto bad;

    if (defined($experiment)) {
	my $exptidx = $experiment->idx();
	my $pid     = $experiment->pid();
	my $eid     = $experiment->eid();

	# Reserve node to hold it from being messed with.
	print STDERR
	    "*** Reserving new node $node_id to $pid/$eid\n";

	DBQueryWarn("insert into reserved ".
		    "(node_id, exptidx, pid, eid, rsrv_time, vname) ".
		    "values ('$node_id', $exptidx, ".
		    "        '$pid', '$eid', now(), '$node_id')")
	    or goto bad;
    }

    #
    # Add vnode counts.
    #
    if ($role eq $Node::NODEROLE_TESTNODE && $virtnode_capacity) {
	my $vtype = $type;
	if (!($vtype =~ s/pc/pcvm/)) {
	    $vtype = "$vtype-vm";
	}
	my $pcvmtype = ($isremote ? "pcvwa" : "pcvm");

	DBQueryWarn("insert into node_auxtypes set node_id='$node_id', " .
		    "type='$pcvmtype', count=$virtnode_capacity")
	    or goto bad;
	    
	DBQueryWarn("insert into node_auxtypes set node_id='$node_id', " .
		    "type='$vtype', count=$virtnode_capacity")
	    or goto bad;
    }
    return Node->Lookup($node_id);
    
  bad:
    foreach my $table (@cleantables) {
	DBQueryWarn("delete from $table where node_id='$node_id'");
    }
    return undef;
}

#
# Refresh a class instance by reloading from the DB.
#
sub Refresh($)
{
    my ($self) = @_;

    return -1
	if (! ref($self));

    my $nodeid = $self->node_id();

    my $query_result =
	DBQueryWarn("select * from nodes as n ".
		    "where n.node_id='$nodeid'");

    return -1
	if (!$query_result || !$query_result->numrows);

    $self->{"DBROW"}  = $query_result->fetchrow_hashref();
    # Force reload
    $self->{"RSRV"}     = undef;
    $self->{"TYPEINFO"} = undef;
    return 0;
}

#
# Stringify for output.
#
sub Stringify($)
{
    my ($self) = @_;
    
    my $nodeid = $self->node_id();

    return "[Node: $nodeid]";
}

#
# Check permissions. Allow for either uid or a user ref until all code
# updated.
#
sub AccessCheck($$$)
{
    my ($self, $user, $access_type) = @_;

    # Must be a real reference. 
    return 0
	if (! ref($self));

    if ($access_type < TB_NODEACCESS_MIN ||
	$access_type > TB_NODEACCESS_MAX) {
	print "*** Invalid access type: $access_type!\n";
	return 0;
    }
    # Admins do whatever they want.
    return 1
	if ($user->IsAdmin());

    my $mintrust;

    if ($access_type == TB_NODEACCESS_READINFO) {
	$mintrust = PROJMEMBERTRUST_USER;
    }
    else {
	$mintrust = PROJMEMBERTRUST_LOCALROOT;
    }

    # Get the reservation for this node. Only admins can mess with free nodes.
    my $experiment = $self->Reservation();
    return 0
	if (!defined($experiment));

    my $group = $experiment->GetGroup();
    return 0
	if (!defined($group));
    my $project = $experiment->GetProject();
    return 0
	if (!defined($project));

    #
    # Either proper permission in the group, or group_root in the
    # project. This lets group_roots muck with other people's
    # nodes, including those in groups they do not belong to.
    #
    return TBMinTrust($group->Trust($user), $mintrust) ||
	TBMinTrust($project->Trust($user), PROJMEMBERTRUST_GROUPROOT);
}

#
# Lazily load the reservation info.
#
sub IsReserved($)
{
    my ($self) = @_;

    return -1
	if (! ref($self));

    if (! defined($self->{"RSRV"})) {
	my $nodeid = $self->node_id();
	
	my $query_result =
	    DBQueryWarn("select * from reserved " .
			"where node_id='$nodeid'");
	return -1
	    if (!$query_result);
	return 0
	    if (!$query_result->numrows);

	$self->{"RSRV"} = $query_result->fetchrow_hashref();
	return 1;
    }
    return 1;
}

#
# Get the experiment this node is reserved too, or null.
#
sub Reservation($)
{
    my ($self) = @_;

    return undef
	if (! ref($self));

    return undef
	if (! $self->IsReserved());

    return Experiment->Lookup($self->{"RSRV"}->{'pid'},
			      $self->{"RSRV"}->{'eid'});
}

#
# Get the raw reserved table info and return it, or null if no reservation
#
sub ReservedTableEntry($)
{
    my ($self) = @_;

    return undef
	if (! ref($self));

    return undef
	if (! $self->IsReserved());

    return $self->{"RSRV"};
}

# Need to create a set of access methods for the reservation.
sub vname($)
{
    my ($self) = @_;

    return undef
	if (! ref($self));

    return undef
	if (! $self->IsReserved());

    return $self->{"RSRV"}->{'vname'};
}

#
# Return type info. We cache this in the instance since node_type stuff
# does not change much.
#
sub NodeTypeInfo($)
{
    my ($self) = @_;

    return undef
	if (! ref($self));

    return $self->{"TYPEINFO"}
        if (defined($self->{"TYPEINFO"}));

    my $type = $self->type();
    my $nodetype = NodeType->Lookup($type);
    
    $self->{"TYPEINFO"} = $nodetype
	if (defined($nodetype));
    
    return $nodetype;
}

#
# Lookup a specific attribute in the nodetype info. 
#
sub NodeTypeAttribute($$$;$)
{
    my ($self, $attrkey, $pattrvalue, $pattrtype) = @_;
    
    return -1
	if (!ref($self));

    my $typeinfo = $self->NodeTypeInfo();

    return -1
	if (!defined($typeinfo));

    return $typeinfo->GetAttribute($attrkey, $pattrvalue, $pattrtype);
}

#
# Shortcuts to "common" type information.
# Later these might be overriden by node attributes.
#
sub class($)          { return NodeTypeInfo($_[0])->class(); }
sub isvirtnode($)     { return NodeTypeInfo($_[0])->isvirtnode(); }
sub isjailed($)       { return NodeTypeInfo($_[0])->isjailed(); }
sub isdynamic($)      { return NodeTypeInfo($_[0])->isdynamic(); }
sub isremotenode($)   { return NodeTypeInfo($_[0])->isremotenode(); }
sub issubnode($)      { return NodeTypeInfo($_[0])->issubnode(); }
sub isplabdslice($)   { return NodeTypeInfo($_[0])->isplabdslice(); }
sub isplabphysnode($) { return NodeTypeInfo($_[0])->isplabphysnode(); }
sub issimnode($)      { return NodeTypeInfo($_[0])->issimnode(); }

#
# And these are the less common attributes, but still common enough to
# warrant shortcuts.
#
sub default_osid($;$) {
    return NodeTypeInfo($_[0])->default_osid($_[1]);
}
sub default_imageid($;$) {
    return NodeTypeInfo($_[0])->default_imageid($_[1]);
}
sub imageable($;$) {
    return NodeTypeInfo($_[0])->imageable($_[1]);
}
sub disksize($;$) {
    return NodeTypeInfo($_[0])->disksize($_[1]);
}
sub disktype($;$) {
    return NodeTypeInfo($_[0])->disktype($_[1]);
}
sub bootdisk_unit($;$) {
    return NodeTypeInfo($_[0])->bootdisk_unit($_[1]);
}
sub control_iface($;$) {
    return NodeTypeInfo($_[0])->control_iface($_[1]);
}
sub rebootable($;$) {
    return NodeTypeInfo($_[0])->rebootable($_[1]);
}

#
# Perform some updates ...
#
sub Update($$)
{
    my ($self, $argref) = @_;

    # Must be a real reference. 
    return -1
	if (! ref($self));

    my $nodeid = $self->node_id();

    my $query = "update nodes set ".
	join(",", map("$_='" . $argref->{$_} . "'", keys(%{$argref})));

    $query .= " where node_id='$nodeid'";

    return -1
	if (! DBQueryWarn($query));

    return Refresh($self);
}

#
# Insert a Log entry for a node.
#
sub InsertNodeLogEntry($$$$)
{
    my ($self, $user, $type, $message) = @_;

    # Must be a real reference. 
    return -1
	if (! ref($self));

    return -1
	if (! grep {$_ eq $type} TB_NODELOGTYPES());

    # XXX Eventually this should change, but it uses non-existent uids!
    my $dbid    = (defined($user) ? $user->uid_idx() : 0);
    my $dbuid   = (defined($user) ? $user->uid()     : "root");
    my $node_id = $self->node_id();
    $message    = DBQuoteSpecial($message);

    return -1
	if (! DBQueryWarn("insert into nodelog values ".
			  "('$node_id', NULL, '$type', '$dbuid', '$dbid', ".
			  " $message, now())"));
    return 0;
}

#
# Mark a node for an update.
#
sub MarkForUpdate($)
{
    my ($self) = @_;

    # Must be a real reference. 
    return -1
	if (! ref($self));

    my $node_id = $self->node_id();

    return -1
	if (! DBQueryWarn("update nodes set ".
			  "update_accounts=GREATEST(update_accounts,1) ".
			  "where node_id='$node_id'"));

    return Refresh($self);
}
# Class method!
sub CheckUpdateStatus($$$@)
{
    my ($class, $pdone, $pnotdone, @nodelist) = @_;
    my @done = ();
    my @notdone = ();

    my $where = join(" or ",
		     map("node_id='" . $_->node_id() . "'", @nodelist));

    my $query_result =
	DBQueryWarn("select node_id,update_accounts from nodes ".
		    "where ($where)");

    return -1
	if (! $query_result);

    while (my ($node_id,$update_accounts) = $query_result->fetchrow_array) {
	my $node = Node->Lookup($node_id);
	if (! $update_accounts) {
	    Refresh($node);
	    push(@done, $node);
	}
	else {
	    push(@notdone, $node);
	}
    }
    
    @$pdone = @done;
    @$pnotdone = @notdone;
    return 0;
}

#
# Clear the bootlog.
#
sub ClearBootLog($)
{
    my ($self) = @_;

    # Must be a real reference. 
    return -1
	if (! ref($self));

    my $node_id = $self->node_id();

    return -1
	if (! DBQueryWarn("delete from node_bootlogs ".
			  "where node_id='$node_id'"));
    return 0;
}

#
# Get the bootlog.
#
sub GetBootLog($$)
{
    my ($self, $pref) = @_;

    # Must be a real reference. 
    return -1
	if (! ref($self));

    $$pref = undef;

    my $node_id = $self->node_id();

    my $query_result =
	DBQueryWarn("select bootlog from node_bootlogs ".
		    "where node_id='$node_id'");
    return -1
	if (! $query_result);
    return 0
	if (! $query_result->numrows);

    my ($bootlog) = $query_result->fetchrow_array();
    $$pref = $bootlog;
    return 0;
}

#
# 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
# a hash of options to be used when creating the new node(s). A list of the
# node names is returned.
#
sub CreateVnodes($$)
{
    my ($rptr, $options) = @_;
    my @created   = ();
    my @tocreate  = ();

    if (!defined($options->{'pid'})) {
	print STDERR "*** CreateVnodes: Must supply a pid!\n";
	return -1;
    }
    if (!defined($options->{'eid'})) {
	print STDERR "*** CreateVnodes: Must supply a eid!\n";
	return -1;
    }
    if (!defined($options->{'count'})) {
	print STDERR "*** CreateVnodes: Must supply a count!\n";
	return -1;
    }
    if (!defined($options->{'vtype'})) {
	print STDERR "*** CreateVnodes: Must supply a vtype!\n";
	return -1;
    }
    if (!defined($options->{'nodeid'})) {
	print STDERR "*** CreateVnodes: Must supply a pnode!\n";
	return -1;
    }
    
    my $debug   = defined($options->{'debug'}) && $options->{'debug'};
    my $impotent= defined($options->{'impotent'}) && $options->{'impotent'};
    my $verbose = defined($options->{'verbose'}) && $options->{'verbose'};
    my $pid     = $options->{'pid'};
    my $eid     = $options->{'eid'};
    my $count   = $options->{'count'};
    my $vtype   = $options->{'vtype'};
    my $pnode   = $options->{'nodeid'};

    my $exptidx;
    if (!TBExptIDX($pid, $eid, \$exptidx)) {
	print STDERR "*** CreateVnodes: No such experiment $pid/$eid!\n";
	return -1;
    }

    #
    # Need the vtype node_type info. 
    #
    my $nodetype = NodeType->Lookup($vtype);
    if (! defined($nodetype)) {
	print STDERR "*** CreateVnodes: No such node type '$vtype'\n";
	return -1;
    }
    if (!$nodetype->isdynamic()) {
	print STDERR "*** CreateVnodes: Not a dynamic node type: '$vtype'\n";
	return -1;
    }
    my $isremote = $nodetype->isremotenode();
    my $isjailed = $nodetype->isjailed();

    #
    # Make up a priority (just used for sorting). We need the name prefix
    # as well for consing up the node name.
    #
    my $nodeprefix;
    my $nodenum;
    if ($pnode =~ /^(.*\D)(\d+)$/) {
	$nodeprefix = $1;
	$nodenum    = $2;
    }
    else {
	print STDERR "*** CreateVnodes: Unexpected nodeid '$pnode'\n";
	return -1;
    }

    #
    # Need the opmode, which comes from the OSID, which is in the node_types
    # table. 
    #
    my $osid = $nodetype->default_osid();
    
    my $query_result =
	DBQueryWarn("select op_mode from os_info where osid='$osid'");
    return -1
	if (! $query_result);
    
    if (! $query_result->numrows) {
	print STDERR "*** CreateVnodes: No such OSID '$osid'\n";
	return -1;
    }
    my ($opmode) = $query_result->fetchrow_array();

    #
    # Need IP for jailed nodes.
    # 
    my $IPBASE = TBDB_JAILIPBASE();
    my $IPBASE1;
    my $IPBASE2;
    if ($IPBASE =~ /^(\d+).(\d+).(\d+).(\d+)/) {
	$IPBASE1 = $1;
	$IPBASE2 = $2;
    }
    else {
	print STDERR "*** CreateVnodes: Bad IPBASE '$IPBASE'\n";
	return -1;
    }

    #
    # Assign however many we are told to (typically by assign). Locally
    # this is not a problem since nodes are not shared; assign always
    # does the right thing and we do what it says. In the remote case,
    # nodes are shared and so it is harder to make sure that nodes are not
    # over committed. I am not going to worry about this right now though
    # cause it would be too hard. For RON nodes this is fine; we just
    # tell people to log in and use them. For plab nodes, this is more
    # of a problem, but I am going to ignore that for now too since we do
    # not ever allocate enough to worry; must revisit this at some point.
    # 
    # Look to see what nodes are already allocated on the node, and skip
    # those. Must do this with tables locked, of course.
    #
    DBQueryFatal("lock tables nodes write, reserved write, ".
		 "node_status write, node_hostkeys write");

    if (0 && !$isremote) {
	for (my $i = 1; $i <= $count; $i++) {
	    push(@tocreate, $i);
	}
    }
    else {
	my $n = 1;
	my $i = 0;

	while ($i < $count) {
	    my $vnodeid = $nodeprefix . "vm" . $nodenum . "-" . $n;
	    
	    $query_result =
		DBQueryWarn("select node_id from nodes ".
			     "where node_id='$vnodeid'");
	    goto bad
		if (!$query_result);

	    if (!$query_result->numrows) {
		push(@tocreate, $n);
		$i++;
	    }
	    $n++;
	}
    }

    # See below.
    my $eventstate = TBDB_NODESTATE_SHUTDOWN();
    my $allocstate = TBDB_ALLOCSTATE_FREE_CLEAN();

    #
    # Create a bunch.
    #
    foreach my $i (@tocreate) {
	my $vpriority = 10000000 + ($nodenum * 1000) + $i;
	my $vnodeid   = $nodeprefix . "vm" . $nodenum . "-" . $i;

	#
	# Construct the vnode IP.  The general form is:
	#	<IPBASE1>.<IPBASE2>.<pnode>.<vnode>
	# but if <pnode> is greater than 254 we have to increment
	# IPBASE2.
	#
	# XXX at Utah our second big cluster of nodes starts at
	# nodenum=201 and I would like our vnode IPs to align
	# at that boundary, so 254 becomes 200.
	#
	my $nodenumlimit = $ISUTAH ? 200 : 254;
	my $pnet = $IPBASE2;
	my $pnode2 = int($nodenum);
	while ($pnode2 > $nodenumlimit) {
	    $pnet++;
	    $pnode2 -= $nodenumlimit;
	}
	my $jailip = "${IPBASE1}.${pnet}.${pnode2}.${i}";

	if ($verbose) {
	    if ($impotent) {
		print "Would allocate $vnodeid on $pnode ($vtype, $osid)\n";
	    }
	    else {
		print "Allocating $vnodeid on $pnode ($vtype, $osid)\n";
	    }
	}

	my $statement =
	         "insert into nodes set ".
		 "       node_id='$vnodeid', " .
		 "       type='$vtype', ".
		 "       phys_nodeid='$pnode', ".
		 "       role='virtnode', " .
		 "       priority='$vpriority', ".
		 "       op_mode='$opmode', " .
		 "       eventstate='$eventstate', " .
		 "       allocstate='$allocstate', ".
		 "       def_boot_osid='$osid', " .
		 "       update_accounts=1, ".
		 "       jailflag=$isjailed ".
		 (($isjailed && !$isremote) ? ",jailip='$jailip'" : "");

	print STDERR "$statement\n"
	    if ($debug);

	if (!$impotent && !DBQueryWarn($statement)) {
	    print STDERR "*** CreateVnodes: Could not create nodes entry\n";
	    goto bad;
	}

	#
	# Also reserve the node!
	# 
	$statement =
	         "insert into reserved set ".
		 "       node_id='$vnodeid', " .
		 "       exptidx=$exptidx, ".
		 "       pid='$pid', ".
		 "       eid='$eid', ".
		 "       vname='$vnodeid', ".
		 "       old_pid='', ".
		 "       old_eid=''";

	print STDERR "$statement\n"
	    if ($debug);

	if (!$impotent && !DBQueryWarn($statement)) {
	    print STDERR "*** CreateVnodes: Could not create reserved entry\n";
	    goto bad;
	}

	$statement =
	         "insert into node_status set ".
		 "       node_id='$vnodeid', " .
		 "       status='up', ".
		 "       status_timestamp=now()";

	print STDERR "$statement\n"
	    if ($debug);

	if (!$impotent && !DBQueryWarn($statement)) {
	    print STDERR "*** CreateVnodes: Could not create status entry\n";
	    goto bad;
	}

	$statement =
	         "insert into node_hostkeys set ".
		 "       node_id='$vnodeid'";

	print STDERR "$statement\n"
	    if ($debug);

	if (!$impotent && !DBQueryWarn($statement)) {
	    print STDERR "*** CreateVnodes: Could not create hostkeys entry\n";
	    goto bad;
	}
	
	push(@created, $vnodeid);
    }
    DBQueryFatal("unlock tables");
    @$rptr = @created;
    return 0;

  bad:
    if (!$impotent) {
	foreach my $vnodeid (@created) {
	    DBQueryWarn("delete from reserved where node_id='$vnodeid'");
	    DBQueryWarn("delete from nodes where node_id='$vnodeid'");
	    DBQueryWarn("delete from node_hostkeys where node_id='$vnodeid'");
	    DBQueryWarn("delete from node_status where node_id='$vnodeid'");
	}
    }
    DBQueryFatal("unlock tables");
    return -1;
}

#
# Delete vnodes created in above step.
# 
sub DeleteVnodes(@)
{
    my (@vnodes) = @_;

    DBQueryWarn("lock tables nodes write, reserved write");
    foreach my $vnodeid (@vnodes) {
	DBQueryWarn("delete from reserved where node_id='$vnodeid'");
	DBQueryWarn("delete from nodes where node_id='$vnodeid'");
    }
    DBQueryFatal("unlock tables");
    
    foreach my $vnodeid (@vnodes) {
	DBQueryWarn("delete from node_hostkeys where node_id='$vnodeid'");
	DBQueryWarn("delete from node_status where node_id='$vnodeid'");
	DBQueryWarn("delete from node_rusage where node_id='$vnodeid'");
    }

    return 0;
}

sub SetNodeHistory($$$$)
{
    my ($self, $op, $user, $experiment) = @_;

    my $exptidx = $experiment->idx();
    my $nodeid  = $self->node_id();
    my $now     = time();
    my $uid;
    my $uid_idx;

    if (!defined($user)) {
	# Should this be elabman instead?
	$uid = "root";
	$uid_idx = 0;
    }
    else {
	$uid = $user->uid();
	$uid_idx = $user->uid_idx();
    }
    if ($op eq TB_NODEHISTORY_OP_MOVE() || $op eq TB_NODEHISTORY_OP_FREE()) {
	# Summary info. We need the last entry made.
	my $query_result =
	    DBQueryWarn("select exptidx,stamp from node_history ".
			"where node_id='$nodeid' ".
			"order by stamp desc limit 1");

	if ($query_result && $query_result->numrows) {
	    my ($lastexptidx,$stamp) = $query_result->fetchrow_array();
	    my $checkexp;

	    if ($op eq TB_NODEHISTORY_OP_FREE()) {
		$checkexp = $experiment;
	    }
	    else {
		$checkexp = Experiment->Lookup($lastexptidx);
	    }
	    if (defined($checkexp)) {
		if ($checkexp->pid() eq NODEDEAD_PID() &&
		    $checkexp->eid() eq NODEDEAD_EID()) {
		    my $diff = $now - $stamp;

		    DBQueryWarn("update node_utilization set ".
				" down=down+$diff ".
				"where node_id='$nodeid'")
		    }
		else {
		    my $diff = $now - $stamp;

		    DBQueryWarn("update node_utilization set ".
				" allocated=allocated+$diff ".
				"where node_id='$nodeid'");
		}
	    }
	}
    }
    return DBQueryWarn("insert into node_history set ".
		       "  history_id=0, node_id='$nodeid', op='$op', ".
		       "  uid='$uid', uid_idx='$uid_idx', ".
		       "  stamp=$now, exptidx=$exptidx");
}

# _Always_ make sure that this 1 is at the end of the file...

1;