os_setup.in

#!/usr/bin/perl -wT
use English;
use Getopt::Std;
require 'ctime.pl';

#
# Reboot the nodes in an experiment. The nodes table will already contain
# all the information. This script deals with possible disk reloading,
# rebooting, and waiting for nodes to come back alive before allowing
# experiment creation to continue.
#
# TODO: Reload disk images.
# 
# usage: os_setup <pid> <eid>
#
sub usage()
{
    print STDOUT "Usage: os_setup <pid> <eid>\n";
    exit(-1);
}
my  $optlist = "";

#
# Configure variables
#
my $TB		= "@prefix@";
my $DBNAME	= "@TBDBNAME@";
my $TBOPS       = "@TBOPSEMAIL@";
my $TESTMODE    = @TESTMODE@;
my $TFTP	= "/tftpboot";

#
# Testbed Support libraries
#
use lib "@prefix@/lib";
use libdb;
use libtestbed;

my $nodereboot	= "$TB/bin/node_reboot";
my $ping	= "/sbin/ping";
my $dbg		= 0;
my @nodes       = ();
my %osids       = ();
my %waitfor     = ();
my %canfail     = ();
my $db_result;
my @row;

#
# This stuff is BOGUS! Quick hack for paper deadline to make Jay happy.
# If Frisbee works, this might be appropriate.
#
my $doreloading = 0;
my $forcereload = 0;
my %reload      = ();
    
# un-taint path
$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin';
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

$| = 1; #Turn off line buffering on output

#
# Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments.
#
%options = ();
if (! getopts($optlist, \%options)) {
    usage();
}
if (@ARGV != 2) {
    usage();
}
my $pid = $ARGV[0];
my $eid = $ARGV[1];

#
# Untaint args.
#
if ($pid =~ /^([-\@\w]+)$/) {
    $pid = $1;
}
else {
    die("Bad data in pid: $pid.");
}
if ($eid =~ /^([-\@\w]+)$/) {
    $eid = $1;
}
else {
    die("Bad data in eid: $eid.");
}

#
# Figure out who called us. Only root, people with admin status
# in the DB, or the owner of the experiment can run this script.
#
if ($UID && !TBAdmin($UID)) {
    my ($me) = getpwuid($UID)
	or die "$UID not in passwd file";

    my $leader = ExpLeader($pid, $eid);

    if ($me ne $leader) {
	die("os_setup: You must be root or a TB administrator\n");
    }
}

#
# Get the set of nodes, as well as the nodes table information for them.
#
$db_result =
    DBQueryFatal("select * from nodes left join reserved on ".
		 "nodes.node_id=reserved.node_id ".
		 "where reserved.pid='$pid' and reserved.eid='$eid'");

if ($db_result->numrows < 1) {	
    die("There are no nodes assigned to experiment '$eid' in project '$pid'.");
}

for ($i = 0; $i < $db_result->numrows; $i++) {
    my %row      = $db_result->fetchhash();
    my $node     = $row{'node_id'};
    my $osid     = $row{'def_boot_osid'};
    my $bootpath = 0;

    push(@nodes, $node);
    $osids{$node} = $osid;

    #
    # Make sure the files specified in the paths exist. We mount the
    # user tftp directory on boss node, so we can ignore the IP address,
    # and just check the path directly. 
    #
    if (defined($row{'def_boot_path'})) {
	my $path = $row{'def_boot_path'};

	if ($path ne "") {
	    my $ip   = 0;

	    # Split out IP address if it exists.
	    if ($path =~ /^([0-9\.]+):(\/.*)$/) {
		$ip   = $1;
		$path = $2;
	    }

	    # Path must begin with $TFTP
	    if (! ($path =~ /^\/$TFTP\//)) {
		die("*** File $path for node $node must reside in $TFTP\n");
	    }

	    if (! -f $path) {
		die("*** File $path for node $node does not exist!");
	    }
	    $bootpath = 1;
	}
    }
    if (defined($row{'next_boot_path'})) {
	my $path = $row{'next_boot_path'};

	if ($path ne "") {
	    my $ip   = 0;

	    # Split out IP address if it exists.
	    if ($path =~ /^([0-9\.]+):(\/.*)$/) {
		$ip   = $1;
		$path = $2;
	    }

	    # Path must begin with $TFTP
	    if (! ($path =~ /^\/$TFTP\//)) {
		die("*** File $path for node $node must reside in $TFTP\n");
	    }

	    if (! -f $path) {
		die("*** File $path for node $node does not exist!");
	    }
	}
    }

    #
    # XXX - Check for existence of the delta files. We do this here
    # cause its easier than looking for a failure later, when the node
    # tries to install the delta. Not a general solution though. Needs
    # more thought.
    #
    foreach my $delta (split(":", $row{'deltas'})) {
	if (! -f $delta) {
	    die("*** Delta file $delta for node $node does not exist!");
	}
    }
    #
    # XXX - Ditto for RPMs.
    #
    foreach my $rpm (split(":", $row{'rpms'})) {
	if (! -f $rpm) {
	    die("*** RPM $rpm for node $node does not exist!");
	}
    }
    
    #
    # XXX - Ditto for tarfiles.
    #
    foreach my $tarspec (split(":", $row{'tarballs'})) {
	my ($dir, $tar) = split(" ", $tarspec);
	
	if (! -f $tar) {
	    die("*** Tarfile $tar for node $node does not exist!");
	}
    }

    #
    # If there is a path specified, then we don't worry anymore about it.
    # The user must know what is going on. The OSID might have a path
    # associated with it, which means the same thing; we don't worry about
    # it. 
    #
    if (! $bootpath) {
	#
	# These checks are not necessary if the front end and web page
	# are doing the right thing, but lets be careful anyway.
	# 
	if (! $osid) {
	    die("*** $node has no bootpath and no def_boot_osid set!\n");
	}

	#
	# Grab the info for this OSID. This is part of the image check.
	#
	my $osid_result =
	    DBQueryFatal("select * from os_info where osid='$osid'");
	
	if ($osid_result->numrows == 0) {
	    die("*** No such OSID $osid is defined!\n");
	}
	
	my %osid_row   = $osid_result->fetchhash();

	#
	# If there is an actual path, its an OSKit kernel not an image.
	# 
	if (! defined($osid_row{'path'}) || $osid_row{'path'} eq "") {
	    #
	    # Not an OSKit kernel.
	    # Make sure this OSID is actually loaded on the machine. 
	    #
	    my $p_result =
		DBQueryFatal("select * from partitions ".
			     "where node_id='$node' and osid='$osid'");

	    #
	    # If not loaded, then see if the user was looking for the generic
	    # name of the OS that is loaded. 
	    # 
	    if ($p_result->numrows == 0) {
		#
		# If its a specific Version, and its not loaded on the machine,
		# its currently an error. Later we might reload.
		#
		if (defined($osid_row{'version'}) &&
		    $osid_row{'version'} ne "") {
		    die("*** OSID $osid is not currently loaded on $node!\n");
		}

		#
		# A non-specific version. Try to map it.
		# 
		my $o_result =
		    DBQueryFatal("select o1.* from os_info as o1 ".
				 "left join partitions as p ".
				 "  on o1.osid=p.osid ".
				 "left join os_info as o2 ".
				 "  on o2.OS=o1.OS ".
				 "where p.node_id='$node' ".
				 "  and o2.osid='$osid'");

		if ($o_result->numrows == 0) {
		    die("*** $0:\n".
			"    No mapping can be made for $osid on $node!\n".
			"    Perhaps the disk needs reloading?\n");
		}
		else {
		    my %o_row  = $o_result->fetchhash();
		    my $n_osid = $o_row{'osid'};

		    print "Mapping $osid on $node to $n_osid.\n";
		    DBQueryFatal("update nodes set def_boot_osid='$n_osid' ".
				 "where node_id='$node'");
		    $osids{$node} = $n_osid;
		}
	    }
	}
    }
    
    #
    # If pingable, then the node is "waitable".
    #
    if (OSFeatureSupported($osids{$node}, "ping")) {
	$waitfor{$node} = 1;
    }
    else {
	$waitfor{$node} = 0;
    }

    #
    # Set the canfail bit. Currently, sharks are always canfail=1.
    # Will come from DB at some point.
    #
    if ($row{'type'} eq "dnard") {
	$canfail{$node} = 1;
    }
    else {
	$canfail{$node} = 0;
    }
    
    print STDOUT "$node - $osids{$node} - $waitfor{$node} - $canfail{$node}\n"
	if $dbg;
}

#
# Fire off a mass reboot. The reboot script does this in parallel, so
# no need to create any new children here. We just wait until it exits,
# which means all the nodes are actually rebooting.
#
if (!$TESTMODE) {
  if (system("$nodereboot @nodes")) {
    die("*** Failed to reboot some nodes!");
  }
}

print STDOUT "Waiting for testbed nodes to finish rebooting ...\n";

my $waitstart = time;

#
# Now lets wait for them to come back alive.
#
foreach my $node ( @nodes ) {
    my $failmesg;
    
    #
    # Don't bother to wait for nodes that are running foreign OSs since
    # we are not going to deal with them anyway later in the process.
    #
    if ($waitfor{$node} == 0) {
	print STDOUT "Not waiting for $node to come alive. Foreign OS.\n";
	SetNodeBootStatus($node, NODEBOOTSTATUS_UNKNOWN);
	next;
    }	

    if (WaitTillAlive($node) == 0) {
	print STDOUT "$node is alive and well\n";
	SetNodeBootStatus($node, NODEBOOTSTATUS_OKAY);
	next;
    }
    SetNodeBootStatus($node, NODEBOOTSTATUS_FAILED);

    print STDOUT "*** Oops, $node may be down. ".
	         "This has been reported to testbed-ops.\n";

    if ($canfail{$node}) {
	# Send mail to testbed-ops and to the user about it.
	my ($user) = getpwuid($UID);
	
	SENDMAIL($user, "TESTBED: Node $node is down",
		 "Node $node in pid/eid $pid/$eid appears to be dead.\n\n".
		 "Your experiment will continue to run since this failure\n".
		 "is nonfatal, although you might encounter other problems\n".
		 "if your experiment depends explicitly on this node.\n".
		 "You should terminate this experiment if it cannot ".
		 "tolerate this failure.\n\n".
		 "Testbed Operations has also been notified so they can ".
		 "investigate.\n\n".
		 "Thanks\n".
		 "Testbed Operations\n",
		 0,
		 "Cc: $TBOPS");

	print STDERR "*** Continuing with experiment setup anyway ...\n";
    }
    else {
	# Reserve it to down experiment.
	MarkNodeDown($node);

	# Send mail to testbed-ops about it
	SENDMAIL($TBOPS, "TESTBED: Node $node is down",
		 "Node $node in pid/eid $pid/$eid appears to be dead.\n\n".
		 "Please look into this matter. $node has been reserved\n".
		 "by the Testbed until this matter has been resolved.\n\n".
		 "Thanks\n".
		 "Testbed Operations\n");

	die("*** Experiment will be now be terminated automatically.");
    }
}

print STDOUT "OS Setup Done!\n";
exit 0;

#
# Wait for a node to come back alive.
# 
sub WaitTillAlive {
    my ($pc) = @_;

    print STDERR "Waiting for $pc to come alive\n" if $dbg;
    
    #
    # Seems like a long time to wait, but it ain't!
    # 
    my $maxwait = (60 * 6);
    if ($reload{$pc}) {
	$maxwait += (60 * 5);
    }

    #
    # Start a counter going, relative to the time we rebooted the first
    # node. 
    # 
    my $waittime  = 0;
    my $minutes   = 0;

    #
    # Sigh, a long ping results in the script waiting until all the
    # packets are sent from all the pings, before it will exit. So,
    # loop doing a bunch of shorter pings.
    #
    while (1) {
	system("$ping -q -c 4 -t 4 $pc >/dev/null 2>&1");
	$status = $? >> 8;

	#
	# Returns 0 if any packets are returned. Returns 2 if pingable
	# but no packets are returned. Other non-zero error codes indicate
	# other problems.  Any non-zero return indicates "not pingable" to us.
	# 
	if (! $status) {
	    print STDERR "$pc alive and well\n" if $dbg;
	    return 0;
	}
	$waittime = time - $waitstart;
	if ($waittime > $maxwait) {
	    print "$pc appears dead; its been ",
	    (int ($waittime / 60))," minutes since reload started.\n";
	    return 1;
	}
	if (int($waittime / 60) > $minutes) {
	    $minutes = int($waittime / 60);
	    print "Still waiting for $pc - its been $minutes minute(s)\n";
	}
    }
}