#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
# Copyright (c) 2005-2009 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();

# Configure variables
my $TB		= "@prefix@";
my $BOSSNODE    = "@BOSSNODE@";
my $EVENTSYS    = @EVENTSYS@;
my $WOL         = "$TB/sbin/whol";
my $OSSELECT    = "$TB/bin/os_select";
# XXX stinky hack detection
my $ISUTAH	= @TBMAINSITE@;

# Need this for jail ip assignment.
my $CONTROL_NETMASK = "@CONTROL_NETMASK@";

use libdb;
use libtestbed;
require NodeType;
require Interface;
require Experiment;
require OSinfo;
use English;
use Socket;
use Data::Dumper;
use overload ('""' => 'Stringify');
if ($EVENTSYS) {
    require event;
    import event;
}
use vars qw($NODEROLE_TESTNODE @EXPORT_OK);

# 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, $token) = @_;
    my $nodeid;

    if ($token =~ /^\w{8}\-\w{4}\-\w{4}\-\w{4}\-\w{12}$/) {
	my $query_result =
	    DBQueryWarn("select node_id from nodes ".
			"where uuid='$token'");
	    return undef
		if (! $query_result || !$query_result->numrows);

	    ($nodeid) = $query_result->fetchrow_array();
    }
    elsif ($token =~ /^[-\w]+$/) {
	$nodeid = $token;
    }
    else {
	return undef;
    }

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

    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;
    $self->{"ATTRS"}    = undef;
    bless($self, $class);

    # Add to cache.
    $nodes{$nodeid} = $self;
    return $self;
}

#
# Bulk lookup of nodes reserved to an experiment. More efficient.
#
sub BulkLookup($$$)
{
    my ($class, $experiment, $pref) = @_;
    my %nodelist = ();
    my $exptidx  = $experiment->idx();

    my $query_result =
	DBQueryWarn("select n.* from reserved as r ".
		    "left join nodes as n on n.node_id=r.node_id ".
		    "where r.exptidx=$exptidx");

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

    while (my $row = $query_result->fetchrow_hashref()) {
	my $nodeid = $row->{'node_id'};
	my $node;

	if (exists($nodes{$nodeid})) {
	    $node = $nodes{$nodeid};
	    $node->{"DBROW"} = $row;
	}
	else {
	    $node               = {};
	    $node->{"DBROW"}    = $row;
	    bless($node, $class);

	    # Add to cache.
	    $nodes{$nodeid} = $node;
	}
	$node->{"RSRV"}     = undef;
	$node->{"TYPEINFO"} = undef;
	$node->{"ATTRS"}    = undef;
	
	$nodelist{$nodeid} = $node;
    }

    $query_result =
	DBQueryWarn("select r.* from reserved as r ".
		    "where r.exptidx=$exptidx");
    return -1
	if (!defined($query_result));
    
    while (my $row = $query_result->fetchrow_hashref()) {
	my $nodeid = $row->{'node_id'};
	my $node   = $nodelist{$nodeid};

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

	$node->{"RSRV"} = $row;
    }

    $query_result =
	DBQueryWarn("select a.* from reserved as r ".
		    "left join node_attributes as a on a.node_id=r.node_id ".
		    "where r.exptidx=$exptidx and a.node_id is not null");
    return -1
	if (!defined($query_result));
    
    while (my $row = $query_result->fetchrow_hashref()) {
	my $nodeid = $row->{'node_id'};
	my $key    = $row->{'attrkey'};
	my $node   = $nodelist{$nodeid};

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

	$node->{"ATTRS"}->{$key} = $row;
    }
	
    @$pref = values(%nodelist);
    return 0;
}

# accessors
sub field($$)  { return ((! ref($_[0])) ? -1 : $_[0]->{'DBROW'}->{$_[1]}); }
sub node_id($)       { return field($_[0], 'node_id'); }
sub uuid($)          { return field($_[0], 'uuid'); }
sub type($)          { return field($_[0], 'type'); }
sub role($)          { return field($_[0], 'role'); }
sub eventstate($)    { return field($_[0], 'eventstate'); }
sub allocstate($)    { return field($_[0], 'allocstate'); }
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.
#
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 $uuid;

    if (exists($argref->{'uuid'})) {
	$uuid = $argref->{'uuid'};
    }
    else {
	$uuid = NewUUID();
	if (!defined($uuid)) {
	    print STDERR "Could not generate a UUID!\n";
	    return undef;
	}
    }
    $uuid = DBQuoteSpecial($uuid);

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

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

    if ($role eq "testnode") {
	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();
    }
    else {
	$osid   = 0;
	$opmode = "";
    }
    $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(), uuid=$uuid, ".
		"  state_timestamp=unix_timestamp(NOW()), " .
		"  op_mode_timestamp=unix_timestamp(NOW())")
	or goto bad;

    if ($role eq "testnode") {
	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;
	
	if (exists($argref->{'vtype'})) {
	    $vtype = $argref->{'vtype'};
	}
	else  {
	    $vtype = $type;
	    if (!($vtype =~ s/pc/pcvm/)) {
		$vtype = "$vtype-vm";
	    }
	}
	
	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;
    $self->{"ATTRS"}    = undef;
    return 0;
}

#
# Flush from our little cache, as for the expire daemon.
#
sub Flush($)
{
    my ($self) = @_;

    delete($nodes{$self->node_id()});
}
sub FlushAll($)
{
    my ($class) = @_;
    
    %nodes = ();
}

#
# 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 STDERR "*** 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 0
	if (! ref($self));

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

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

#
# Is node up.
#
sub IsUp($)
{
    my ($self) = @_;

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

    return $self->eventstate() eq TBDB_NODESTATE_ISUP;
}

#
# 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.
    # Note: nodetypeXpid_permissions has the pid_idx in addition to the pid -
    # presumably, the Right Thing would be to use that, but this function
    # is only passed the pid right now.
    #
    my $query_result =
	DBQueryFatal("select distinct p.type, p.pid_idx 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,$pid_idx) = $query_result->fetchrow_array();

    # No rows, or a pid match.
    if (!defined($ptype) || $pid_idx eq $pid->pid_idx()) {
	return 1;
    }

    # Okay, must be rows in the permissions table. Check each pid for a match.
    while (my ($ptype,$pid_idx) = $query_result->fetchrow_array()) {
	if ($pid_idx eq $pid->pid_idx()) {
	    return 1;
	}
    }
    return 0;
}

# Naming confusion.
sub AllocCheck($$)
{
    my ($self, $pid) = @_;

    return $self->NodeAllocCheck($pid);
}

#
# Set alloc state for a node.
#
sub SetAllocState($$)
{
    my ($self, $state) = @_;

    return -1
	if (! (ref($self)));
    
    my $now = time();
    my $node_id = $self->node_id();
    
    DBQueryWarn("update nodes set allocstate='$state', " .
		"    allocstate_timestamp=$now where node_id='$node_id'")
	or return -1;

    return Refresh($self);
}

#
# Get alloc state for a node.
#
sub GetAllocState($$)
{
    my ($self, $pref) = @_;

    return -1
	if (! (ref($self) && ref($pref)));
    
    my $allocstate = $self->allocstate();
    
    if (defined($allocstate)) {
	$$pref = $allocstate;
    }
    else {
	$$pref = TBDB_ALLOCSTATE_UNKNOWN;
    }
    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.
#
sub Reservation($)
{
    my ($self) = @_;

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

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

    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 @sets    = ();
    foreach my $key (keys(%{$argref})) {
	my $val = $argref->{$key};

	push(@sets, "$key=" . ("$val" eq "NULL" ? "NULL" : "'$val'"));
    }

    my $query = "update reserved set ".	join(",", @sets);
    $query .= " where node_id='$node_id'";

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

    return Refresh($self);
}

#
# 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;
}

#
# 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"};
}

#
# Return a list of virtual nodes on the given physical node.
#
sub VirtualNodes($$)
{
    my ($self, $plist) = @_;

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

    @$plist         = ();

    my $reservation = $self->Reservation();
    return 0
	if (!defined($reservation));

    my $node_id     = $self->node_id();
    my $exptidx     = $reservation->idx();
    my @result      = ();

    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($)
{
    my ($self) = @_;

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

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

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

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

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

    if (!defined($self->{"ATTRS"})) {
	my $query_result =
	    DBQueryWarn("select * from node_attributes ".
			"where node_id='$node_id'");

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

       	$self->{"ATTRS"} = {};
	while (my $row = $query_result->fetchrow_hashref()) {
	    my $key = $row->{'attrkey'};

	    $self->{"ATTRS"}->{$key} = $row;
	}
    }
    
    if (!exists($self->{"ATTRS"}->{$attrkey})) {
	$$pattrvalue = undef;
	return 0;
    }
    my $ref = $self->{"ATTRS"}->{$attrkey};

    $$pattrvalue = $ref->{'attrvalue'};
    $$pattrtype  = $ref->{'attrtype'}
        if (defined($pattrtype));

    return 0;
}

#
# 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(); }
sub isgeninode($)     { return NodeTypeInfo($_[0])->isgeninode(); }
sub isfednode($)      { return NodeTypeInfo($_[0])->isfednode(); }

#
# 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 @sets   = ();

    foreach my $key (keys(%{$argref})) {
	my $val = $argref->{$key};

	# Treat NULL special.
	push (@sets, "${key}=" . ($val eq "NULL" ? "NULL" : "'$val'"));
    }

    my $query = "update nodes set " . join(",", @sets) .
	" 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;
}

#
# 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;
}

#
# Look up all interfaces for a node, return list of objects.
#
sub AllInterfaces($$)
{
    my ($self, $pref) = @_;

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

    return Interface->LookupAll($self->node_id(), $pref);
}

#
# 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;
}

#
# 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. The argument is 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'};
    # Caller can specify uuids, otherwise we make them up.
    my @uuids   = @$rptr;

    my $node = Node->Lookup($pnode);
    if (!defined($node)) {
	print STDERR "*** CreateVnodes: No such node $pnode!\n";
	return -1;
    }

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

    #
    # 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;
    my $ipbase;
    if ($pnode =~ /^(.*\D)(\d+)$/) {
	$nodeprefix = $1;
	$nodenum    = $2;
	$ipbase     = $nodenum;
    }
    else {
	$nodeprefix = $pnode;
	$nodenum    = "";

	#
	# Determine ipbase from the control IP. 
	#
	my $interface = Interface->LookupControl($node);
	if (!defined($interface)) {
	    print STDERR "*** CreateVnodes: No control interface for $node\n";
	    return -1;
	}
	my $ctrlip = $interface->IP();
	if (!defined($ctrlip) || $ctrlip eq "") {
	    print STDERR "*** CreateVnodes: No control IP for $interface\n";
	    return -1;
	}
	my $tmp = ~inet_aton($CONTROL_NETMASK) & inet_aton($ctrlip);
	$ipbase = unpack("N", $tmp);
	if ($ipbase == 0 || $ipbase < 0 || $ipbase > 0x3fff) {
	    print STDERR
		"*** CreateVnodes: Bad ipbase '$ipbase' for $interface\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 + ($ipbase * 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($ipbase);
	while ($pnode2 > $nodenumlimit) {
	    $pnet++;
	    $pnode2 -= $nodenumlimit;
	}
	my $jailip = "${IPBASE1}.${pnet}.${pnode2}.${i}";

	my $uuid = (@uuids ? shift(@uuids) : NewUUID());
	if (!defined($uuid)) {
	    print STDERR "Could not generate a UUID!\n";
	    goto bad;
	}

	if ($verbose) {
	    print STDERR "Jail IP for $vnodeid is $jailip\n";
	    if ($impotent) {
		print STDERR
		    "Would allocate $vnodeid on $pnode ($vtype, $osid)\n";
	    }
	    else {
		print STDERR
		    "Allocating $vnodeid on $pnode ($vtype, $osid)\n";
	    }
	}

	my $statement =
	         "insert into nodes set ".
		 "       node_id='$vnodeid', " .
		 "       uuid='$uuid', " .
		 "       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");
}

#
# 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;
}

#
# Do a normal wakeonlan after power cycle. This is for laptops that like
# to go to sleep (especially while in PXEWAIT).
#
sub SimpleWOL($)
{
    my ($self) = @_;

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

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

    # XXX Must know the outgoing interface. Using the whol flag. Ick.
    my $query_result =
	DBQueryFatal("select iface from interfaces ".
		     "where node_id='boss' and whol=1");
    if ($query_result->numrows != 1) {
	warn "SimpleWOL: Could not get outgoing interface for boss node.\n";
	return -1;
    }
    my ($iface) = $query_result->fetchrow_array();

    #
    # Grab the control interface MAC for the node.
    #
    $query_result =
	DBQueryFatal("select mac from interfaces  ".
		     "where node_id='$node_id' and ".
		     "      role='" . TBDB_IFACEROLE_CONTROL() . "'");

    if ($query_result->numrows != 1) {
	warn "SimpleWOL: Could not get control interface MAC for $node_id.\n";
	return -1;
    }
    my ($mac) = $query_result->fetchrow_array();

    print "Doing a plain WOL to $node_id ($mac) via interface $iface\n";

    #
    # Do this a few times since the packet could get lost and
    # it seems to take a couple of packets to kick it.
    #
    for (my $i = 0; $i < 5; $i++) {
	system("$WOL $iface $mac");
	select(undef, undef, undef, 0.1);
    }
    select(undef, undef, undef, 5.0);
    return 0;
}

sub NewRootPasswd($)
{
    my ($self) = @_;

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

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

    # But only part of it.
    $hash = substr($hash, 0, 10);

    DBQueryWarn("replace into node_attributes set ".
		"  node_id='$node_id',".
		"  attrkey='root_password',attrvalue='$hash'")
	or return -1;

    return 0;
}

#
# Invoke OS selection. Currently we use this to reset to default boot,
# but might change later to take an argument.
#
sub SelectOS($;$)
{
    my ($self, $osid) = @_;

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

    my $node_id = $self->node_id();
    my $args    = (defined($osid) ? "$osid" : "-b");

    system("$OSSELECT $args $node_id");
    return -1
	if ($?);
    return 0;
}

#
# Set geni sliver idx,tmcd for the node. Called out of the geni libraries
# when the sliver that corresponds to the node has been created.
#
sub SetGeniSliverInfo($$;$)
{
    my ($self, $idx, $tmcd_redirect) = @_;

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

    my $args = {"genisliver_idx" => $idx};
    if (defined($tmcd_redirect)) {
	$args->{'tmcd_redirect'} =
	    ($tmcd_redirect eq "" ? "NULL" : $tmcd_redirect);
    }
    return $self->ModifyReservation($args);
}

#
# Get the geni info for a node.
#
sub GetGeniSliverInfo($$;$)
{
    my ($self, $idx, $tmcd_redirect) = @_;

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

    my $reservation = $self->ReservedTableEntry();
    return -1
	if (!defined($reservation));

    $$idx = $reservation->{'genisliver_idx'};
    $$tmcd_redirect = $reservation->{'tmcd_redirect'}
        if defined($tmcd_redirect);

    return 0;
}

#
# Set the status slot for a node.
#
sub SetStatus($$)
{
    my ($self, $status) = @_;

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

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

    return -1
	if (! DBQueryWarn("update node_status set status='$status' ".
			  "where node_id='$node_id'"));
    $self->{"DBROW"}->{'node_status'} = $status;
    return 0;
}

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

1;