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 $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 %osid        = ();
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      = ();
my $osload	= "$TB/bin/os_load";
    
# 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'};

    push(@nodes, $node);
    $osid{$node} = $row{'def_boot_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 (! -e $path) {
		die("File $path for node $node does not exist!");
	    }
	}
    }
    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 (! -e $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 (! -e $delta) {
	    die("Delta file $delta for node $node does not exist!");
	}
    }
    #
    # XXX - Ditto for RPMs.
    #
    foreach my $rpm (split(":", $row{'rpms'})) {
	if (! -e $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 (! -e $tar) {
	    die("Tarfile $tar for node $node does not exist!");
	}
    }
    
    #
    # If pingable, then the node is "waitable".
    #
    if (OSFeatureSupported($osid{$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 "shark") {
	$canfail{$node} = 1;
    }
    else {
	$canfail{$node} = 0;
    }
    
    print STDOUT "$node - $osid{$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 (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 "$node may be down. This has been reported to testbed-ops.\n";
    print STDOUT "Please end this experiment, and try again.\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 "*** Oops, $node did not come back alive!\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("*** Oops, $node did not come back alive!\n");
    }
}

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 * 4);
    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";
	}
    }
}