plabmonitord.in 12.4 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
#
# Grab the supplied plcname and ensure we know about it.
#
if (scalar(@ARGV) == 1) {
    $plcname = shift(@ARGV);

    # XXX need to escape this better
David Johnson's avatar
David Johnson committed
101
    if (!($plcname =~ /^[\w\d\-]+$/)) {
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
	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();
}

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

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

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

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

143
144
145
146
147
# 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
148
149
150
151
#
# daemonize
#
if (!$debug) {
Kirk Webb's avatar
   
Kirk Webb committed
152
    if (TBBackGround($LOGFILE)) {
Kirk Webb's avatar
   
Kirk Webb committed
153
154
155
156
        exit(0);
    }
}

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

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

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

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

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

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

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

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

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

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

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

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

Kirk Webb's avatar
Kirk Webb committed
225
#
Kirk Webb's avatar
   
Kirk Webb committed
226
227
# 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
228
#
Kirk Webb's avatar
   
Kirk Webb committed
229
my $windowsize = 0;
230
my $i = 0;
Kirk Webb's avatar
   
Kirk Webb committed
231
232
233
234
while (1) {
    my $now = time();
    my $sleeptime = $MAXSLEEPTIME;
    my $reappool;
Kirk Webb's avatar
   
Kirk Webb committed
235
    my $lastwindowsize = -1;
Kirk Webb's avatar
   
Kirk Webb committed
236

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

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

Kirk Webb's avatar
   
Kirk Webb committed
262
263
264
265
266
267
268
269
270
271
272
273
    # 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
274
    # Go to sleep waiting for the next node to process.
Kirk Webb's avatar
   
Kirk Webb committed
275
276
277
    print "Monitor going to sleep for $sleeptime seconds ".
          "(winsize: $windowsize, LA: $curLA).\n";

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

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

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

Kirk Webb's avatar
   
Kirk Webb committed
293
294
    # 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
295
296
297
    # 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
298
    foreach my $pool (@allpools) {
Kirk Webb's avatar
   
Kirk Webb committed
299
300
        my $numfinished = $pool->checkexpiration();
        $windowsize -= $numfinished;
Kirk Webb's avatar
Kirk Webb committed
301
302
    }

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

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

324
325
326
327
328
329
330
331
332
333
334
335
336
337
    # 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);
    }

338
339
    # 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
340
    # XXX: need to change everything to deal with vnodes rather than pnodes.
341
342
343
344
    #
    # 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
345
346
347
348
349
350
    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 ".
351
352
                     "      nt.isplabphysnode = 1 and ".
		     "      nt.type='${plctype}phys'".
Kirk Webb's avatar
   
Kirk Webb committed
353
                     "order by rand()");
Kirk Webb's avatar
   
Kirk Webb committed
354
355
356
357
358

    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];
359
360
361
362
363

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

Kirk Webb's avatar
   
Kirk Webb committed
364
365
366
367
368
            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
369
                                             'nextchecktime'  => $now + int(rand(120)),
Kirk Webb's avatar
   
Kirk Webb committed
370
371
372
373
                                             'lastfailtime'   => $NEVER,
                                             'consecfails'    => 0,
                                             'consecsuccess'  => 0,
                                             'setupfails'     => 0};
Kirk Webb's avatar
   
Kirk Webb committed
374

375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
		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";
		}

395
                Log(STATUSLOG($plcname), "plabmonitord, $pnodename, addtopool, ".
Kirk Webb's avatar
   
Kirk Webb committed
396
                    "nostat, node added to pool $pool->{'NAME'}");
Kirk Webb's avatar
   
Kirk Webb committed
397
398
399
400
            }
            # Mark this node as still in the pool as of this check.
            $poolpnodes->{$pnodename}->{'updtime'} = $now;
        }
Kirk Webb's avatar
Kirk Webb committed
401
    }
Kirk Webb's avatar
   
Kirk Webb committed
402
403
404
405
406
407
408
409

    # 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};
410
            Log(STATUSLOG($plcname), "plabmonitord, $pnodename, removefrompool, ".
Kirk Webb's avatar
   
Kirk Webb committed
411
                "nostat, node removed from pool $pool->{'NAME'}");
Kirk Webb's avatar
   
Kirk Webb committed
412
        }
Kirk Webb's avatar
Kirk Webb committed
413
414
    }

Kirk Webb's avatar
   
Kirk Webb committed
415
    return;
Kirk Webb's avatar
Kirk Webb committed
416
417
}

Kirk Webb's avatar
Kirk Webb committed
418
419
420
#
# send mail with given message, and exit (also printing message).
#    
421
422
423
424
425
426
427
sub fatal($)
{
    local($msg) = $_[0];

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