plabmonitord.in 12 KB
Newer Older
1
2
3
#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
4
# Copyright (c) 2000-2003, 2008 University of Utah and the Flux Group.
5
6
7
8
9
# All rights reserved.
#
use English;
use Getopt::Std;
use POSIX qw(strftime);
Kirk Webb's avatar
   
Kirk Webb committed
10
use POSIX ":sys_wait_h";
11
12
13
14
15
16
17
18
19

#
# 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()
{
20
    print STDERR "Usage: plabmonitord [-dS] <plcname>\n";
21
22
23
24
    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";
25
26
    exit(-1);
}
27
my $optlist = "dS";
28
my $debug   = 0;
29
my $stateful = 1;
30
31
my $plcname = '';
my $plctype = '';
32
33
34
35
36
37
38
39
40
41
42
43
44
45

#
# 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@";
46
my $TBAUTOMAIL  = "@TBAUTOMAILEMAIL@";
47
48
49
50
51
52
53
54
55
56
57
58
59
60

# 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;
Kirk Webb's avatar
   
Kirk Webb committed
61
use libplabmon;
62

63
64
65
# Grab stuff to interpret the plab_nodehist table
use libplabnodehist;

Kirk Webb's avatar
   
Kirk Webb committed
66
67
68
69
# Load pool libraries
use plabmon_badpool;
use plabmon_goodpool;

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

# Variables from libdb.
Kirk Webb's avatar
   
Kirk Webb committed
74
75
my $PLABDOWN_PID    = PLABDOWN_PID();
my $PLABDOWN_EID    = PLABDOWN_EID();
76
77
78
79
80
81
82
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.
#
Kirk Webb's avatar
   
Kirk Webb committed
83
my %options = ();
84
85
86
87
88
89
if (! getopts($optlist, \%options)) {
    usage();
}
if (defined($options{"d"})) {
    $debug = 1;
}
90
91
92
if (defined($options{'S'})) {
    $stateful = 0;
}
93

94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
#
# 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 =~ /\'/) {
	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();

    # tell other libplabmon users, sigh
117
    libplabmon::setPLCName($plcname);
118
119
120
121
122
123
}
else {
    print STDERR "Must supply plcname argument!\n";
    usage();
}

124
#
Kirk Webb's avatar
   
Kirk Webb committed
125
# Function prototypes
126
#
Kirk Webb's avatar
   
Kirk Webb committed
127
sub updatenodepool($);
128
129
sub fatal($);

Kirk Webb's avatar
   
Kirk Webb committed
130
#
Kirk Webb's avatar
   
Kirk Webb committed
131
# Global vars
Kirk Webb's avatar
   
Kirk Webb committed
132
#
133
134
my $LOGFILE      = "$TB/log/plabmonitord-$plcname";
my $PIDFILE      = "/var/run/plabmonitord-$plcname.pid";
Kirk Webb's avatar
   
Kirk Webb committed
135
136
137
138
139
140
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.
Kirk Webb's avatar
   
Kirk Webb committed
141

142
my $MAXLA        = 8;    # Don't let the system load get out of hand.
Kirk Webb's avatar
   
Kirk Webb committed
143

144
145
146
147
148
# 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;

Kirk Webb's avatar
   
Kirk Webb committed
149
150
151
152
#
# daemonize
#
if (!$debug) {
Kirk Webb's avatar
   
Kirk Webb committed
153
    if (TBBackGround($LOGFILE)) {
Kirk Webb's avatar
   
Kirk Webb committed
154
155
156
157
        exit(0);
    }
}

Kirk Webb's avatar
   
Kirk Webb committed
158
159
160
161
162
163
164
#
# 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!");

165
# pid -> pool mapping; passed in as param to pool setup function.
Kirk Webb's avatar
   
Kirk Webb committed
166
167
my %chpid2pool = ();

168
print "Plab Monitor Daemon ($plcname) starting... pid $$, at ".`date`;
Kirk Webb's avatar
   
Kirk Webb committed
169

Kirk Webb's avatar
   
Kirk Webb committed
170
171
172
173
#
# Open the status log.  This will be used by the pools to log
# node success/fail results, and other status info.
#
174
175
OpenLog(STATUSLOG($plcname), STATUSLOGPATH($plcname)) 
    or die "Can't open status log!";
Kirk Webb's avatar
   
Kirk Webb committed
176

177
#
Kirk Webb's avatar
   
Kirk Webb committed
178
# Create the node pools.
179
#
Kirk Webb's avatar
   
Kirk Webb committed
180
181
182
183
184
185
186
187
188
my $badpool  = plabmon_badpool->new("bad", 
                                    $PLABDOWN_PID, 
                                    $PLABDOWN_EID, 
                                    \%chpid2pool);
my $goodpool = plabmon_goodpool->new("good", 
                                     $PLABHOLDING_PID, 
                                     $PLABHOLDING_EID, 
                                     \%chpid2pool);
@allpools = ($badpool, $goodpool);
Kirk Webb's avatar
   
Kirk Webb committed
189

Kirk Webb's avatar
   
Kirk Webb committed
190
191
192
193
194
195
#
# Handle termination/hangup signals
#
sub termsig($) {
    my $signame = shift;
    print "*** $0: Received $signame - exiting.\n";
Kirk Webb's avatar
   
Kirk Webb committed
196

Kirk Webb's avatar
   
Kirk Webb committed
197
198
199
    # Whack the whole process group (except top level parent!)
    local $SIG{TERM} = 'IGNORE';
    kill("TERM", -$$);
200

Kirk Webb's avatar
   
Kirk Webb committed
201
202
    while (wait() > 0) {};

Kirk Webb's avatar
   
Kirk Webb committed
203
204
    unlink($PIDFILE);

Kirk Webb's avatar
   
Kirk Webb committed
205
    exit -1;
Kirk Webb's avatar
Kirk Webb committed
206
}
207

Kirk Webb's avatar
   
Kirk Webb committed
208
209
210
211
$SIG{TERM} = \&termsig;
$SIG{HUP}  = \&termsig;
$SIG{INT}  = \&termsig;

212
213
214
215
216
217
218
#
# 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).
#
219
220
my $seqref = {};
if ($stateful) {
221
    $seqref = getNodeHistSequences($plcname);
222
}
223

Kirk Webb's avatar
Kirk Webb committed
224
#
Kirk Webb's avatar
   
Kirk Webb committed
225
226
# Main loop: grind around looking for nodes to check in the various
# pools.  Sleep until next node is ready to be processed.
Kirk Webb's avatar
Kirk Webb committed
227
#
Kirk Webb's avatar
   
Kirk Webb committed
228
my $windowsize = 0;
229
my $i = 0;
Kirk Webb's avatar
   
Kirk Webb committed
230
231
232
233
while (1) {
    my $now = time();
    my $sleeptime = $MAXSLEEPTIME;
    my $reappool;
Kirk Webb's avatar
   
Kirk Webb committed
234
    my $lastwindowsize = -1;
Kirk Webb's avatar
   
Kirk Webb committed
235

Kirk Webb's avatar
   
Kirk Webb committed
236
    # Update pool membership.
Kirk Webb's avatar
   
Kirk Webb committed
237
238
    foreach my $pool (@allpools) {
        updatenodepool($pool);
Kirk Webb's avatar
   
Kirk Webb committed
239
240
241
242
243
    }

    # 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.
Kirk Webb's avatar
   
Kirk Webb committed
244
245
246
    my $curLA = getLA();
    while ($windowsize < $MAXWINSIZE && $windowsize != $lastwindowsize
           && $curLA < $MAXLA) {
Kirk Webb's avatar
   
Kirk Webb committed
247
        $lastwindowsize = $windowsize;
Kirk Webb's avatar
   
Kirk Webb committed
248
        $curLA = getLA();
Kirk Webb's avatar
   
Kirk Webb committed
249
250
251
        foreach my $pool (@allpools) {
            # if pool still has nodes to test, get them going.
            if ($pool->getnextchecktime() <= $now) {
252
253
254
255
256
		# Only increment the window if we successfully launched a 
		# process.
		if (!$pool->checknextnode()) {
		    $windowsize++;
		}
Kirk Webb's avatar
   
Kirk Webb committed
257
            }
Kirk Webb's avatar
   
Kirk Webb committed
258
259
260
        }
    }

Kirk Webb's avatar
   
Kirk Webb committed
261
262
263
264
265
266
267
268
269
270
271
272
    # 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);
    }

Kirk Webb's avatar
   
Kirk Webb committed
273
    # Go to sleep waiting for the next node to process.
Kirk Webb's avatar
   
Kirk Webb committed
274
275
276
    print "Monitor going to sleep for $sleeptime seconds ".
          "(winsize: $windowsize, LA: $curLA).\n";

Kirk Webb's avatar
   
Kirk Webb committed
277
278
    sleep($sleeptime);

Kirk Webb's avatar
   
Kirk Webb committed
279
280
    #$now = time(); # Must reset $now after sleep.

Kirk Webb's avatar
   
Kirk Webb committed
281
    # Handle any children that have exited.
Kirk Webb's avatar
   
Kirk Webb committed
282
283
284
285
286
287
288
    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--;
Kirk Webb's avatar
   
Kirk Webb committed
289
        }
290
    }
Kirk Webb's avatar
Kirk Webb committed
291

Kirk Webb's avatar
   
Kirk Webb committed
292
293
    # Look for expired processes.  Calling checkexpiration on a pool
    # has the side effect of checking for ISUP (or ISUP expiration) for
Kirk Webb's avatar
   
Kirk Webb committed
294
295
296
    # 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.
Kirk Webb's avatar
   
Kirk Webb committed
297
    foreach my $pool (@allpools) {
Kirk Webb's avatar
   
Kirk Webb committed
298
299
        my $numfinished = $pool->checkexpiration();
        $windowsize -= $numfinished;
Kirk Webb's avatar
Kirk Webb committed
300
301
    }

Kirk Webb's avatar
   
Kirk Webb committed
302
303
304
    # We may have just fired off a bunch of kills, so chill for a bit to
    # let things quiesce.
    sleep($CHILLTIME);
305
306
}

Kirk Webb's avatar
Kirk Webb committed
307
#
Kirk Webb's avatar
   
Kirk Webb committed
308
309
310
311
# 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).
Kirk Webb's avatar
Kirk Webb committed
312
#
Kirk Webb's avatar
   
Kirk Webb committed
313
314
315
316
317
318
319
320
321
322
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";

323
324
    # XXX: checking node type like this is mighty expensive!  Can't we just 
    # check the base type for this plc?
Kirk Webb's avatar
   
Kirk Webb committed
325
    # XXX: need to change everything to deal with vnodes rather than pnodes.
326
327
328
329
    #
    # 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.
Kirk Webb's avatar
   
Kirk Webb committed
330
331
332
333
334
335
    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 ".
336
337
                     "      nt.isplabphysnode = 1 and ".
		     "      nt.type='${plctype}phys'".
Kirk Webb's avatar
   
Kirk Webb committed
338
                     "order by rand()");
Kirk Webb's avatar
   
Kirk Webb committed
339
340
341
342
343
344
345
346
347
348

    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 $poolpnodes->{$pnodename} ) {
                print "Adding $pnodename to pool: $pool->{'NAME'}\n";
                $poolpnodes->{$pnodename} = {'name'           => $pnodename,
                                             'entertime'      => $now,
                                             'lastcheckstart' => $NEVER,
Kirk Webb's avatar
   
Kirk Webb committed
349
                                             'nextchecktime'  => $now + int(rand(120)),
Kirk Webb's avatar
   
Kirk Webb committed
350
351
352
353
                                             'lastfailtime'   => $NEVER,
                                             'consecfails'    => 0,
                                             'consecsuccess'  => 0,
                                             'setupfails'     => 0};
Kirk Webb's avatar
   
Kirk Webb committed
354

355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
		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";
		}

375
                Log(STATUSLOG($plcname), "plabmonitord, $pnodename, addtopool, ".
Kirk Webb's avatar
   
Kirk Webb committed
376
                    "nostat, node added to pool $pool->{'NAME'}");
Kirk Webb's avatar
   
Kirk Webb committed
377
378
379
380
            }
            # Mark this node as still in the pool as of this check.
            $poolpnodes->{$pnodename}->{'updtime'} = $now;
        }
Kirk Webb's avatar
Kirk Webb committed
381
    }
Kirk Webb's avatar
   
Kirk Webb committed
382
383
384
385
386
387
388
389

    # 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};
390
            Log(STATUSLOG($plcname), "plabmonitord, $pnodename, removefrompool, ".
Kirk Webb's avatar
   
Kirk Webb committed
391
                "nostat, node removed from pool $pool->{'NAME'}");
Kirk Webb's avatar
   
Kirk Webb committed
392
        }
Kirk Webb's avatar
Kirk Webb committed
393
394
    }

Kirk Webb's avatar
   
Kirk Webb committed
395
    return;
Kirk Webb's avatar
Kirk Webb committed
396
397
}

Kirk Webb's avatar
Kirk Webb committed
398
399
400
#
# send mail with given message, and exit (also printing message).
#    
401
402
403
404
405
406
407
sub fatal($)
{
    local($msg) = $_[0];

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