plabmonitord.in

#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
# Copyright (c) 2000-2003, 2008 University of Utah and the Flux Group.
# All rights reserved.
#
use English;
use Getopt::Std;
use POSIX qw(strftime);
use POSIX ":sys_wait_h";

#
# Monitor the condition of plab nodes by continually trying to setup/teardown
# vnodes on pnodes that are in hwdown. The goal is to move the pnodes out
# of hwdown so that the vnodes on that pnode will be considered okay for
# experiments (see ptopgen). 
# 
sub usage()
{
    print STDERR "Usage: plabmonitord [-dS] <plcname>\n";
    print STDERR "  -d   Debug mode.\n";
    print STDERR "  -S   Run WITHOUT reading monitor state from database;\n";
    print STDERR "         new state will still be written (default is to" .
	" load state).\n";
    exit(-1);
}
my $optlist = "dS";
my $debug   = 0;
my $stateful = 1;
my $plcname = '';
my $plctype = '';

#
# Only real root can call this.
# 
if ($UID != 0) {
    print STDERR "You must be root to run this script!\n";
    exit(-1);
}

#
# Configure variables
#
my $TB		= "@prefix@";
my $TBOPS       = "@TBOPSEMAIL@";
my $TBAUTOMAIL  = "@TBAUTOMAILEMAIL@";

# un-taint path
$ENV{'PATH'} = "/bin:/usr/bin:/usr/local/bin:$TB/sbin:$TB/bin";
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

$ENV{'WITH_TB_ADMIN_PRIVS'} = '1';

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

# Load the Testbed support stuff.
use lib "@prefix@/lib";
use libdb;
use libtestbed;
use libplabmon;

# Grab stuff to interpret the plab_nodehist table
use libplabnodehist;

# Load pool libraries
use plabmon_badpool;
use plabmon_goodpool;

# Be careful not to exit on transient error
$libdb::DBQUERY_MAXTRIES = 30;

# Variables from libdb.
my $PLABDOWN_PID    = PLABDOWN_PID();
my $PLABDOWN_EID    = PLABDOWN_EID();
my $PLABHOLDING_PID = PLABHOLDING_PID();
my $PLABHOLDING_EID = PLABHOLDING_EID();

#
# Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments.
#
my %options = ();
if (! getopts($optlist, \%options)) {
    usage();
}
if (defined($options{"d"})) {
    $debug = 1;
}
if (defined($options{'S'})) {
    $stateful = 0;
}

#
# Grab the supplied plcname and ensure we know about it.
#
if (scalar(@ARGV) == 1) {
    $plcname = shift(@ARGV);

    # XXX need to escape this better
    if (!($plcname =~ /^[\w\d\-]+$/)) {
	print STDERR "plcname has illegal characters: $plcname\n";
	usage();
    }

    my $qres = DBQueryFatal("select plc_name,node_type" . 
			    " from plab_plc_info" . 
			    " where plc_name='$plcname'");
    if (!$qres->numrows()) {
	print STDERR "Unknown plc $plcname!\n";
	exit(-62);
    }

    ($plcname,$plctype) = $qres->fetchrow_array();
}
else {
    print STDERR "Must supply plcname argument!\n";
    usage();
}

my $IGNORENODES = "@prefix@/etc/plab/plabmonitord.$plcname.ignore";

#
# Function prototypes
#
sub updatenodepool($);
sub fatal($);

#
# Global vars
#
my $LOGFILE      = "$TB/log/plabmonitord-$plcname";
my $PIDFILE      = "/var/run/plabmonitord-$plcname.pid";
my $MINSLEEP     = 2;    # Sleep for no less than 2 seconds.
my $MAXWINSIZE   = 40;   # Degree of parallelization.
my $MAXSLEEPTIME = 600;  # Don't ever sleep for longer than this - we need
                         #  to wake up once in a while!
my $CHILLTIME    = 5;    # How long to wait after processing expirations.
my $NEVER        = 0;    # "Never" in seconds since the Epoch.

my $MAXLA        = 8;    # Don't let the system load get out of hand.

# Keep only this many (success,fail) sequences in memory at a 
# time (they get saved in the db anyway... we just need to minimize cost
# across fork()s)
my $MAX_STATE_SEQUENCES = 10;

#
# daemonize
#
if (!$debug) {
    if (TBBackGround($LOGFILE)) {
        exit(0);
    }
}

#
# Write our pid into the pid file so we can be killed later. 
#
system("echo '$PID' > $PIDFILE") == 0 or
    die("*** $0:\n".
	"    Could not create $PIDFILE!");

# pid -> pool mapping; passed in as param to pool setup function.
my %chpid2pool = ();

print "Plab Monitor Daemon ($plcname) starting... pid $$, at ".`date`;

#
# Open the status log.  This will be used by the pools to log
# node success/fail results, and other status info.
#
OpenLog(STATUSLOG($plcname), STATUSLOGPATH($plcname)) 
    or die "Can't open status log!";

#
# Create the node pools.
#
my $badpool  = plabmon_badpool->new($plcname,
				    "bad", 
                                    $PLABDOWN_PID, 
                                    $PLABDOWN_EID, 
                                    \%chpid2pool);
my $goodpool = plabmon_goodpool->new($plcname,
				     "good", 
                                     $PLABHOLDING_PID, 
                                     $PLABHOLDING_EID, 
                                     \%chpid2pool);
@allpools = ($badpool, $goodpool);

#
# Handle termination/hangup signals
#
sub termsig($) {
    my $signame = shift;
    print "*** $0: Received $signame - exiting.\n";

    # Whack the whole process group (except top level parent!)
    local $SIG{TERM} = 'IGNORE';
    kill("TERM", -$$);

    while (wait() > 0) {};

    unlink($PIDFILE);

    exit -1;
}

$SIG{TERM} = \&termsig;
$SIG{HUP}  = \&termsig;
$SIG{INT}  = \&termsig;

#
# Load state from plab_nodehist.  Down in updatenodepool, we load each node's 
# consecsuccess or consecfailure vars from this hash, and then we delete the 
# node's history entry from this hashref.
# If we ever need the history to hang around longer, have to use a better way
# to only set consec* vars once (easy).
#
my $seqref = {};
if ($stateful) {
    $seqref = getNodeHistSequences($plcname);
}

#
# Main loop: grind around looking for nodes to check in the various
# pools.  Sleep until next node is ready to be processed.
#
my $windowsize = 0;
my $i = 0;
while (1) {
    my $now = time();
    my $sleeptime = $MAXSLEEPTIME;
    my $reappool;
    my $lastwindowsize = -1;

    # Update pool membership.
    foreach my $pool (@allpools) {
        updatenodepool($pool);
    }

    # Check pools and fire off new checks as window room permits.  If no
    # new node tests were added since the last run through the pools, then
    # bail out.
    my $curLA = getLA();
    while ($windowsize < $MAXWINSIZE && $windowsize != $lastwindowsize
           && $curLA < $MAXLA) {
        $lastwindowsize = $windowsize;
        $curLA = getLA();
        foreach my $pool (@allpools) {
            # if pool still has nodes to test, get them going.
            if ($pool->getnextchecktime() <= $now) {
		# Only increment the window if we successfully launched a 
		# process.
		if (!$pool->checknextnode()) {
		    $windowsize++;
		}
            }
        }
    }

    # Now adjust the sleep time according to the next node service 
    # time.  The next service time is defined as the soonest time in 
    # the future that a node in any of the pools needs attention 
    # (either to be checked, or to be processed as a result of an 
    # already running check).
    foreach my $pool (@allpools) {
        my $nextservicetime = $pool->getnextservicetime();
        my $servicediff = $nextservicetime - $now;
        $servicediff = $servicediff > $MINSLEEP ? $servicediff : $MINSLEEP;
        $sleeptime = MIN($servicediff, $sleeptime);
    }

    # Go to sleep waiting for the next node to process.
    print "Monitor going to sleep for $sleeptime seconds ".
          "(winsize: $windowsize, LA: $curLA).\n";

    sleep($sleeptime);

    #$now = time(); # Must reset $now after sleep.

    # Handle any children that have exited.
    while((my $chpid = waitpid(-1, WNOHANG)) > 0) {
        my $chstat = $?;
        next if !defined($chpid2pool{$chpid});
        $reappool = $chpid2pool{$chpid};
        delete $chpid2pool{$chpid};
        if ($reappool->processchild($chpid, $chstat)) {
            $windowsize--;
        }
    }

    # Look for expired processes.  Calling checkexpiration on a pool
    # has the side effect of checking for ISUP (or ISUP expiration) for
    # any nodes pending thusly in the pool.  The return value is the
    # number of nodes that the pool has finished processing (if any).
    # Decrement the windowsize appropriately.
    foreach my $pool (@allpools) {
        my $numfinished = $pool->checkexpiration();
        $windowsize -= $numfinished;
    }

    # We may have just fired off a bunch of kills, so chill for a bit to
    # let things quiesce.
    sleep($CHILLTIME);
}

#
# Go through the PID/EID associated with the pool and grab any new nodes
# that have appeared.
#
# XXX: Also, remove nodes that have disappeared (wrong to do here).
#
sub updatenodepool($) {
    my $pool = shift;
    my $poolpid = $pool->{'PID'};
    my $pooleid = $pool->{'EID'};
    my $poolpnodes = $pool->{'PNODES'};

    my $now = time();

    print "Updating node membership in pool: $pool->{'NAME'}\n";

    # check our ignore file, and do nothing with these nodes:
    my %ignore = ();
    if ( -e "$IGNORENODES" ) {
	open(IFD,"$IGNORENODES")
	    or die "could not open $IGNORENODES!";
	while (my $line = <IFD>) {
	    chomp($line);
	    if ($line =~ /^[\d\w\-\.]+$/) {
		$ignore{$line} = 1;
	    }
	}
	close(IFD);
    }

    # XXX: checking node type like this is mighty expensive!  Can't we just 
    # check the base type for this plc?
    # XXX: need to change everything to deal with vnodes rather than pnodes.
    #
    # NOTE: in the query below, we filter by plctype, but append phys to the 
    # type string!  In libplab, when nodes are added to the db, we also 
    # auto-append "phys" to create the phys category of the plab type.
    my $qres = 
        DBQueryFatal("select r.node_id from reserved as r ".
                     "left join nodes as n on n.node_id=r.node_id ".
                     "left join node_types as nt on n.type = nt.type ".
                     "where r.pid='$poolpid' and ".
                     "      r.eid='$pooleid' and ".
                     "      nt.isplabphysnode = 1 and ".
		     "      nt.type='${plctype}phys'".
                     "order by rand()");

    if ($qres and $qres->num_rows()) {
        # Find any new nodes that need to be added and add them.
        while (my @row = $qres->fetchrow_array()) {
            my $pnodename = $row[0];

	    if (exists($ignore{$pnodename})) {
		next;
	    }

            if (!exists $poolpnodes->{$pnodename} ) {
                print "Adding $pnodename to pool: $pool->{'NAME'}\n";
                $poolpnodes->{$pnodename} = {'name'           => $pnodename,
                                             'entertime'      => $now,
                                             'lastcheckstart' => $NEVER,
                                             'nextchecktime'  => $now + int(rand(120)),
                                             'lastfailtime'   => $NEVER,
                                             'consecfails'    => 0,
                                             'consecsuccess'  => 0,
                                             'setupfails'     => 0};

		if (exists($seqref->{$pnodename})) {
		    my $lseqtype = $seqref->{$pnodename}{'lastseq'}->[0];
		    my $lseqcount = $seqref->{$pnodename}{'lastseq'}->[1]->[2];

		    if ($lseqtype eq 'success') {
			$poolpnodes->{$pnodename}{'consecsuccess'} = $lseqcount;
		    }
		    elsif ($lseqtype eq 'failure') {
			$poolpnodes->{$pnodename}{'consecfails'} = $lseqcount;
		    }

		    $pool->calcnextcheck($poolpnodes->{$pnodename});

		    delete $seqref->{$pnodename};

		    print "Loaded nodehist for $pnodename ($lseqtype/$lseqcount).\n";
		    my $nct = $poolpnodes->{$pnodename}->{'nextchecktime'};
		    print "calcnextcheck($pnodename) = ".($nct-time())."\n";
		}

                Log(STATUSLOG($plcname), "plabmonitord, $pnodename, addtopool, ".
                    "nostat, node added to pool $pool->{'NAME'}");
            }
            # Mark this node as still in the pool as of this check.
            $poolpnodes->{$pnodename}->{'updtime'} = $now;
        }
    }

    # Prune out nodes that no longer appear in the pool query.
    # XXX: A node entry should never disappear, and should be
    #      moved explicitly from one pool to another.
    foreach my $pnodename (keys %{$poolpnodes}) {
        if ($poolpnodes->{$pnodename}->{'updtime'} != $now) {
            print "Removing $pnodename from pool: $pool->{'NAME'}\n";
            delete $poolpnodes->{$pnodename};
            Log(STATUSLOG($plcname), "plabmonitord, $pnodename, removefrompool, ".
                "nostat, node removed from pool $pool->{'NAME'}");
        }
    }

    return;
}

#
# send mail with given message, and exit (also printing message).
#    
sub fatal($)
{
    local($msg) = $_[0];

    SENDMAIL($TBOPS, "Plab Monitor Died", $msg, $TBOPS);
    die($msg);
}