batch_daemon.in 15.9 KB
Newer Older
1
#!/usr/bin/perl -wT
Leigh B. Stoller's avatar
Leigh B. Stoller committed
2 3 4 5 6 7 8

#
# EMULAB-COPYRIGHT
# Copyright (c) 2000-2002 University of Utah and the Flux Group.
# All rights reserved.
#

9 10
use English;
use Getopt::Std;
11 12
use Fcntl;
use IO::Handle;
13 14 15 16 17 18

#
# Create a batch experiment.
#
# usage: batch_daemon
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
19 20
# TODO: Use "logger" instead of writing a log file.
#
21 22
sub usage()
{
23 24
    print STDOUT "Usage: batch_daemon [-d]\n" .
	"Use the -d option to prevent daemonization\n";
25 26
    exit(-1);
}
27
my  $optlist = "d";
28 29 30 31 32 33 34

#
# Configure variables
#
my $TB       = "@prefix@";
my $DBNAME   = "@TBDBNAME@";
my $TBOPS    = "@TBOPSEMAIL@";
35
my $TBLOGS   = "@TBLOGSEMAIL@";
36

37 38 39 40 41 42 43
#
# Testbed Support libraries
#
use lib "@prefix@/lib";
use libdb;
use libtestbed;

44 45 46 47
my $tbbindir = "$TB/bin/";
my $batchdir = "$TB/batch";
my $startexp = "$TB/bin/startexp";
my $endexp   = "$TB/bin/endexp";
48
my $savelogs = "$TB/bin/savelogs";
49
my $avail    = "$TB/sbin/avail";
50 51
my $batchlog = "$TB/log/batchlog";
my $projroot = "/proj";
52
my $debug    = 0;
53 54
my $dirname;

55 56 57 58 59
my $BSTATE_POSTED	= BATCHSTATE_POSTED;
my $BSTATE_ACTIVATING	= BATCHSTATE_ACTIVATING;
my $BSTATE_RUNNING	= BATCHSTATE_RUNNING;
my $BSTATE_TERMINATING	= BATCHSTATE_TERMINATING;

60 61 62 63 64 65
#
# These are valid in the children, not the parent. I suppose I could use
# dynamically scoped variables, but hardly worth it.
#
my $eid;
my $pid;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
66
my $gid;
67
my $logname;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
68
my $nsfile;
69
my $user_name  = "Testbed Operations";
70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93
my $user_email = "$TBOPS";

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

#
# Untaint the path
# 
$ENV{'PATH'} = "/bin:/usr/bin:";
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

#
# 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 != 0) {
    usage();
}
94 95 96
if (defined($options{"d"})) {
    $debug = $options{"d"};
}
97 98

# Go to ground.
99
if (! $debug) {
100 101 102
    if (TBBackGround($batchlog)) {
	exit(0);
    }
103
}
104 105 106 107 108

#
# Loop, looking for batch experiments that want to run.
# 
while (1) {
109
    my($count, $i, $query_result, $pending_result, $running_result);
110
    my(%row, %pending_row);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
111

112
    #
113
    # Need to lock the table here because of cancelation in endexp.
114 115 116 117 118 119
    # See the comments in there. We need to atomically grab the next
    # batch experiment we want to try, and then change its state from
    # new to configuring. We want to grab just one experiment, since
    # it takes a while to configure an experiment, and grabbing a bunch and
    # locking them up might result in having to wait a really long time
    # to cancel a batch experiment that hasn't really tried to start yet!
120
    # Thats would ne annoying to users.
121
    #
122
    # So, now you're wondering what my selection criteria is? Well, its
123 124
    # damn simplistic. I set the "started" datetime field each attempt,
    # and I pick the batch_experiment with the oldest time, thereby cycling
125 126 127 128
    # through in a "least recently attempted" manner. In addition, we want
    # to throttle the number simultaneous batches that one person can
    # can have running at a time (curently to just one batch), so check to
    # to see if the person has another batch active (thats e2 below).
129 130
    #
    $query_result =
131 132
	DBQuery("lock tables experiments write, experiments as e1 write, ".
		"experiments as e2 write");
133 134
    if (! $query_result) {
	print "DB Error locking tables. Waiting a bit ...\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
135
	goto pause;
136 137 138
    }
    
    $pending_result =
139 140 141 142 143 144 145 146 147 148 149 150
	DBQueryWarn("SELECT e1.* FROM experiments as e1 ".
		    "left join experiments as e2 on ".
		    " e2.expt_head_uid=e1.expt_head_uid and ".
		    " e2.batchmode=1 and e2.batchstate='$BSTATE_RUNNING' and ".
		    " e1.pid=e2.pid and e1.eid!=e2.eid ".
		    "WHERE e2.eid is null and ".
		    " e1.batchmode=1 and e1.canceled=0 and ".
		    " e1.batchstate='$BSTATE_POSTED' and ".
		    "  (e1.attempts=0 or ".
		    "    ((UNIX_TIMESTAMP() - ".
		    "      UNIX_TIMESTAMP(e1.expt_start) > (60 * 15)))) ".
		    "ORDER BY e1.expt_start LIMIT 1");
151

152
    $running_result =
153 154 155
	DBQuery("select * from experiments ".
		"where batchmode=1 and batchstate='$BSTATE_RUNNING' ".
		"ORDER BY expt_start");
156 157 158

    if (!$pending_result || !$running_result) {
	print "DB Error getting batch info. Waiting a bit ...\n";
159
	DBQuery("unlock tables");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
160
	goto pause;
161 162 163
    }

    if (!$pending_result->numrows && !$running_result->numrows) {
164
	DBQuery("unlock tables");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
165
	goto pause;
166 167 168
    }

    #
169
    # If we have a pending experiment to run, set its state to configuring
170
    # right away, while we have the tables locked. This prevents endexp
171
    # from seeing it as something it can cancel.
172
    #
173 174 175 176 177 178 179 180
    if ($pending_result->numrows) {
	%pending_row = $pending_result->fetchhash();

	# Local vars!
	my $eid = $pending_row{'eid'};
	my $pid = $pending_row{'pid'};

	$query_result = 
181 182 183
	    DBQuery("update experiments set expt_start=now(), ".
		    "batchstate='$BSTATE_ACTIVATING' ".
		    "where eid='$eid' and pid='$pid'");
184 185 186

	if (! $query_result) {
	    print "DB error setting batch $pid/$eid to configuring.\n";
187
	    DBQuery("unlock tables");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
188
	    goto pause;
189 190
	}
    }
191
    DBQueryWarn("unlock tables");
192

193 194 195 196 197 198 199 200 201 202 203
    #
    # Okay, first we check the status of running batch mode experiments
    # since we want to end those before trying to start any new ones, cause
    # it would be nice to have as many nodes available as possible before
    # trying to add a new one. This can potentially delay startup, but thats
    # okay. Its a batch system.
    #
    # If you are wondering why I check for finished experiments in the main
    # loop instead of in the child that started the experiment, its so that
    # we fire up again and look for them in the event that paper goes down.
    #
204
    while (%row = $running_result->fetchhash()) {
205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221
	my $canceled = $row{'canceled'};
	if ($canceled) {
	    dosomething("cancel", %row);
	    next;
	}
	if (isexpdone(%row)) {
	    dosomething("end", %row);
	    next;
	}
    }

    #
    # Finally start an actual experiment!
    #
    if ($pending_result->numrows) {
	dosomething("start", %pending_row);
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
222 223
  pause:
    sleep(30);
224 225 226
}

#
227
# Do something as the user. Either, start, end, or cancel an experiment.
228
#
229
sub dosomething($$)
230
{
231 232
    my($dowhat)   = shift;
    my(%exphash)  = @_;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
233
    my($unix_uid, $unix_gid, $row, $query_result);
234 235

    # Global vars
236 237 238 239 240 241 242 243
    $eid     = $exphash{'eid'};
    $pid     = $exphash{'pid'};
    $gid     = $exphash{'gid'};
    $dirname = $exphash{'path'};
    $nsfile  = "$eid.ns";
    
    # Locals
    my $creator = $exphash{'expt_head_uid'};
244

245 246 247 248 249 250 251
    print "Doing a '$dowhat' to batch experiment $pid/$eid\n";

    #
    # Create a temporary name for a log file. We do this in the parent so
    # we can remove it when the child ends. The child could remove it, but
    # since it is open in the child, it has the tendency to stick around.
    #
252
    $logname = TBExptCreateLogFile($pid, $eid, "${dowhat}-batch");
253

254 255 256
    #
    # Start up a child to run the guts. The parent waits. If the
    # experiment configures okay, the parent can return to try something
257
    # else.
258 259 260
    #
    $childpid = fork();
    if ($childpid) {
261 262
	print "Child PID $childpid started to $dowhat $pid/$eid\n";

263
	waitpid($childpid, 0);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
264
	my $status = $? >> 8;
265

Leigh B. Stoller's avatar
Leigh B. Stoller committed
266
	print "Child PID $childpid exited with exit status $status\n";
267

268 269 270 271 272 273 274 275 276 277 278 279 280 281
        #
        # Move the temporary log file into the experiment directory and
	# change the name in the DB. This makes it available to the web
	# interface later on if desired.
	#
	# The exp dir might be gone if the batch was killed/canceled.
        #
	if (-e $dirname) {
	    my $fname = "$dirname/tbdata/${dowhat}-batch.log";
	    
	    system("cp -pf $logname $fname");
	    TBExptCloseLogFile($pid, $eid);
	    TBExptSetLogFile($pid, $eid, $fname);
	}
282
	unlink($logname);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
283
	return $status;
284
    }
285
    openlog($logname);
286 287
    TBExptSetLogFile($pid, $eid, $logname);
    TBExptOpenLogFile($pid, $eid);
288

289 290 291
    #
    # Get some user information. 
    #
292
    if (!UserDBInfo($creator, \$user_name, \$user_email)) {
293
	fatal("DB Error getting user information for uid $creator");
294
    }
295 296 297
    
    chdir("$dirname/tbdata") or
	fatal("Could not cd into $dirname/tbdata!");
298 299 300 301 302

    #
    # Figure out the unix uid/gid that the experiment configuration is
    # going to run as. 
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
303
    (undef,undef,$unix_uid) = getpwnam($creator) or
304
	fatal("No such user $creator");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
305 306
    (undef,undef,$unix_gid) = getgrnam($gid) or
	fatal("No such group $gid");
307

308 309 310
    #
    # Change the ownership of the log file before we flip.
    #
311 312
    chown($unix_uid, $unix_gid, $logname) or
	fatal("Could not chown $logname to $unix_uid/$unix_gid!");
313 314

    # Flip to the user. We never flip back.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
315 316
    $EGID = $GID = $unix_gid;
    $EUID = $UID = $unix_uid;
317
    $ENV{'USER'} = $creator;
318
    
319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336
    if ($dowhat eq "start") {
	startexp(%exphash);
    }
    elsif ($dowhat eq "end") {
	endexp(%exphash);
    }
    elsif ($dowhat eq "cancel") {
	cancelexp(1, %exphash);
    }
    exit(0);
}

#
# Try to start an experiment. Never returns.
# 
sub startexp($)
{
    my(%exphash)  = @_;
337
    my($exit_status, $running, $query_result);
338 339 340

    my $attempts  = $exphash{'attempts'};

341
    #
342
    # Try to start the experiment. 
343
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
344
    system("$startexp -b $logname -g $gid $pid $eid $nsfile");
345 346
    $exit_status = $? >> 8;
    $running     = 1;
347 348 349 350 351
    if ($exit_status) {
	$running = 0;
    }
    
    #
352 353
    # Look for cancelation. If we get a DB error on this, just continue cause
    # we can pick up the cancelation later.
354 355
    #
    $query_result =
356
	DBQueryWarn("select canceled from experiments ".
357
		    "where eid='$eid' and pid='$pid'");
358

359 360
    if ($query_result) {
	@row = $query_result->fetchrow_array();
361

362 363 364 365 366 367 368 369
	if ($row[0]) {
	    cancelexp($running);
	    #
	    # Never returns, but just to be safe ...
	    #
	    exit(0);
	}
    }
370 371 372 373

    #
    # If the configuration failed for lack of nodes, then don't send
    # email unless the number of attempts starts to get big.
374
    #
375 376 377
    # If the configuration failed for some other reason, then send email.
    # We have to reset the state to "new" so that it will be retried again
    # later. 
378 379
    #
    if (! $running) {
380 381 382 383
	#
	# XXX - What if this update fails?
	# 
	$query_result = 
384
	    DBQueryWarn("update experiments set attempts=attempts+1 ".
385
			"where eid='$eid' and pid='$pid'");
386

387 388 389 390 391 392 393 394 395 396
	#
	# The exit value is important. If its -1 or 1, thats bad. Kill the
	# batch off. Anything else implies an assign violation that is
	# (hopefully) transient. We leave it up the user to kill cancel the
	# batch if it looks like its never going to work.
	#
	if ($exit_status == 1 || $exit_status == -1) {
	    email_status("Experiment startup has failed with a fatal error!\n".
			 "Batch has been removed from the system.");
	    ExptCleanup();
397
	    exit($exit_status);
398
	}
399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424
	
	if (($attempts % 30) == 0) {
	    $attempts++;

	    my $msg =
		"Could not configure Batch Mode experiment $pid/$eid.\n".
		"\n".
		"There was an assignment violation (please check the log)\n".
		"that prevented it from being scheduled. The violation\n".
		"might result from not enough nodes or not enough link\n".
		"bandwidth. If you feel that the violation is in error,\n".
		"please cancel the batch and notify $TBOPS\n".
		"Otherwise, another attempt will be made in a little while.\n".
		"\n". 
		"There have been $attempts attempts to start this batch.";

	    email_status($msg);
	}

	#
	# There is some state that needs to be reset so that another
	# attempt can be made.
	# 
	SetExpState($pid, $eid, EXPTSTATE_NEW);
	TBSetBatchState($pid, $eid, $BSTATE_POSTED);
	    
425
	exit($exit_status);
426 427 428 429 430
    }

    #
    # Well, it configured! Lets set it state to running.
    #
431 432
    TBSetBatchState($pid, $eid, $BSTATE_RUNNING);
    
433
    email_status("Batch Mode experiment $pid/$eid is now running!\n".
434
		 "Please consult the Web interface to see how it is doing.");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
435

436
    #
437
    # Done with this phase. Must exit.
438
    #
439 440
    exit(0);
}
441

442 443 444 445 446 447
#
# End an experiment. Never returns.
#
sub endexp($)
{
    my(%exphash)  = @_;
448

449 450 451
    #
    # Save tiplogs
    #
452 453
    system("$savelogs $pid $eid");

454 455 456 457 458
    #
    # Have to set the state to terminating or else endexp will not accept it.
    # 
    TBSetBatchState($pid, $eid, $BSTATE_TERMINATING);
    
459
    system("$endexp -b $pid $eid");
460 461 462 463 464 465 466 467
    my $exit_status = $? >> 8;

    if ($exit_status) {
	#
	# TB admin is going to have to clean up. 
	# 
	fatal("Terminating Batch Mode experiment $pid/$eid");
    }
468 469

    ExptCleanup();
470
    email_status("Batch Mode experiment $pid/$eid has finished!");
471
   
472
    #
473
    # Child must exit!
474
    #
475 476 477 478 479 480 481 482 483 484 485
    exit(0);
}

#
# Cancel an experiment. Never returns.
#
sub cancelexp($$)
{
    my($running) = shift;
    my(%exphash) = @_;
    
486 487
    TBSetBatchState($pid, $eid, $BSTATE_TERMINATING);
    
488 489 490 491
    if ($running) {
	system("$endexp -b $pid $eid");
    }

492 493
    ExptCleanup();
    donotify("Your Batch Mode experiment has been canceled!", "Canceled", 0);
494 495 496 497 498 499 500
   
    #
    # Child must exit!
    #
    exit(0);
}

501 502 503 504 505 506 507
#
# Check experiment status. Looks to see if all of the nodes in an
# experiment have reported in.
#
sub isexpdone($)
{
    my(%exphash)  = @_;
508
    my($query_result, @row);
509 510 511 512 513 514 515 516 517 518 519
    
    # Global vars
    $eid = $exphash{'eid'};
    $pid = $exphash{'pid'};

    print "Checking to see if $pid/$eid has finished up yet\n";

    #
    # Look to see if any nodes yet to report status. If so, spin again.
    #
    $query_result =
520 521 522
	DBQueryWarn("SELECT startstatus,bootstatus FROM nodes ".
		    "LEFT JOIN reserved ON nodes.node_id=reserved.node_id ".
		    "WHERE reserved.eid='$eid' and reserved.pid='$pid'");
523 524 525 526 527

    if (! $query_result) {
	return 0;
    }

528 529 530 531 532 533 534 535 536 537 538 539 540
    #
    # Well, right now a node is considered finished up only if its
    # boot did not fail, and it has reported start command status.
    # The idea being that if the boot failed, then its status will
    # never be reported anyway, and we might as well consider the node
    # done (else the experiment would never end).
    # 
    while (@row = $query_result->fetchrow_array()) {
	if ($row[1] eq NODEBOOTSTATUS_FAILED) {
	    next;
	}
	if ($row[0] eq NODESTARTSTATUS_NOSTATUS) {
	    return 0;
541 542
	}
    }
543
    return 1;
544 545
}

546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568
#
# Remove all trace.
# 
sub ExptCleanup()
{
    if (system("rm -rf $dirname")) {
	print "*** WARNING: Not able to remove experiment directory.\n";
	print "             Someone will need to do this by hand.\n";
    }

    #
    # Remove all trace from the DB.
    # 
    DBQueryWarn("DELETE from nsfiles ".
		"WHERE eid='$eid' and pid='$pid'");

    DBQueryWarn("DELETE from exppid_access ".
		"WHERE exp_eid='$eid' and exp_pid='$pid'");

    DBQueryWarn("DELETE from experiments ".
		"WHERE eid='$eid' and pid='$pid'");
}

569 570
#
# Start up a child, and set its descriptors talking to a log file.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
571
# The log file already exists, created with mktemp above.
572 573 574 575 576 577 578
# 
sub openlog($)
{
    my($logname) = $_[0];
	
    #
    # We have to disconnect from the caller by redirecting both STDIN and
Leigh B. Stoller's avatar
Leigh B. Stoller committed
579 580
    # STDOUT away from the pipe. Otherwise the caller will continue to wait
    # even though the parent has exited. 
581 582
    #
    open(STDIN, "< /dev/null") or
583
	fatal("opening /dev/null for STDIN: $!");
584 585 586 587 588 589

    open(STDERR, ">> $logname") or
	fatal("opening $logname for STDERR: $!");
    open(STDOUT, ">> $logname") or
	fatal("opening $logname for STDOUT: $!");

590 591 592
    STDOUT->autoflush(1);
    STDERR->autoflush(1);

593 594 595
    return 0;
}

596 597 598 599 600
#
# A fatal error is something that the user does not need to know about.
# Caused by a breakdown in the TB system. Generally speaking, once the
# experiment is running, this should not be used.
# 
601
sub fatal($)
602 603 604
{
    my($mesg) = $_[0];

605
    donotify($mesg, "Failure", 1);
606 607 608 609

    exit(-1);
}

610 611 612
#
# Something the user cares about. 
# 
613
sub email_status($)
614
{
615
    my($mesg) = $_[0];
616

617
    donotify($mesg, "Status", 0);
618 619
}

620
sub donotify($$$)
621
{
622
    my($mesg, $subtext, $iserr) = @_;
623
    my($subject, $from, $to, $hdrs);
624
    my $MAIL;
625

626 627 628
    $mesg = "$mesg\n";

    print STDOUT "$mesg";
629

630
    $subject = "Batch Mode Experiment $subtext $pid/$eid";
631
    $from    = $TBOPS;
632 633 634 635 636 637
    $hdrs    = "Reply-To: $TBOPS";
    
    #
    # An error goes just to Testbed Operations. Normal status messages go
    # to the user and to the Testbed Logs address.
    # 
638
    if ($iserr) {
639
	$to = "$TBOPS";
640 641
    }
    else {
642 643 644
	$to   = "$user_name <$user_email>";
	$hdrs = "Bcc: $TBLOGS\n".
	        "$hdrs";
645 646
    }

647
    SENDMAIL($to, $subject, $mesg, $from, $hdrs,
648
	     ($logname, "assign.log", $nsfile));
649
}