swapexp.in 41.3 KB
Newer Older
1
#!/usr/bin/perl -wT
Leigh B. Stoller's avatar
Leigh B. Stoller committed
2 3 4

#
# EMULAB-COPYRIGHT
5
# Copyright (c) 2000-2006 University of Utah and the Flux Group.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
6 7 8
# All rights reserved.
#

9 10
use English;
use Getopt::Std;
11
use POSIX qw(isatty setsid);
12 13

#
Chad Barb's avatar
Chad Barb committed
14
# This gets invoked from the Web interface.
Chad Barb's avatar
 
Chad Barb committed
15
# Swap an experiment in, swap it out, restart or modify.
16
#
Chad Barb's avatar
Chad Barb committed
17

18 19
sub usage()
{
20
    print(STDERR
21
	  "Usage: swapexp [-q] [-b | -w] [-i | -a | -f] [-r] [-e]\n".
22 23 24 25
	  "               <-s in | out | restart | modify | pause>\n".
	  "               <pid> <eid> [<nsfile>]\n".
	  "switches and arguments:\n".
	  "-w       - wait for non-batchmode experiment swap/modify\n".
26
	  "-q       - be less chatty\n".
27 28 29 30 31 32
	  "-r       - reboot nodes when doing a modify experiment\n".
	  "-e       - restart event scheduler when doing a modify experiment\n".
	  "-s <op>  - Operation to perform; one of those listed above\n".
	  "<pid>    - The project the experiment belongs to\n".
	  "<eid>    - The experiment name (id)\n".
	  "<nsfile> - Optional NS file to parse for experiment modify\n");
33 34
    exit(-1);
}
35
my  $optlist = "biafres:wqx";
36

37 38 39 40 41 42 43 44 45 46 47 48 49 50 51
#
# Exit codes are important; they tell the web page what has happened so
# it can say something useful to the user. Fatal errors are mostly done
# with die(), but expected errors use this routine. At some point we will
# use the DB to communicate the actual error.
#
# $status < 0 - Fatal error. Something went wrong we did not expect.
# $status = 0 - Termination is proceeding in the background. Notified later.
# $status > 0 - Expected error. User not allowed for some reason. 
# 
sub ExitWithStatus($$)
{
    my ($status, $message) = @_;
    
    if ($status < 0) {
Kevin Atkinson's avatar
 
Kevin Atkinson committed
52
	tbdie($message);
53 54
    }
    else {
Kevin Atkinson's avatar
 
Kevin Atkinson committed
55
	tbnotice($message);
56 57 58 59
    }
    exit($status);
}

60 61 62 63 64
#
# Configure variables
#
my $TB     = "@prefix@";
my $TBOPS  = "@TBOPSEMAIL@";
65
my $TBROBOCOPS = "@TBROBOCOPSEMAIL@";
66
my $TBLOGS = "@TBLOGSEMAIL@";
67
my $TBINFO = "$TB/expinfo";
68
my $TBDOCBASE = "@TBDOCBASE@";
69
my $TBBASE = "@TBBASE@";
70
my $CONTROL  = "@USERNODE@";
71 72 73 74 75 76 77

#
# Testbed Support libraries
#
use lib "@prefix@/lib";
use libdb;
use libtestbed;
Kevin Atkinson's avatar
 
Kevin Atkinson committed
78
use libtblog;
79
use libArchive;
80

81 82 83 84 85 86 87 88 89
# Be careful not to exit on transient error; 0 means infinite retry.
$libdb::DBQUERY_MAXTRIES = 0;

# For the END block below.
my $cleaning = 0;
my $justexit = 1;
my $signaled = 0;

my $tbdir    = "$TB/bin";
90
my $tbdata   = "tbdata";
91
my $checkquota = "$TB/sbin/checkquota";
92
my $batch    = 0;
93
my $idleswap = 0;
94 95
my $autoswap = 0;
my $force    = 0;
Chad Barb's avatar
Chad Barb committed
96
my $reboot   = 0;
97
my $waitmode = 0;
98
my $quiet    = 0;
99
my $eventsys_restart   = 0;
100
my $errorstat= -1;
101 102
my $modifyHosed   = 0;
my $modifySwapped = 0;
103
my $robotexp = 0;
104
my $template_node = 0;
Chad Barb's avatar
 
Chad Barb committed
105

106 107 108 109 110
my $inout;
my $logname;
my $dbuid;
my $user_name;
my $user_email;
111
my @allnodes;
112
my @row;
113
my $action;
114
my $tag;
115
my $nextswapstate;
116
my $termswapstate;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
117
my $isadmin  = 0;
Chad Barb's avatar
 
Chad Barb committed
118

119 120 121 122 123
# Protos
sub fatal($);
sub CheckFWinfo($);
sub GatherFWinfo();
		
124 125 126
#
# Untaint the path
# 
127
$ENV{'PATH'} = "/bin:/usr/bin:$TB/libexec/vis";
128 129 130 131 132 133 134
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

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

135 136 137 138 139 140 141
#
# Set umask for start/swap. We want other members in the project to be
# able to swap/end experiments, so the log and intermediate files need
# to be 664 since some are opened for append.
#
umask(0002);

142 143 144 145 146 147 148 149
#
# Parse command arguments. Once we return from getopts, all that should
# left are the required arguments.
#
%options = ();
if (! getopts($optlist, \%options)) {
    usage();
}
150 151 152
if (defined($options{"i"})) {
    $idleswap = 1;
}
153 154 155
if (defined($options{"w"})) {
    $waitmode = 1;
}
156 157 158 159 160 161
if (defined($options{"a"})) {
    $autoswap = 1;
}
if (defined($options{"f"})) {
    $force = 1;
}
162 163 164
if (defined($options{"b"})) {
    $batch = 1;
}
Chad Barb's avatar
 
Chad Barb committed
165 166 167
if (defined($options{"r"})) {
    $reboot = 1;
}
168 169 170
if (defined($options{"e"})) {
    $eventsys_restart = 1;
}
171 172 173
if (defined($options{"q"})) {
    $quiet = 1;
}
174 175 176
if (defined($options{"x"})) {
    $template_mode = 1;
}
177 178 179
if (defined($options{"s"})) {
    $inout = $options{"s"};

Chad Barb's avatar
Chad Barb committed
180 181 182
    if ($inout ne "out"     &&
	$inout ne "in"      &&
	$inout ne "restart" &&
183
	$inout ne "pause"   &&
Chad Barb's avatar
 
Chad Barb committed
184
	$inout ne "modify") {
185 186 187 188 189 190 191
	usage();
    }
}
else {
    usage();
}

192 193 194 195 196
usage()
    if (($waitmode && $batch) ||
	($inout ne "modify" && @ARGV != 2) ||
	(($waitmode || $batch) && ($idleswap || $autoswap || $force)));

197 198 199 200 201
if ($eventsys_restart && $inout ne "modify") {
    print STDOUT "Usage: swapexp: -e (eventsys_restart) can be used ".
                 "only with -s modify\n";
    usage();
}
Chad Barb's avatar
 
Chad Barb committed
202 203 204
my $pid   = $ARGV[0];
my $eid   = $ARGV[1];

205 206 207
#
# Untaint the arguments.
#
208
if ($pid =~ /^([-\w\.]+)$/) {
209 210 211
    $pid = $1;
}
else {
Kevin Atkinson's avatar
 
Kevin Atkinson committed
212
    tbdie("Tainted argument $pid!");
213
}
214
if ($eid =~ /^([-\w\.]+)$/) {
215 216 217
    $eid = $1;
}
else {
Kevin Atkinson's avatar
 
Kevin Atkinson committed
218
    tbdie("Tainted argument $eid!");
219
}
220
my $repfile = "$eid.report";
221 222
my $workdir = TBExptWorkDir($pid, $eid);
my $userdir = TBExptUserDir($pid, $eid);
223 224
my $tempnsfile;
my $modnsfile;
225
my $nsfile;
226

Leigh B. Stoller's avatar
Leigh B. Stoller committed
227
if ($inout eq "modify" && @ARGV > 2) {
228 229 230 231 232
    $tempnsfile = $ARGV[2];

    #
    # Untaint nsfile argument; Allow slash.
    #
233
    if ($tempnsfile =~ /^([-\w\.\/]+)$/) {
234
	$tempnsfile = $1;
235 236
    }
    else {
Kevin Atkinson's avatar
 
Kevin Atkinson committed
237
	tbdie("Tainted nsfile name: $tempnsfile");
238 239 240 241 242 243 244 245 246
    }
    #
    # Called from ops interactively. Make sure NS file in /proj or /users.
    #
    # Use realpath to resolve any symlinks.
    #
    my $translated = `realpath $tempnsfile`;
    if ($translated =~ /^([-\w\.\/]+)$/) {
	$tempnsfile = $1;
247
    }
248
    else {
Kevin Atkinson's avatar
 
Kevin Atkinson committed
249
	tbdie("Tainted nsfile returned by realpath: $translated");
250 251 252 253 254 255 256 257 258 259 260 261 262 263 264
    }

    #
    # The file must reside in /proj, /groups, or /users. Since this script
    # runs as the caller, regular file permission checks ensure its a file
    # the user is allowed to use. /tmp/$guid-$nsref.nsfile also allowed
    # since this script is invoked directly from web interface, which generates
    # a name that should not be guessable, so as long as it looks to be in
    # proper format, we accept it. 
    #
    if (! ($tempnsfile =~ /^\/tmp\/[-\w]+-\d+\.nsfile/) &&
	! ($tempnsfile =~ /^\/var\/tmp\/php\w+/) &&
	! ($tempnsfile =~ /^\/proj/) &&
	! ($tempnsfile =~ /^\/groups/) &&
	! ($tempnsfile =~ /^\/users/)) {
Kevin Atkinson's avatar
 
Kevin Atkinson committed
265
	tbdie("$tempnsfile does not resolve to an appropriate directory!");
266 267 268
    }

    if (! -f $tempnsfile || -z $tempnsfile || ! -r $tempnsfile) {
Kevin Atkinson's avatar
 
Kevin Atkinson committed
269
	tbdie("$tempnsfile does not look like an NS file!");
270
    }
271 272
    $nsfile    = "$eid.ns";
    $modnsfile = "${eid}-modify.ns";
273
}
274 275 276 277 278

#
# Verify user and get his DB uid.
#
if (! UNIX2DBUID($UID, \$dbuid)) {
Kevin Atkinson's avatar
 
Kevin Atkinson committed
279
    tbdie("You do not exist in the Emulab Database.");
280 281 282 283 284 285
}

#
# Get email info for user.
#
if (! UserDBInfo($dbuid, \$user_name, \$user_email)) {
Kevin Atkinson's avatar
 
Kevin Atkinson committed
286
    tbdie("Cannot determine your name and email address.");
287
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
288
$isadmin = TBAdmin($UID);
289

Kevin Atkinson's avatar
 
Kevin Atkinson committed
290 291 292 293 294
#
# Set error reporting info
#
tblog_set_info($pid,$eid,$UID);

295
#
Chad Barb's avatar
 
Chad Barb committed
296
# Verify that this person can muck with the experiment.
297 298
# Note that any script down the line has to do an admin check also. 
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
299
if ($UID && !$isadmin &&
300
    !TBExptAccessCheck($dbuid, $pid, $eid, TB_EXPT_DESTROY)) {
Kevin Atkinson's avatar
 
Kevin Atkinson committed
301
    tbdie("You do not have permission to swap or modify this experiment!");
302 303
}

304 305 306 307
# Must do this before lock tables!
# idleswap is in minutes, threshold is in hours
$idleswap_time = 60 * TBGetSiteVar("idle/threshold");

308 309 310 311 312 313 314 315 316
#
# In wait mode, block interrupt until we spin off the background process.
#
if ($waitmode) {
    $SIG{TERM} = 'IGNORE';
    $SIG{QUIT} = 'IGNORE';
    $SIG{INT}  = 'IGNORE';
}

317 318 319 320 321 322
#
# Check for overquota; we deal with it below, cause of the batch system.
#
my $overquota = system("$checkquota $dbuid");

if ($overquota) {
Kevin Atkinson's avatar
 
Kevin Atkinson committed
323
    tberror("You are over your disk quota on $CONTROL; please cleanup!");
324 325
}

326 327 328 329 330 331
#
# Temp fix; Disallow swapmod to firewalled experiments. This will come
# out later.
#
my $firewalled = TBExptFirewall($pid, $eid);

332 333 334 335 336 337 338 339 340 341
#
# see if we've got a robot exp (this isn't the only check; if this is a
# swapmod, we've got to check tbprerun as well...
#
$robotexp = 
    TBExptContainsNodeCT($pid,$eid,'robot') || 
    TBExptContainsNodeCT($pid,$eid,'mote') || 
    TBExptContainsNodeCT($pid,$eid,'motehost') || 
    TBExptContainsNodeCT($pid,$eid,'powermon');

342 343 344 345 346
#
# We have to protect against trying to end an experiment that is currently
# in the process of being terminated. We use a "wrapper" state (actually
# a timestamp so we can say when termination was requested) since
# terminating consists of a couple of different experiment states down inside
Chad Barb's avatar
Chad Barb committed
347
# the tb scripts.
348 349 350 351 352 353 354
#
DBQueryFatal("lock tables experiments write");

$query_result =
    DBQueryFatal("SELECT * FROM experiments WHERE eid='$eid' and pid='$pid'");

if (! $query_result->numrows) {
Kevin Atkinson's avatar
 
Kevin Atkinson committed
355
    tbdie("No such experiment $pid/$eid exists!");
356 357 358
}
my %hashrow = $query_result->fetchhash();
my $expt_head_login = $hashrow{'expt_head_uid'};
359
my $last_swap_uid   = $hashrow{'expt_swap_uid'};
360
my $estate          = $hashrow{'state'};
361
my $batchstate      = $hashrow{'batchstate'};
362
my $expt_path       = $hashrow{'path'};
363
my $expt_locked     = $hashrow{'expt_locked'};
364
my $isbatchexpt     = $hashrow{'batchmode'};
365
my $canceled        = $hashrow{'canceled'};
366 367 368 369 370 371 372 373 374 375
my $swappablebit= $hashrow{'swappable'};
my $idleswapbit = $hashrow{'idleswap'};
my $autoswapbit = $hashrow{'autoswap'};
my $swappablestr= ( $swappablebit ? "Yes" : "No" );
my $idleswapstr = ( $idleswapbit ? "Yes" : "No" );
my $autoswapstr = ( $autoswapbit ? "Yes" : "No" );
my $noswap      = $hashrow{'noswap_reason'};
my $noidleswap  = $hashrow{'noidleswap_reason'};
my $idleswaptime= $hashrow{'idleswap_timeout'} / 60.0;
my $autoswaptime= $hashrow{'autoswap_timeout'} / 60.0;
376
my $rendering   = $hashrow{'prerender_pid'};
377
my $elabinelab  = $hashrow{'elab_in_elab'};
378
my $lockdown    = $hashrow{'lockdown'};
379

380 381
if ($inout ne "out") {
    # I'm going to update this below, so fix the value before I use it.
382
    $idleswap_time = min($idleswaptime * 60, $idleswap_time);
383 384 385
    $idleswaptime = $idleswap_time / 60.0;
}

386 387
my $swapsettings = 
  "Idle-Swap:   $idleswapstr".
388
  ($idleswapbit ? ", at $idleswaptime hours\n" : " (Reason: $noidleswap)\n").
389 390
  "Auto-Swap:   $autoswapstr".
  ($autoswapbit ? ", at $autoswaptime hours\n" : "\n");
391

392
if (! chdir($workdir)) {
Kevin Atkinson's avatar
 
Kevin Atkinson committed
393
    tbdie("Could not chdir to $workdir: $!");
394 395
}

396
#
397 398 399
# This script is called from the batch daemon.
# 
if ($batch) {
400
    #
401 402 403
    # Sanity Check. If called from the daemon, must already be locked,
    # must be a batch experiment, and must be in proper state for the
    # operation requested. 
404
    #
Kevin Atkinson's avatar
 
Kevin Atkinson committed
405
    tbdie("Experiment $pid/$eid is supposed to be a batch experiment!")
406 407
	if (!$isbatchexpt);
    
Kevin Atkinson's avatar
 
Kevin Atkinson committed
408
    tbdie("Batch experiment $pid/$eid should be locked!")
409 410
	if (!defined($expt_locked) ||
	    $batchstate ne BATCHSTATE_LOCKED());
Kevin Atkinson's avatar
 
Kevin Atkinson committed
411 412
    
    tbdie("Batch experiment $pid/$eid is locked down; cannot be swapped!")
413 414
	if ($lockdown);

415
    if ($inout eq "in") {
Kevin Atkinson's avatar
 
Kevin Atkinson committed
416 417
	tbdie("Batch experiment $pid/$eid is not in the proper state!\n".
	      "Currently $estate, but should be QUEUED.")
418 419
	    if ($estate ne EXPTSTATE_QUEUED);
	
Kevin Atkinson's avatar
 
Kevin Atkinson committed
420
	tbdie("Batch experiment $pid/$eid has been canceled! Aborting.")
421
	    if ($canceled);
422 423

	# Do not allow it to swap in. What about swapout? 
Kevin Atkinson's avatar
 
Kevin Atkinson committed
424
	tbdie("Batch experiment cannot swap in when over quota! Aborting.")
425
	    if ($overquota);
426 427
    }
    elsif ($inout eq "out") {
Kevin Atkinson's avatar
 
Kevin Atkinson committed
428 429
	tbdie("Batch experiment $pid/$eid is not in the proper state!\n".
	      "Currently $estate, but should be ACTIVE.")
430
	    if ($estate ne EXPTSTATE_ACTIVE);
431 432
    }
    else {
Kevin Atkinson's avatar
 
Kevin Atkinson committed
433
	tbdie("Improper request from batch daemon for $pid/$eid!\n");
434 435 436 437
    }
}
else {
    if ($isbatchexpt) {
438 439 440 441
	#
	# User is requesting that a batch either be injected or paused.
	# Sanity check the state, but otherwise let the batch daemon
	# handle it.
442 443
	#
	ExitWithStatus(1, "Batch experiment $pid/$eid is still canceling!")
444
	    if ($canceled);
445

446 447 448
	ExitWithStatus(1, "Batch experiment $pid/$eid is locked down!")
	    if ($lockdown);

449
	if ($inout eq "in") {
450
	    ExitWithStatus(1,
451 452 453
			   "Batch experiment $pid/$eid must be SWAPPED to\n".
			   "QUEUE. Currently $estate.")
		if ($estate ne EXPTSTATE_SWAPPED);
454 455 456 457 458 459

	    ExitWithStatus(1,
			   "Batch experiment $pid/$eid cannot swap in when ".
			   "over quota!\n")
		if ($overquota);
	    
460
	    SetExpState($pid, $eid, EXPTSTATE_QUEUED);
461 462
	}
	elsif ($inout eq "out") {
463
	    ExitWithStatus(1,
464 465 466 467
			   "Batch experiment $pid/$eid must be ACTIVE or\n".
			   "ACTIVATING to swap out. Currently $estate.")
		if ($estate ne EXPTSTATE_ACTIVE &&
		    $estate ne EXPTSTATE_ACTIVATING);
468 469 470 471 472

	    #
	    # Since the batch daemon has control, all we can do is set
	    # the cancel bit.
	    # 
473
	    TBSetCancelFlag($pid, $eid, EXPTCANCEL_SWAP);
474 475
	}
	elsif ($inout eq "pause") {
476
	    ExitWithStatus(1,
477 478 479
			   "Batch experiment $pid/$eid must be QUEUED to\n".
			   "DEQUEUE. Currently $estate.")
		if ($estate ne EXPTSTATE_QUEUED);
480 481

	    #
482 483 484 485
	    # XXX. The batch daemon might already have the experiment, but
	    # not have shipped it off to startexp. Change the state
	    # anyway. The error will be noticed later when startexp dies,
	    # and the batch daemon gets the error back. This sucks.
486
	    #
487
	    SetExpState($pid, $eid, EXPTSTATE_SWAPPED);
488
	}
489
	elsif ($inout eq "modify") {
490
	    ExitWithStatus(1,
491 492 493 494
			   "Batch experiment $pid/$eid must be SWAPPED or\n".
			   "ACTIVE to modify. Currently $estate.")
		if (($estate ne EXPTSTATE_SWAPPED &&
		     $estate ne EXPTSTATE_ACTIVATING) ||
495
		    $batchstate ne BATCHSTATE_UNLOCKED());
496

497 498 499
	    ExitWithStatus(1,
			"Cannot modify an active firewalled experiment (yet).")
		if ($firewalled && $estate ne EXPTSTATE_SWAPPED && !$isadmin);
500

501 502 503
	    ExitWithStatus(1,
			"Cannot modify an active ElabInElab experiment (yet).")
		if ($elabinelab && $estate ne EXPTSTATE_SWAPPED && !$isadmin);
504 505 506 507 508 509

	    ExitWithStatus(1,
			   "Cannot modify batch experiment $pid/$eid when ".
			   "over quota!\n")
		if ($overquota);
	    
510
	    #
511
	    # Otherwise, proceed with the modify. The experiment will be
512 513
	    # locked below, and so it cannot be injected or otherwise messed
	    # with since its state is going to be changed before we unlock
514 515 516 517
	    # the experiments table. The batch daemon will leave it alone
	    # until the modify is done. If the modify fails and cannot recover
	    # it is going to get swapped out; that is okay since the batch
	    # daemon does not keep state internally. 
518
	    #
519 520
	    goto doit;
	}
521
	else {
Kevin Atkinson's avatar
 
Kevin Atkinson committed
522
	    tbdie("Operation $inout not allowed on a batch experiment!");
523
	}
524 525
	ExitWithStatus(0, 
		       "Batch experiment $pid/$eid state has been changed.\n");
526
      doit:
527
    }
528 529 530 531 532 533 534 535 536 537
    else {
	#
	# If the cancel flag is set, then user must wait for that to
	# clear before we can do anything else.
	#
	ExitWithStatus(1,
		       "Experiment $pid/$eid has its cancel flag set!.\n".
		       "You must wait for that to clear before you can swap\n".
		       "or modify the experiment.\n")
	    if ($canceled);
538

539 540 541 542
 	ExitWithStatus(1,
		       "Experiment $pid/$eid is locked down; cannot swap!\n")
	    if ($lockdown);

543 544 545 546 547 548 549 550 551 552
	#
	# Check the state for the various operations.
	#
	if (!$force) {
	  SWITCH: for ($inout) {
	      /^in$/i && do {
		  if ($estate ne EXPTSTATE_SWAPPED()) {
		      ExitWithStatus(1,
				     "Experiment $pid/$eid is not swapped out!");
		  }
553 554 555 556 557
		  ExitWithStatus(1,
				 "Experiment $pid/$eid cannot swap in when ".
				 "over quota!\n")
		      if ($overquota);
		  
558 559 560 561
		  last SWITCH;
	      };
	      /^out$/i && do {
		  if ($estate ne EXPTSTATE_ACTIVE() &&
Leigh B. Stoller's avatar
Leigh B. Stoller committed
562
 		      $estate ne EXPTSTATE_PANICED() &&
563 564 565 566 567 568
		      $estate ne EXPTSTATE_ACTIVATING()) {
		      ExitWithStatus(1,
				     "Experiment $pid/$eid is not swapped in ".
				     "or activating!\n");
		  }
		  
Leigh B. Stoller's avatar
Leigh B. Stoller committed
569 570 571 572 573 574 575 576 577 578 579 580
 		  #
 		  # Must be an admin person to swap out an experiment that
 		  # has had its panic button pressed.
 		  #
 		  if ($estate eq EXPTSTATE_PANICED() && !$isadmin) {
 		      ExitWithStatus(1,
 				     "Experiment $pid/$eid had its panic ".
 				     "button pressed!\n".
 				     "Only a testbed administrator can swap ".
 				     "this experiment out.");
 		  }

581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609
		  if ($estate eq EXPTSTATE_ACTIVATING()) {
		      #
		      # All we can do is set the cancel flag and hope that
		      # it gets noticed. We do not wait. 
		      # 
		      TBSetCancelFlag($pid, $eid, EXPTCANCEL_SWAP);
		      
		      ExitWithStatus(0,
				     "Experiment $pid/$eid swapin has been  ".
				     "marked for cancelation.\n".
				     "You will receive email when the original ".
				     "swap request has finished.");
		  }
		  last SWITCH;
	      };
	      /^restart$/i && do {
		  if ($estate ne EXPTSTATE_ACTIVE()) {
		      ExitWithStatus(1,
				     "Experiment $pid/$eid is not swapped in!");
		  }
		  last SWITCH;
	      };
	      /^modify$/i && do {
		  if ($estate ne EXPTSTATE_ACTIVE() &&
		      $estate ne EXPTSTATE_SWAPPED()) {
		      ExitWithStatus(1,
				     "Experiment $pid/$eid must be ACTIVE or\n".
				     "SWAPPED to modify!\n");
		  }
610
		  ExitWithStatus(1,
611 612 613 614
			"Cannot modify an active firewalled experiment (yet).")
		      if ($firewalled &&
			  $estate ne EXPTSTATE_SWAPPED && !$isadmin);

615
		  ExitWithStatus(1,
616 617 618
			"Cannot modify an active ElabInElab experiment (yet).")
		      if ($elabinelab &&
			  $estate ne EXPTSTATE_SWAPPED && !$isadmin);
619 620 621 622 623

		  ExitWithStatus(1,
				 "Experiment $pid/$eid cannot be modified ".
				 "when over quota!\n")
		      if ($overquota);
624
		  
625 626
		  last SWITCH;
	      };
Kevin Atkinson's avatar
 
Kevin Atkinson committed
627
	      tbdie("Missing state check for action: $action");
628
	  }
629 630
	}
    }
631 632
}

633 634 635 636 637 638 639
#
# Determine the temporary and next state for experiment. If the experiment
# is a batch experiment, then the next state is actually handled by the
# batch daemon, but we still have to deal with the temporary state. 
#
SWITCH: for ($inout) {
    /^in$/i && do {
640
	$nextswapstate = EXPTSTATE_ACTIVATING();
641 642 643
	last SWITCH;
    };
    /^out$/i && do {
644
	$nextswapstate = EXPTSTATE_SWAPPING();
645 646 647
	last SWITCH;
    };
    /^restart$/i && do {
648
	$nextswapstate = EXPTSTATE_RESTARTING();
649 650 651
	last SWITCH;
    };
    /^modify$/i && do {
652 653
	$nextswapstate = (($estate eq EXPTSTATE_SWAPPED()) ?
			  EXPTSTATE_MODIFY_PARSE() : EXPTSTATE_MODIFY_REPARSE());
654 655
	last SWITCH;
    };
Kevin Atkinson's avatar
 
Kevin Atkinson committed
656
    tbdie("Missing state check for action: $action");
657
}
658 659
 
# Update idleswap_timeout to whatever the current value is.
660
if ($inout ne "out") {
661 662 663
    DBQueryFatal("update experiments set idleswap_timeout='$idleswap_time' ".
		 "where eid='$eid' and pid='$pid'");
}
664

665 666 667 668 669 670
#
# On a failure, we go back to this swapstate. Might be modified below.
# 
$termswapstate = $estate;

# Lock the record, set the nextstate, and unlock the table.
671
TBLockExp($pid, $eid, $nextswapstate)
Kevin Atkinson's avatar
 
Kevin Atkinson committed
672
    or tbdie("Failed to set experiment state to $nextswapstate");
673 674 675 676 677 678 679

#
# At this point, we need to force a cleanup no matter how we exit.
# See the END block below.
#
$justexit = 0;

680 681 682 683
DBQueryFatal("unlock tables");

#
# XXX - At this point a failure is going to leave things in an
684 685 686 687
# inconsistent state. Be sure to call fatal() only since we are
# going into the background, and we have to send email since no
# one is going to see printed error messages (output goes into the
# log file, which will be sent along in the email). 
688 689
#

690 691
if ($inout eq "in") {
    $action = "swapped in";
692
    $tag    = "swapin";
693 694 695
}
if ($inout eq "out") {
    $action = "swapped out";
696
    $tag    = "swapout";
697 698 699 700
}
if ($inout eq "restart") {
    $action = "restarted";
}
Chad Barb's avatar
 
Chad Barb committed
701 702
if ($inout eq "modify") {
    $action = "modified";
703
    $tag    = "swapmod";
Chad Barb's avatar
 
Chad Barb committed
704
}
705

706 707 708 709 710 711 712 713 714
#
# Get email address of the experiment head, which may be different than
# the person who is actually terminating the experiment, since its polite
# to let the original creator know whats going on. 
#
my $expt_head_name;
my $expt_head_email;

if (! UserDBInfo($expt_head_login, \$expt_head_name, \$expt_head_email)) {
Kevin Atkinson's avatar
 
Kevin Atkinson committed
715
    tbwarn("Could not determine name/email for $expt_head_login.");
716 717 718 719
    $expt_head_name  = "TBOPS";
    $expt_head_email = $TBOPS;
}

720 721 722
#
# Before going to background, we have to copy out the NS file!
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
723
if ($inout eq "modify" && defined($modnsfile)) {
724 725
    unlink($modnsfile);
    if (system("/bin/cp", "$tempnsfile", "$modnsfile")) {
726
	fatal("Could not copy $tempnsfile to $modnsfile");
727 728 729 730
    }
    chmod(0664, "$modnsfile");
}

731 732 733
#
# If not in batch mode, go into the background. Parent exits.
#
734
if (! $batch && ! $template_mode) {
735
    $logname = TBExptCreateLogFile($pid, $eid, "swapexp");
736
    TBExptSetLogFile($pid, $eid, $logname);
737
    TBExptOpenLogFile($pid, $eid);
Chad Barb's avatar
Chad Barb committed
738

739 740
    if (my $childpid = TBBackGround($logname)) {
	#
741 742
	# Parent exits normally, unless in waitmode. We have to set
	# justexit to make sure the END block below does not run.
743
	#
744 745
	$justexit = 1;

746
	if (!$waitmode) {
747 748 749
	    print("Experiment $pid/$eid is now being $action.\n".
		  "You will be notified via email when the this is done.\n")
		if (! $quiet);
750 751
	    exit(0);
	}
752 753 754 755 756 757 758 759
	print("Waiting for experiment $eid to finish its swap${action}\n")
	    if (! $quiet);
	    
	if (isatty(STDIN) && !$quiet) {
	    print("You may type ^C at anytime; you will be notified via email.".
		  "\n".
		  "You will not actually interrupt the experiment itself.\n");
	}
760 761 762 763 764 765 766 767 768 769 770 771
	
	# Give child a chance to run.
	select(undef, undef, undef, 0.25);
	
	#
	# Reset signal handlers. User can now kill this process, without
	# stopping the child.
	#
	$SIG{TERM} = 'DEFAULT';
	$SIG{INT}  = 'DEFAULT';
	$SIG{QUIT} = 'DEFAULT';

772
	#
773
	# Wait until child exits or until user gets bored and types ^C.
774
	#
775 776
	waitpid($childpid, 0);
	
777 778
	print("Done. Exited with status: $?\n")
	    if (! $quiet);
Kevin Atkinson's avatar
 
Kevin Atkinson committed
779 780 781 782 783 784 785 786 787 788

	my $exit_code = $? >> 8;

	if ($exit_code != 0) {
	    my $d = tblog_lookup_error();
	    print tblog_format_error($d);
	}

	exit $exit_code;

789
    }
790
    TBdbfork();
791 792
}

793 794 795 796 797 798 799 800
#
# When in waitmode, must put ourselves in another process group so that
# an interrupt to the parent will not have any effect on the backend.
#
if ($waitmode) {
    POSIX::setsid();
}

801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820
#
# We need to catch TERM cause sometimes shit happens and we have to kill
# an experiment swap that is hung or otherwise scrogged. Rather then 
# trying to kill off the children one by one, lets arrange to catch it
# here and send a killpg to the children. This is not to be done lightly,
# cause it can leave things worse then they were before!
#
sub handler ($) {
    my ($signame) = @_;
    
    $SIG{TERM} = 'IGNORE';
    my $pgrp = getpgrp(0);
    kill('TERM', -$pgrp);
    sleep(1);
    $signaled = 1;
    fatal("Caught SIG${signame}! Killing experiment setup ...");
}
$SIG{TERM} = \&handler;
$SIG{QUIT} = 'DEFAULT';

821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836
#
# Gather stats; start clock ticking
#
if ($inout eq "in") {
    GatherSwapStats($pid, $eid, $dbuid, TBDB_STATS_SWAPIN, 0,
		    TBDB_STATS_FLAGS_START);
}
elsif ($inout eq "out") {
    GatherSwapStats($pid, $eid, $dbuid, TBDB_STATS_SWAPOUT, 0,
		    TBDB_STATS_FLAGS_START);
}
elsif ($inout eq "modify") {
    GatherSwapStats($pid, $eid, $dbuid, TBDB_STATS_SWAPMODIFY, 0,
		    TBDB_STATS_FLAGS_START);
}

837 838 839
#
# Remove old report file since its contents are going to be invalid.
#
840
if ($inout ne "restart" && -e $repfile) {
841 842 843
    unlink("$repfile");
}

844 845 846 847
#
# Sanity check states in case someone changes something.
#
if ($inout eq "out") {
848
    my $optarg = (($force || $idleswap) ? "-force" : "");
849

850 851
    print STDOUT "Running 'tbswap out $optarg $pid $eid'\n";
    if (system("$tbdir/tbswap out $optarg $pid $eid") != 0) {
852
	$errorstat = $? >> 8;
853
	fatal("tbswap out failed!");
854
    }
855 856 857 858 859 860 861 862

    #
    # Add the files that have been detected by tracing to the archive.
    #
    if (libArchive::TBExperimentArchiveAddTracedFiles($pid, $eid) < 0) {
	fatal("Failed to add traced files to the experiment archive!");
    }

Leigh B. Stoller's avatar
Leigh B. Stoller committed
863 864 865 866 867 868 869
    #
    # Add the special per-experiment archive directory.
    #
    if (libArchive::TBExperimentArchiveAddUserFiles($pid, $eid) < 0) {
	fatal("Failed to add user specified files to the experiment archive!");
    }

870 871
    SetExpState($pid, $eid, EXPTSTATE_SWAPPED)
	or fatal("Failed to set experiment state to " . EXPTSTATE_SWAPPED());
Leigh B. Stoller's avatar
Leigh B. Stoller committed
872
    TBExptClearPanicBit($pid, $eid);
873
}
874
elsif ($inout eq "in") {
875 876
    GatherSwapStats($pid, $eid, $dbuid,
		    TBDB_STATS_SWAPIN, 0, TBDB_STATS_FLAGS_PRESWAPIN);
877 878 879 880

    # Set the swapper now so that nodes use the proper uid. If the swapin
    # fails, we leave the swapper as is, since its harmless and informative.
    TBExptSetSwapUID($pid, $eid, $dbuid);
881
    
882
    print STDOUT "Running 'tbswap in $pid $eid'\n";
Chad Barb's avatar
 
Chad Barb committed
883
    if (system("$tbdir/tbswap in $pid $eid") != 0) {
884
	$errorstat = $? >> 8;
885
	fatal("tbswap in failed!");
886
    }
887 888
    SetExpState($pid, $eid, EXPTSTATE_ACTIVE)
	or fatal("Failed to set experiment state to " . EXPTSTATE_ACTIVE());
889

890
    system("$tbdir/tbreport -b $pid $eid 2>&1 > $repfile");
Chad Barb's avatar
Chad Barb committed
891
}
Chad Barb's avatar
 
Chad Barb committed
892
elsif ($inout eq "modify") {
893
    my $modifyError;
Chad Barb's avatar
Chad Barb committed
894

895 896 897
    #
    # Prepare the Archive for the swapmod, in case we have to "roll back".
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
898
    print "Doing a preswapmod on the experiment archive ...\n";
899 900 901 902
    if (libArchive::TBExperimentArchivePreSwapMod($pid, $eid) < 0) {
	fatal("Failed to do a preswapmod on the experiment archive!");
    }

903 904 905
    GatherSwapStats($pid, $eid, $dbuid,
		    TBDB_STATS_SWAPMODIFY, 0, TBDB_STATS_FLAGS_PREMODIFY);

906 907 908 909 910
    # Gather up some firewall state for later comparison.
    if (GatherFWinfo() < 0) {
	fatal("Could not gather firewall info; cannot safely continue!");
    }

Chad Barb's avatar
Chad Barb committed
911
    print "Backing up old experiment state ... " . TBTimeStamp() . "\n";
912
    if (TBExptBackupVirtualState($pid, $eid)) {
913
	fatal("Could not backup experiment state; cannot safely continue!");
Chad Barb's avatar
Chad Barb committed
914 915 916
    }

    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
917
    # Rerun tbprerun if modifying, but only if new NS file provided.
918 919
    # Yep, we allow reswap without changing the NS file. For Shashi and SIM.
    # Note that tbprerun kills the renderer if its running.
Chad Barb's avatar
Chad Barb committed
920
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
921 922 923
    if (defined($modnsfile)) {
	print STDOUT "Running 'tbprerun $pid $eid $modnsfile'\n";
	if (system("$tbdir/tbprerun $pid $eid $modnsfile") != 0) {
924
	    print STDOUT "Modify Error: tbprerun failed.\n";
925
	  FWHOSED:
926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943
	    print STDOUT "Recovering experiment state...\n";

	    if (TBExptRemoveVirtualState($pid, $eid) ||
		TBExptRestoreVirtualState($pid, $eid)) {
		$modifyHosed = 1;
		fatal("Experiment state could not be restored!");
		# Never returns;
	    }
	    #
	    # If the renderer was running when we started the swapmod, then we
	    # want to restart it. If it was stopped, then the renderer info
	    # was captured with the rest of the virtual state (restored above).
	    #
	    system("prerender -t $pid $eid")
		if ($rendering);

	    fatal("Update aborted; old virtual state restored.");
	    # Never returns;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
944
	}
945 946 947 948 949 950 951 952 953
	#
	# Okay, whenever a new NS file is presented, we need to do some
	# checks on the firewall to make sure the user is not trying to
	# do something "unsafe". 
	#
	if (CheckFWinfo($estate) != 0) {
	    # All the stuff for recovering is right above, so go there. 
	    goto FWHOSED;
	}
Chad Barb's avatar
Chad Barb committed
954 955
    }

Chad Barb's avatar
 
Chad Barb committed
956
    #
957
    # Our next state depends on whether the experiment was active or swapped.
Chad Barb's avatar
 
Chad Barb committed
958
    #
959 960 961 962 963
    if ($estate eq EXPTSTATE_SWAPPED) {
	SetExpState($pid, $eid, EXPTSTATE_SWAPPED);
    }
    else {
	SetExpState($pid, $eid, EXPTSTATE_MODIFY_RESWAP);
964

965 966 967 968 969
	# Set the swapper now so that nodes use the proper uid. If the
	# swapin fails, we need to reset the swapper back so that he
	# is charged appropriately.
	TBExptSetSwapUID($pid, $eid, $dbuid);

970 971 972 973 974 975 976 977 978 979 980 981
	my $optarg = "";
	#
	# For elabinelab experiments; ignore reboot/eventsys_restart,
	# and force noreconfig; none of it will work or make sense. 
	#
	if ($elabinelab) {
	    $optarg = "-noreconfig";
	}
	else {
	    $optarg  = ($reboot ? "-reboot" : "");
	    $optarg .= ($eventsys_restart ? " -eventsys_restart" : "");
	}
982

983 984 985
	print STDOUT "Running 'tbswap update $optarg $pid $eid'\n";
	if (system("$tbdir/tbswap update $optarg $pid $eid") == 0) {
	    #
986 987
	    # Success. Set the state back to active cause thats where it
	    # started.
988 989 990 991 992 993 994
	    # 
	    SetExpState($pid, $eid, EXPTSTATE_ACTIVE);
	    $estate = EXPTSTATE_ACTIVE;
	}
	else {
	    $modifyError = $errorstat = $? >> 8;
	    print STDOUT "Modify Error: tbswap update failed.\n";
Chad Barb's avatar
 
Chad Barb committed
995

996
	    #
997 998 999
	    # tbswap either restored the experiment to the way it was,
	    # or it swapped it out completely. In either case, it has
	    # also restored the virtual state. 
1000
	    # 
1001 1002 1003 1004 1005 1006 1007
	    # Icky. Magic return code that says tbswap swapped it out.
	    # We do not want tbswap to muck with states anymore, so
	    # need to know what it did. At some point we should clean
	    # up the exit reporting! Anyway, fatal() needs to know the
	    # the right state to go back to (no longer ACTIVE).
	    #
	    if ($errorstat & 0x40) {
1008 1009
		$estate = EXPTSTATE_SWAPPED;
		$termswapstate = EXPTSTATE_SWAPPED;
1010
		$modifySwapped = 1;
1011 1012
                # Old accounting info.
		TBSetExpSwapTime($pid, $eid);
1013 1014 1015 1016
		$modifyError = "Update aborted; experiment swapped out.";
	    }
	    else {
		$modifyError = "Update aborted; old state restored.";
1017 1018 1019

		# Reset the swapper since the experiment is still running.
		TBExptSetSwapUID($pid, $eid, $last_swap_uid);
Chad Barb's avatar
 
Chad Barb committed
1020
	    }
1021
	}
Chad Barb's avatar
Chad Barb committed
1022 1023
    }