tbswap.in 55.5 KB
Newer Older
1 2 3
#!/usr/bin/perl -w

#
4
# Copyright (c) 2000-2018 University of Utah and the Flux Group.
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
# 
# {{{EMULAB-LICENSE
# 
# This file is part of the Emulab network testbed software.
# 
# This file is free software: you can redistribute it and/or modify it
# under the terms of the GNU Affero General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
# 
# This file is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Affero General Public
# License for more details.
# 
# You should have received a copy of the GNU Affero General Public License
# along with this file.  If not, see <http://www.gnu.org/licenses/>.
# 
# }}}
24 25 26
#
use English;

27 28 29
# Returns 0 on success.
# Returns 1 on non-assign_wrapper failure.
# Returns (1 | assign_wrapper's errorcode) on assign_wrapper failure.
30 31
# Returns |0x40 if update caused a swapout. Icky.
# Returns -1 on uncontrolled error (die called).
32

33 34 35 36 37
# XXX: handle error cases for update? (backup the db?)
# XXX: Shouldn't do idempotent stuff twice for update.
# XXX: repush/calc routing for update??? (tbprerun)
# XXX: previz for update???              (tbprerun)
# XXX: make snmpit faster for update.
38 39 40
#
# XXX: for update, expt is swapped out on os_setup fail.
#      (we only recover if assign fails)
41 42 43

sub usage()
{
44 45 46
    print STDERR
	"Usage: $0 {in|out|modify [-reboot] [-eventsys_restart]} ".
	"[-noswapout] [-genimode] pid eid\n";
47 48 49 50 51 52 53
    exit(-1);
}

#
# Configure variables
#
my $TBROOT         = "@prefix@";
54
my $TBOPS          = "@TBOPSEMAIL@";
55
my $TBLOGS         = "@TBLOGSEMAIL@";
56
my $MAINSITE	   = @TBMAINSITE@;
57
my $ELABINELAB     = @ELABINELAB@;
58
my $THISHOMEBASE   = "@THISHOMEBASE@";
59 60
my $TESTMODE       = @TESTMODE@;
my $DISABLE_EVENTS = "@DISABLE_EVENT_SCHED@";
61 62
my $mapper         = "$TBROOT/bin/mapper";
my $wrapper        = "$TBROOT/libexec/assign_wrapper";
63
my $SNMPIT	   = "$TBROOT/bin/snmpit";
64
my $RFLINKS	   = "$TBROOT/bin/rflinks";
65
my $IMAGESETUP     = "$TBROOT/sbin/image_setup";
66
my $PUSHROOTKEY	   = "$TBROOT/sbin/pushrootkey";
67
my $portstats	   = "$TBROOT/bin/portstats";
68
my $TCPP           = "$TBROOT/sbin/tcpp";
69
my $NFSTRACESUPPORT= @NFSTRACESUPPORT@;
70
my $PGENISUPPORT   = @PROTOGENI_SUPPORT@;
71 72 73 74 75 76 77 78 79 80 81

# Untaint the path
$ENV{'PATH'} = "/usr/bin:$TBROOT/libexec:$TBROOT/libexec/ns2ir" . 
    ":$TBROOT/sbin:$TBROOT/bin";

#
# Testbed Support libraries
#
use lib "@prefix@/lib";
use libdb;
use libtestbed;
82
use libadminctrl;
83
use libadminmfs;
84
use libtblog;
85
use EmulabFeatures;
86
use Experiment;
87
use User;
88
use Lan;
89
use Firewall;
90 91 92 93

#
# Actual swap-in and swap-out functions, defined below.
#
94 95 96
sub doSwapout($);
sub doSwapin($);

97
# XXX fixme: should not be hardwired!
98
my $cnetstack = "-S Control";
99 100 101
my $cnetvlanname = "Control";


102 103 104 105
sub REAL()    { return 5; }
sub CLEANUP() { return 4; }
sub RETRY()   { return 3; }
sub MODIFY()  { return 2; }
106
sub UPDATE()  { return 1; }
107
sub MODIFY_RECOVER()  { return 0; }
108

109 110 111
#
# Grab global enable of linkdelays.
#
112
my $enablelinkdelays = TBGetSiteVar("general/linux_endnodeshaping");
113

114 115 116 117 118 119
#
# Turn off line buffering on output
#

$| = 1;

120 121
my $updateReboot   = 0;
my $updateReconfig = 1;
122 123
my $update_Eventsys_restart = 0;
my $elabinelab     = 0;
124
my $plabinelab     = 0;
125 126 127 128 129
my $force          = 0;
my $noswapout      = 0;
my $genimode       = 0;
my $errors         = 0;
my $updatehosed    = 0;
130
my $canceled;
131
my $os_setup_pid;
132
my $nextState;
133 134

#
135
# First argument is either "in", "out", or "update";
136 137 138 139 140
# this value goes into $swapop.
#

my $swapop = shift;	

141 142 143
if (!$swapop || 
    (($swapop ne "in") && 
     ($swapop ne "out") &&
144
     ($swapop ne "modify") &&
145
     ($swapop ne "update"))) {
146 147 148 149 150 151 152 153 154 155 156
    usage();
}

#
# Get other arguments.
#

while ($#ARGV > 1) {
    $arg = shift;
    if ($arg eq "-force") {
	$force = 1;
157 158
    } elsif ($arg eq "-reboot") {
	$updateReboot = 1;
159
	$updateReconfig = 0;
160 161 162
    } elsif ($arg eq "-noreconfig") {
	$updateReboot   = 0;
	$updateReconfig = 0;
163
    } elsif ($arg eq "-eventsys_restart" && $swapop eq "modify") {
164
	$update_Eventsys_restart = 1;
165
    } elsif ($arg eq "-noswapout") {
166
	$noswapout = 1;
167 168 169 170 171 172 173 174 175
    } else {
	usage();
    }
}
if ($#ARGV < 1) {
    usage();
}
my ($pid,$eid) = @ARGV;

176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191
#
# Untaint the arguments.
#
if ($pid =~ /^([-\@\w.]+)$/) {
    $pid = $1;
}
else {
    die("Tainted argument $pid!\n");
}
if ($eid =~ /^([-\@\w.]+)$/) {
    $eid = $1;
}
else {
    die("Tainted argument $eid!\n");
}

192 193 194 195 196 197
#
# Set Error reporting info
# 
tblog_set_info($pid,$eid,$UID);

#
198
# Turn on timestamps
199
#
200 201
TBDebugTimeStampsOn();

202 203 204 205 206 207
#
# Verify user and get his DB uid and other info for later.
#
my $this_user = User->ThisUser();
if (! defined($this_user)) {
    tbdie("You ($UID) do not exist!");
208
}
209 210 211
my $user_uid   = $this_user->uid();
my $user_name  = $this_user->name();
my $user_email = $this_user->email();
212

213 214 215 216 217 218
# Slowly convert to using Experiment module.
my $experiment = Experiment->Lookup($pid, $eid);
if (!defined($experiment)) {
    tbdie("Could not lookup experiment object!")
}

219 220 221 222 223 224 225 226
# Do not reboot *or* reconfig the shared node experiment.
if (($swapop eq "modify" || $swapop eq "update") &&
    $pid eq TBOPSPID() &&
    ($eid eq "shared-nodes" || $eid eq "shared-node")) {
    $updateReboot   = 0;
    $updateReconfig = 0;
}

227 228 229
#
# Print starting message.
#
230 231 232
my $exptidx = $experiment->idx();
my $state   = $experiment->state();
my $group   = $experiment->GetGroup();
233

234 235
print "Beginning swap-$swapop for $pid/$eid ($exptidx). " .
    TBTimeStampWithDate() . "\n";
236 237
TBDebugTimeStamp("tbswap $swapop started");

238 239 240
# Sanity check the current state. 
if (!$force) {
    if ($swapop eq "in") {
241
	tbdie("Experiment should be ACTIVATING. Currently $state.")
242
	    if ($state ne EXPTSTATE_ACTIVATING);
243
    }
244
    elsif ($swapop eq "out") {
245
	tbdie("Experiment should be SWAPPING. Currently $state.")
246
	    if ($state ne EXPTSTATE_SWAPPING);
247
    }
248
    elsif ($swapop eq "modify" || $swapop eq "update") {
249
	tbdie("Experiment should be MODIFY_RESWAP. Currently $state.")
250
	    if ($state ne EXPTSTATE_MODIFY_RESWAP);
251 252
    }
}
253 254
# Get elabinelab status. See below.
if (! TBExptIsElabInElab($pid, $eid, \$elabinelab)) {
255
    tbdie("Could not get elabinelab status for experiment $pid/$eid");
256
}
257 258 259 260 261 262 263 264 265 266 267
# and plabinelab status.
if (! TBExptIsPlabInElab($pid, $eid, \$plabinelab)) {
    tbdie("Could not get plabinelab status for experiment $pid/$eid");
}
if ($elabinelab && $plabinelab) {
    tberror "Cannot get my head around Plab in Elab in Elab!\n";
    print "Failingly finished swap-$swapop for $pid/$eid. " .
	TBTimeStamp() . "\n";
    TBDebugTimeStamp("tbswap $swapop finished (failed)");
    exit(1);
}
268

269 270 271 272 273 274 275 276
#
# See if we use the new version of SyncVlans.
#
my $syncvlans =
    (EmulabFeatures->FeatureEnabled("SyncVlans",
				    $this_user, $group, $experiment)
     || $pid eq "emulab-ops");

277 278 279 280 281
#
# See if the experiment is firewalled
#
my $firewalled = TBExptFirewall($pid, $eid);

282 283 284
#
# Do actual swapping
#
285 286 287 288
if ($swapop eq "out") {
    #
    # Swap out
    #
289
    tblog_set_attempt(1);
290
    $errors = doSwapout(REAL);
291
}
292
elsif ($swapop eq "update" || $swapop eq "modify") {
293 294 295 296 297 298
    #
    # Before swapout, do cursory admission control to see if the
    # modified experiment will be swappable. assign_wrapper does a
    # more stringent check using assign.
    #
    print STDERR "Checking with Admission Control ...\n";
299
    if (! TBAdmissionControlCheck(undef, $experiment, undef)) {
300 301 302
	tberror({type => 'secondary', severity => SEV_SECONDARY,
		 error => ['admission_control_failure']},
		"Admission control failure!\n");
303 304 305 306 307 308
	print "Failingly finished swap-$swapop for $pid/$eid. " .
	    TBTimeStamp() . "\n";
	TBDebugTimeStamp("tbswap $swapop finished (failed)");
	exit(1);
    }
    
309 310
    #
    # Update.
311 312 313
    #
    tblog_set_attempt(1);

314 315 316 317
    #
    # Phase One -- swap experiment partially out.
    #
    print STDERR "Backing up physical state...\n";
318
    $experiment->BackupPhysicalState();
319

320 321 322 323 324
    #
    # Actually, in update mode this is not done cause we are anticipating
    # adding nodes only.
    #
    $errors = ($swapop eq "modify" ? doSwapout(MODIFY) : 0);
325

326
    if ($errors) {
327
	#
328
	# Clean up the mess, leaving the experiment in the SWAPPED state,
329
	#
330
	if ($noswapout || $elabinelab) {
331 332 333 334 335
	    print STDERR "Leaving experiment swapped in as directed.\n";
	}
	else {
	    print STDERR "Cleaning up after errors.\n";
	    doSwapout(CLEANUP);
336
	    $updatehosed = 1;
337
	}
338
    }
339
    else {
340
	#
341
	# Phase Two -- swap experiment back in.
342
	#
343
	$errors = doSwapin(MODIFY);
344

345
	if ($errors) {
346 347 348
	    #
	    # There were errors; see if we can recover.
	    #
349
	    my $CanRecover = 1;
350 351 352

	    if ($errors != 7) {
		print STDERR "Update failure occurred _after_ assign phase; ";
353
		$CanRecover = 0;
354 355
	    }

356 357 358
	    if ($CanRecover) {
		print STDERR "Recovering virtual and physical state.\n";

359 360 361
		# It is safe to remove the phystate since we know it was
		# backed up above, and cause we do not know if assign_wrapper
		# made it to that point before it failed. 
362 363 364 365 366
		if ($experiment->RemoveVirtualState() ||
		    $experiment->RestoreVirtualState() ||
		    $experiment->ReserveSharedBandwidth(1, 1) ||
		    $experiment->RemovePhysicalState() ||
		    $experiment->RestorePhysicalState()) {
367 368
		    print STDERR "Could not restore backed-up state; ";
		    $CanRecover = 0;
369
		}
370 371 372
		else {
		    print STDERR "Doing a recovery swap-in of old state.\n";

373
		    if (doSwapin(MODIFY_RECOVER)) {
374 375 376
			print STDERR "Could not swap in old physical state; ";
			$CanRecover = 0;
		    }
377 378
		}
	    }
379 380 381 382 383 384

	    #
	    # Some part of the recovery failed; must swap it out. swapexp
	    # (caller) will then have to do more clean up, hence the special
	    # exit status indicated by $updatehosed.
	    # 
385
	    if (!$CanRecover) {
386
		if ($noswapout || $elabinelab) {
387 388 389 390 391 392 393 394 395
		    print STDERR
			"No Recovery, but leaving experiment swapped in.\n";
		}
		else {
		    print STDERR
			"Recovery aborted! Swapping experiment out.\n";
		    doSwapout(CLEANUP);
		    $updatehosed = 1;
		}
396 397 398
	    }
	    else {
		print STDERR "Update recovery successful.\n";
399
	    }
400
	}
401 402
    }
}
403 404 405 406 407
elsif ($swapop eq "in") {
    #
    # Swap in
    #
    my $retries = 2;
408 409 410 411 412 413

    #
    # Before real swapin, do cursory admission control. assign_wrapper does
    # a more stringent check using assign.
    #
    print STDERR "Checking with Admission Control ...\n";
414
    if (! TBAdmissionControlCheck(undef, $experiment, undef)) {
415 416 417
	tberror({type => 'secondary', severity => SEV_SECONDARY,
		 error => ['admission_control_failure']},
		"Admission control failure!\n");
418 419 420 421 422
	print "Failingly finished swap-$swapop for $pid/$eid. " .
	    TBTimeStamp() . "\n";
	TBDebugTimeStamp("tbswap $swapop finished (failed)");
	exit(1);
    }
423 424

    tblog_set_attempt(1);
425
    $errors = doSwapin(REAL);
426

427 428 429 430 431 432 433 434 435 436
    #
    # Attempt a retry if: 
    #   a) there were errors, 
    #   b) doswapin() indicated (via return code 3) a retry is appropriate,
    #   c) we haven't tried too many times already.
    #   d) The cancelflag has not been set.
    #   e) $TESTMODE == 0.
    #
    while ($errors == 3 && $retries && !$canceled && !$TESTMODE) {
	$retries--;
437
	tblog_inc_attempt();
438

439 440
	print STDERR "Cleaning up after errors; will try again.\n";
	doSwapout(RETRY);
441

442 443
	print STDERR "Trying again...\n";
	$errors = doSwapin(RETRY);
444
    }
445 446
    if ($errors || $canceled) {
	print STDERR "Cleaning up after " .
447
	    ($canceled ? "cancelation" : "errors") . ".\n";
448
	doSwapout(CLEANUP);
449 450 451
    }
}

452 453 454 455
tblog_set_attempt(0);

TBGetCancelFlag($pid, $eid, \$canceled);
if ($canceled) {
456 457
    tberror ({type=>'summary', cause=>'canceled', 
	      severity=>SEV_IMMEDIATE, error=>['cancel_flag']},
458 459 460
	     "Experiment swap-$swapop canceled by user.");
}

461 462 463 464
#
# Write appropriate message and exit.
#
if ($errors) {
465
    print "Failingly finished swap-$swapop for $pid/$eid. ".TBTimeStamp()."\n";
466
    TBDebugTimeStamp("tbswap $swapop finished (failed)");
467

468 469
    # Pass out magic value to indicate that update failed!
    exit(1 | ($updatehosed ? 0x40 : 0));
470
}
471
print "Successfully finished swap-$swapop for $pid/$eid. " .TBTimeStamp()."\n";
472 473
TBDebugTimeStamp("tbswap $swapop finished (succeeded)");
exit(0);
474 475 476 477

#################################

##
478
#
479 480
# doSwapout - Swaps experiment out.
#
481
#             If in REAL or CLEANUP,
482 483 484
#             this function will free all nodes for the 
#             experiment.
#
485
#             If in RETRY or UDPATE,
486 487 488 489 490 491
#             only nodes not in RES_READY will be freed.
#
#             Returns 0 on success, >0 on failure.
#
##

492
sub doSwapout($) {
493
    my $type = shift;
494 495
    my $swapout_errors = 0;

496 497
    tblog_set_cleanup(1) if $type == CLEANUP;

498 499 500 501 502 503 504 505 506
    #
    # wait for os_setup;
    # this only applies if called after a failed doswapin.
    #
    if ($os_setup_pid) {
	print "Waiting for os_setup to finish\n";
	waitpid($os_setup_pid, 0);
	undef $os_setup_pid;
    }
507

508
    if (0 && $NFSTRACESUPPORT && $type == REAL) {
509 510
	print "Getting files accessed via NFS.\n";
	TBDebugTimeStamp("nfstrace started");
511
	system("nfstrace transfer $pid $eid");
512
	TBDebugTimeStamp("nfstrace finished");
513
    }
514

515
    if (! $TESTMODE) { 
516 517
	if (! ($DISABLE_EVENTS || $elabinelab)) {
	    if ($type >= RETRY ||
518
		($update_Eventsys_restart && $type == MODIFY) ) {
519
		print "Stopping the event system\n";
520
		if (system("eventsys_control stop $pid,$eid")) {
521 522 523
		    tberror({type => 'secondary', severity => SEV_SECONDARY,
			     error => ['eventsys_stop_failed']},
			    "Failed to stop the event system.");
524 525
		    $swapout_errors = 1;
		}
526 527
	    }
	}
528 529 530 531 532 533
	
	#
	# Do teardown of inner elab. We must do this before we teardown the
	# vlans since the inner control network is a vlan, and we want that
	# active so inner boss can reboot the inner nodes (avoid power cycle).
	#
534
	if ($elabinelab && $type >= CLEANUP) {
535 536
	    print "Tearing down elabinelab. This could take a while.\n";
	    if (system("elabinelab -k $pid $eid")) {
537 538 539
		tberror({type => 'secondary', severity => SEV_SECONDARY,
			 error => ['elabinelab_tear_down_failed']},
			"Failed to teardown elabinelab!");
540 541 542 543
		$swapout_errors = 1;
	    }
	}

544 545 546 547 548 549 550 551 552 553
	#
	# Tear down TCP proxies.
	#
	if( $type != MODIFY ) {
	    print "Closing TCP proxy ports...\n";
	    if( system( "$TCPP -d $pid $eid" ) != 0 ) {
		tbwarn( "TCP proxy setup failed!" );
	    }
	}

554 555 556 557 558
	if( $type >= CLEANUP ) {
	    print "Releasing public address pools...\n";
	    $experiment->ReleasePublicAddrPools();
	}

559 560 561 562 563 564
	if( $type >= CLEANUP ) {
	    if( system( "$RFLINKS -r $pid $eid" ) ) {
		tbwarn( "Failed to remove RF links" );
	    }
	}
	
565 566 567 568
	#
	# Grab our per-experiment switch stack name.
	#
	my @expswitches = $experiment->SwitchList(1);
569
	my ($perexpstack,$leader,@curswitches) = 
570 571 572 573 574 575
	    GetPerExperimentSwitchStack($experiment);
	my $stackarg = "";
	if (defined($perexpstack) && (@expswitches || @curswitches)) {
	    $stackarg = "-S $perexpstack --skip-supplied";
	}

576 577 578 579 580 581 582 583 584 585
	#
	# Remove per-experiment switch stacks.
	#
	# Clean up any reserved VLAN tags in per-experiment switches so that
	# underlying logical wires can be deleted!
	#
	if ($type != MODIFY && defined($perexpstack)) {
	    # Kill tag reservations on actual swapout.
	    TBDebugTimeStamp("snmpit started");
	    print STDERR "Removing per-experiment VLANs.\n";
586
	    if (system("$SNMPIT -S $perexpstack --redirect-err -r $pid $eid")) {
587 588 589 590 591 592 593 594 595 596
		tbwarn "Failed to remove per-experiment VLANs";
	    }
	    TBDebugTimeStamp("snmpit finished");
	}
	if ($type >= RETRY && defined($perexpstack)) {
	    print STDERR "Removing per-experiment switch stack.\n";
	    DeletePerExperimentSwitchStack($experiment);
	    $stackarg = "";
	}

597
	#
598
	# Clean up any VLANs in experiment.
599
	#
600
	# When modifying an elabinelab experiment, leave the vlans intact
601
	# so that the inner networks are not suddenly disconnected.
602
	#
603 604
	if ($type != MODIFY ||
	    ($type == MODIFY && $ELABINELAB && Lan->GotTrunks($experiment))) {
605 606
	    # Kill tag reservations on actual swapout.
	    my $tagopt = ($type != MODIFY ? "-C" : "");
607 608
	    TBDebugTimeStamp("snmpit started");
	    print STDERR "Removing VLANs.\n";
609
	    if (system("$SNMPIT $stackarg --redirect-err $tagopt -r $pid $eid")) {
610 611 612
		tberror({type => 'secondary', severity => SEV_SECONDARY,
			 error => ['vlan_reset_failed']},
			"Failed to reset VLANs");
613 614 615
		$swapout_errors = 1;
	    }
	    TBDebugTimeStamp("snmpit finished");
616
	}
617 618 619 620 621 622 623 624 625 626 627 628 629 630
	#
	# Must check for stale vlans that we kept around in the above clause
	# since they will not be in the lans table anymore.
	#
	if ($type == CLEANUP) {
	    my @stale;
	    if (VLan->StaleVlanList($experiment, \@stale) != 0) {
		tberror({type => 'secondary', severity => SEV_SECONDARY,
			 error => ['vlan_reset_failed']},
			"Failed to get stale VLANs");
		$swapout_errors = 1;
	    }
	    if (@stale) {
		print "Removing stale vlans @stale\n";
631
		system("$SNMPIT $stackarg --redirect-err -f -C ".
632
                    join(" ", map("-o $_", @stale)));
633 634 635 636 637 638 639 640
		if ($?) {
		    tberror({type => 'summary', severity => SEV_SECONDARY,
			     error => ['vlan_reset_failed']},
			    "Failed to remove stale vlans");
		    $swapout_errors = 1;
		}
	    }
	}
641
    }
642
	
643
    if ($type >= MODIFY) {
644 645
	# XXX Do this before releasing the nodes. Needs more thought.
	$experiment->DeleteInternalProgramAgents();
646 647
    }

648 649 650
    if ($type >= RETRY) {
	print "Removing dynamic blobs.\n";
	$experiment->RemoveBlobs();
651 652 653 654 655 656 657 658 659 660 661 662

	print "Clearing shared port vlans.\n";
	if ($experiment->ClearPortLans()) {
	    tberror({type => 'summary', severity => SEV_SECONDARY,
		     error => ['vlan_reset_failed']},
		    "Failed to remove ports from shared vlans");
	    #
	    # If this fails, we cannot release the nodes cause they
	    # have ports in someone elses vlan. Bad.
	    #
	    return -1;
	}
663 664
    }

665
    if ($type >= CLEANUP) {
666 667 668 669 670 671 672 673
	#
	# Undo plab in elab specialness.
	# No need to worry about VLANs here, as all the special abilities
	# involve the control network.
	#
	if (! $TESTMODE && $plabinelab) {
	    print "Tearing down plabinelab.\n";
	    if (system("plabinelab -k $pid $eid")) {
674 675 676
		tberror({type => 'secondary', severity => SEV_SECONDARY,
			 error => ['plabinelab_tear_down_failed']},
			"Failed to teardown plabinelab!");
677 678 679 680
		$swapout_errors = 1;
	    }
	}

681 682
	#
	# We're not attempting a retry;
683
	#
684
	# Stop all of the vnodes.
685
	#
686
	if (! $TESTMODE) { 	
687 688 689
	    print "Tearing down virtual nodes.\n";
	    TBDebugTimeStamp("vnode_setup -k started");
	    if (system("vnode_setup -d -k $pid $eid")) {
690 691 692
		tberror({type => 'secondary', severity => SEV_SECONDARY,
			 error => ['vnode_tear_down_failed']},
			"Failed to tear down vnodes.");
693 694 695
		$swapout_errors = 1;
	    }
	    TBDebugTimeStamp("vnode_setup finished");
696 697
	}

698 699 700 701
	#
	# Nodes behind a firewall are treated special.
	# See undoFWNodes for details.
	#
Leigh Stoller's avatar
Leigh Stoller committed
702 703 704
	# Non-firewalled experiments can now be paniced, and the swapout
	# action is similar. 
	#
705 706 707 708 709
	if ($firewalled) {
	    if (undoFWNodes($experiment)) {
		tblog_set_cleanup(0);
		return 1;
	    }
710
	}
Leigh Stoller's avatar
Leigh Stoller committed
711 712 713 714
	elsif ($experiment->paniced() &&
	       Firewall::Panic($experiment, 0, Firewall::PANIC_ZAP())) {
	    return 1;
	}
Leigh Stoller's avatar
Leigh Stoller committed
715

716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735
	#
	# Perform swapout time admin actions.  Right now there is at most
	# one of these.  It isn't really a general mechanism, just a hook
	# for state saving or data collection during swapout.
	# A couple of important "fer now" notes:
	#
	#	We don't do this for firewalled experiments.  We need a way
	#	to "tag" the saved disk state to ensure it doesn't get
	#	instantiated outside of a firewall.
	#
	#	We only do this on REAL swapouts, and not on CLEANUPs.
	#	There are some types of CLEANUPs where we may want to
	#	do this, in particular an invocation caused by a failed
	#	modify operation, where the admin action is to save the
	#	experiment state.  So we will need to revisit this.
	#
	my %soaction = ();
	if ($type == REAL && !$firewalled) {
	    TBExptGetSwapoutAction($pid, $eid, \%soaction);
	}
736
	if ($soaction{'command'} && doSwapoutAction($pid, $eid, %soaction)) {
737
	    tblog_set_cleanup(0);
738
	    return 1;
739 740
	}

741 742 743 744 745
	#
	# Clear logical interfaces and wires. This might move to support
	# swapmod.
	#
	print "Removing logical wires.\n";
746
	if (Interface::LogicalWire->DeleteLogicalWires($experiment)) {
747 748 749 750
	    tberror("Could not delete logical wires and interfaces\n");
	    return 1;
	}

751 752
	#
	# remove all nodes from the experiment.
Chad Barb's avatar
Chad Barb committed
753
	# (nfree will send them to RES_FREE_DIRTY)
754 755 756
	#
	print STDERR "Freeing nodes.\n";
	TBDebugTimeStamp("nfree started");
757
	if (system("nfree -a $pid $eid")) {
758 759 760
	    tberror({type => 'secondary', severity => SEV_SECONDARY,
		     error => ['nfree_failed']},
		    "Could not free nodes.");
761 762 763
	    $swapout_errors = 1;
	}
	TBDebugTimeStamp("nfree finished");
764 765 766 767 768

	#
	# Since this is an actual swapout, 
	# reset our count of swap out nag emails sent.
	#
769
	DBQueryWarn("update experiments set swap_requests='0', ".
770
		    "   sim_reswap_count='0' ".
771
		    "where eid='$eid' and pid='$pid'");
772 773
    } else {
	#
774
	# $type == RETRY or $type == MODIFY.
775 776
	# Therefore, don't deallocate nodes which have been successfully
	# incorporated into the experiment (i.e., are RES_READY).
Chad Barb's avatar
Chad Barb committed
777
	# (nfree will send deallocated nodes to RES_FREE_DIRTY)
778
	#
779 780 781 782 783 784 785 786
	my @failedpnodes = ();
	my @failedvnodes = ();
	
	my $db_result =
	    DBQueryFatal("select rv.node_id,n.allocstate,nt.isvirtnode ".
                         "  from reserved as rv ".
			 "left join nodes as n on n.node_id = rv.node_id ".
			 "left join node_types as nt on nt.type=n.type ".
787 788
			 "where rv.pid='$pid' and rv.eid='$eid' and ".
			 "      rv.genisliver_idx is null");
789

790
	while (my ($node,$allocstate,$isvirt) = $db_result->fetchrow_array) {
791
	    if ($allocstate ne TBDB_ALLOCSTATE_RES_READY()) {
792 793 794 795 796 797
		if ($isvirt) {
		    push(@failedvnodes, $node);
		}
		else {
		    push(@failedpnodes, $node);
		}
798 799 800
	    }
	}

801 802 803 804 805 806 807
	#
	# Tear down failed vnodes. Perhaps not needed?
	# 
	if (!$TESTMODE && @failedvnodes > 0) {
	    print "Tearing down failed virtual nodes.\n";
	    TBDebugTimeStamp("vnode_setup -k started");
	    if (system("vnode_setup -d -k $pid $eid @failedvnodes")) {
808 809 810
		tberror({type => 'secondary', severity => SEV_SECONDARY,
			 error => ['vnode_tear_down_failed']},
			"Failed to tear down vnodes.");
811 812 813 814
		$swapout_errors = 1;
	    }
	    TBDebugTimeStamp("vnode_setup -k finished");
	}
815

816 817 818 819 820 821 822 823 824 825 826
	#
	# Undo plabinelab setup
	#
	if (!$TESTMODE && $plabinelab && @failedpnodes > 0) {
	    print "Removing failed nodes from inner plab.\n";
	    if (system("plabinelab -r $pid $eid @failedpnodes")) {
		tberror "Failed to remove inner nodes!";
		$swapout_errors = 1;
	    }
	}

827 828 829 830
	#
	# Release all failed nodes.
	# 
	if (@failedpnodes > 0 || @failedvnodes > 0) {
831 832
	    print STDERR "Freeing failed nodes.\n";
	    
833
	    TBDebugTimeStamp("nfree started");
Chad Barb's avatar
Chad Barb committed
834 835 836 837 838
	    #
	    # Specify -x switch so when a physical node gets freed,
	    # any virtual nodes (owned by this experiment)
	    # sitting on top of it are freed as well.
	    #
839 840
	    if (system("nfree -x $pid $eid " .
		       join(" ", (@failedpnodes, @failedvnodes)))) {
841 842 843
		tberror({type => 'secondary', severity => SEV_SECONDARY,
			 error => ['nfree_failed']},
			"Could not free nodes.");
844 845 846 847 848 849
		$swapout_errors = 1;
	    }
	    TBDebugTimeStamp("nfree finished");
	}
    }

850 851 852 853 854 855 856 857 858 859 860 861
    if (! $TESTMODE) {
	#
	# If the experiment has no Plab dslice nodes left, but still has
	# a Plab slice, destroy the slice
	#

	# Does the slice exist?
	$db_result =
	    DBQueryFatal("select slicename from plab_slices ".
			 "where pid='$pid' and eid='$eid'");

	if ($db_result->numrows) {
862
	    # Are there any nodes left in the slice?
863
	    $db_result =
864 865 866 867 868 869 870 871 872
		DBQueryFatal("select r.node_id ".
			     " from plab_slices as ps".
			     " left join plab_slice_nodes as psn ".
			     "   on (ps.slicename=psn.slicename ".
			     "       and ps.plc_idx=psn.plc_idx) ".
			     " left join reserved as r ".
			     "   on psn.node_id=r.node_id ".
			     " where ps.pid='$pid' and ps.eid='$eid'".
			     "   and r.node_id is not NULL");
873 874

	    if (!$db_result->numrows) {
875
		print "Tearing down Slices.\n";
876
		TBDebugTimeStamp("plabslice destroy started");
877
		if (system("plabslice destroy $pid $eid")) {
878
		    tberror "Failed to tear down Slices.";
879 880 881 882 883 884 885
		    $swapout_errors = 1;
		}
		TBDebugTimeStamp("plabslice destroy finished");
	    }
	}
    }

886 887 888 889 890 891 892 893
    if (! $TESTMODE) {
	#
	# All of these errors are non-fatal on swapout. We find out about them
	# via email sent from the individual scripts.
	#

	#
	# Only reset mountpoints if this is an actual swapout, and
894
	# not a failed swapin(cleanup), update, or retry.
895
	#
896
	if ($type == REAL) {
897 898 899
	    print "Resetting mountpoints.\n";
	    TBDebugTimeStamp("exports started");
	    if (system("exports_setup")) {
900 901 902
		tberror({severity => SEV_WARNING,
			 error => ['mountpoint_reset_failed']},
			"Failed to reset mountpoints.");
903 904
	    }
	    TBDebugTimeStamp("exports finished");
905

906 907
	    print "Resetting locked down arp entries\n";
	    TBDebugTimeStamp("arplockdown started");
908
	    if (system("arplockdown")) {
909 910 911 912 913 914 915
		tberror({type => 'secondary', severity => SEV_SECONDARY,
			 error => ['arplockdown_setup_failed']},
			"Failed to reset locked down arp entries");
		return 1;
	    }
	    TBDebugTimeStamp("arplockdown finished");
    
916 917 918 919 920 921 922 923 924
	    #
	    # Ditto these two. 
	    #
	    print "Resetting named maps.\n";
	    TBDebugTimeStamp("named started");
	    if (system("named_setup")) {
		tbwarn "Failed to reset named map.";
	    }
	    TBDebugTimeStamp("named finished");
925

926 927 928 929 930 931
	    print "Resetting email lists.\n";
	    TBDebugTimeStamp("genelists started");
	    if (system("genelists -t")) {
		tbwarn "Failed to reset email lists.";
	    }
	    TBDebugTimeStamp("genelists finished");
932 933 934
	}
    }

935
    #
936
    # Wipe the DB clean except during MODIFY or RETRY. In those
937 938
    #    cases, assign_wrapper will reset the DB after reading
    #    the info.
939
    #
940 941
    if ( $type >= CLEANUP ) {
	print STDERR "Resetting DB.\n";
942 943
	# Add purge flag.
	$experiment->RemovePhysicalState(1);
944 945
	# Special. 
	$experiment->ClearPortRegistration();
946
	$experiment->ClearPortRange();
947
	$experiment->ClearGlobalIPAllocation();
948
    }
949

950
    tblog_set_cleanup(0);
951 952 953 954
    return $swapout_errors;
}

##
955
#
956 957
# doSwapin - Swaps experiment in.
#
958 959 960 961 962
#            Returns:
#              0 - successful swapin
#              1 - failed swapin; cleanup required.
#              3 - failed swapin; cleanup required; can retry.
#              7 - failed swapin; assign failed; no cleanup.
963 964
##

965
sub doSwapin($) {
966
    my $type = shift; 
967 968
    # Just the physnodes ...
    my @deleted_pnodes = ();
969

970 971 972 973 974 975
    if ($type == REAL) {
	if ($experiment->CheckForDeprecatedImages($this_user, 1)) {
	    return 1;
	}
    }

976 977 978 979 980 981
    # Special IP assignment. Must do before mapper runs and moves
    # IPs from virt_lans to interfaces table.
    if ($experiment->SetupNetworkFabrics()) {
	return 1;
    }

982 983 984 985 986 987
    # Do this before we assign any nodes. We want to download the images.
    system("$IMAGESETUP -g $pid,$eid");
    if ($?) {
	return 1;
    }

988 989 990 991
    #
    # assign_wrapper does all the virtual to physical mapping 
    # and updating the DB state.
    #
992
    
993
    if ($type > MODIFY_RECOVER) {
994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007
        #
        # Hacky test to allow disabling of linkdelays if the node is going
        # to run Linux. See sitevar above.
        #
	if (! $enablelinkdelays) {
	    $db_result =
		DBQueryFatal("select distinct e.pid,e.eid,vl.vnode,vn.osname ".
			 "  from experiments as e ".
			 "left join virt_lans as vl on vl.pid=e.pid and ".
			 "     vl.eid=e.eid ".
			 "left join virt_nodes as vn on vn.pid=e.pid and ".
			 "     vn.eid=e.eid and vn.vname=vl.vnode ".
			 "left join os_info as o on o.osname=vn.osname and ".
			 "  (o.pid=vl.pid or o.pid='" . TBOPSPID() . "') ".
1008 1009
			 "left join os_info_versions as ov on ".
			 "     ov.osid=o.osid and ov.vers=o.version ".
1010 1011
			 "where (vl.uselinkdelay!=0 or e.uselinkdelays!=0 or ".
			 "       e.forcelinkdelays!=0) and ".
1012 1013
			 "     (ov.os is NULL or ov.os='Linux' or ".
			 "      ov.os='Fedora') and ".
1014 1015 1016
			 "     e.pid='$pid' and e.eid='$eid'");

	    if ($db_result->numrows) {
1017 1018
		tberror "Endnodeshaping is disabled on Linux Images!";
		tberror "You must modify your experiment to swap it in.";
1019 1020 1021
		return 1;
	    }
	}
1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036

        #
	# Check for feature to back off and let something else manage the
	# nodes in the experiment.  Unconditionally mark the experiment since
	# this feature is most likely to come from the swapper or project.
	# Need to do this before nalloc is called by the mapper.
        #
	if (EmulabFeatures->FeatureEnabled("ExternalNodeManagement",
					   $this_user,
					   $group,
					   $experiment)) {
	    TBDebugTimeStamp("ExternalNodeManagement feature is set.");
	    EmulabFeatures->Lookup("ExternalNodeManagement")->
		Enable($experiment);
	}
1037
	
1038 1039 1040 1041 1042 1043 1044 1045 1046 1047
	# Allocate public IP addresses now.  We do it early, because it's
	# very fast and might fail (it would be silly to go through all
	# the effort of mapping nodes only to later abort because we
	# didn't have enough public addresses).	
	print "Allocating public addresses...\n";
	if( $experiment->AllocatePublicAddrPools() < 0 ) {
	    tberror( "Failed to allocate public address pools!" );
	    return 1;
	}
	    	
1048
	print "Mapping to physical reality ...\n";
1049
	TBDebugTimeStamp("mapper wrapper started");
1050 1051

	#
1052 1053 1054 1055
	# Pass the -u (update) switch into assign_wrapper, which turns on
	# update mode. When doing a retry, must also fix the current nodes
	# to avoid stuff jumping around when simply trying to replace a node
	# that did not boot.
1056 1057
	#
	my $exitcode;
1058
	my $cmd = "$mapper ";
1059
	if (EmulabFeatures->FeatureEnabled("OldMapper",
1060
					   $this_user, $group, $experiment)) {
1061
	    $cmd = "$wrapper";
1062 1063
	}
	$cmd .= " -f"
1064
	    if ($type == RETRY);
1065
	
1066
	if (system("$cmd -u $pid $eid")) {
1067 1068
	    $exitcode = $? >> 8;

1069
	    tberror "Failed ($exitcode) to map to reality.";
1070

1071
	    # Wrapper sets this bit when recoveryppxu is possible.
1072
	    if ($exitcode & 64) {
1073
		# We can recover. 
1074
		tbreport(SEV_SECONDARY, 'assign_wrapper_failed', $exitcode);
1075
		return 7;
1076 1077
	    }
	    else {
1078
		# No recovery, no retry.
1079
		tbreport(SEV_SECONDARY, 'assign_wrapper_failed', $exitcode);
1080 1081 1082
		return 1;
	    }
	}
1083
	TBDebugTimeStamp("mapper wrapper finished");
1084

1085 1086
	print "Mapped to physical reality!\n";
    }
1087

1088
    # Check cancel flag before continuing. No retry, 
1089
    TBGetCancelFlag($pid, $eid, \$canceled);
1090 1091 1092 1093
    if ($canceled) {
	tbreport(SEV_IMMEDIATE, 'cancel_flag');
	return 1
    }
1094

1095 1096 1097 1098 1099
    #
    # Create/update per-experiment switch stacks if necessary.
    # Still haven't done any vlan synch for modify.
    #
    my @expswitches = $experiment->SwitchList(1);
1100
    my ($perexpstack,$leader,@curswitches) = 
1101 1102 1103 1104 1105
	GetPerExperimentSwitchStack($experiment);
    my $stackarg = "";
    if (($type > MODIFY && @expswitches)
	|| ($type == MODIFY && (!defined($perexpstack) && @expswitches))) {
	print STDERR "Creating per-experiment switch stack.\n";
1106 1107
	AddPerExperimentSwitchStack($experiment,undef,undef,undef,undef,
				    @expswitches);
1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119
	$perexpstack = GetPerExperimentSwitchStackName($experiment);
    }
    elsif ($type == MODIFY && defined($perexpstack)
	   && (@expswitches || @curswitches)) {
	print STDERR "Updating per-experiment switch stack.\n";
	UpdatePerExperimentSwitchStack($experiment,@expswitches);
    }
    if (defined($perexpstack) && (@expswitches || @curswitches)) {
	print STDERR "Will configure per-experiment switch stack ($perexpstack) later.\n";
	$stackarg = "-S $perexpstack --skip-supplied";
    }

1120 1121 1122 1123 1124 1125 1126 1127
    # Need this early in case elabinelab OPS is a VM on boss on a XEN VM.
    if ($elabinelab && ($type == REAL || $type == MODIFY)) {
	if ($experiment->AssignElabInElabOpsIP()) {
	    tberror "Failed to allocate IP for elabinelab OPSVM\n";
	    return 1;
	}
    }

1128 1129 1130 1131 1132 1133 1134
    #
    # When doing a modify, we have to compare vlans to determine which
    # vlans actually changed and need to be deleted, before processing
    # the new vlans for the experiment. Note that vlans that already
    # exist on the switches will be left as is by snmpit.
    #
    # We must do this before the nfree of deleted nodes in the next section
1135
    # because the new test in nfree that prevents nodes from accidentally
1136 1137 1138 1139 1140
    # getting released when they are in a vlan.
    #
    if ($type == MODIFY) {
	my @diff = ();
	my @same = ();
1141 1142
	my $ret;

1143
	if ($ELABINELAB || !$syncvlans) {
1144 1145 1146 1147 1148 1149
	    $ret = Lan->CompareVlansWithSwitches($experiment, \@diff, \@same);
	}
	else {
	    $ret = Lan->CompareVlansWithSwitches2($experiment);
	}
	if ($ret) {
1150 1151 1152 1153 1154
	    tberror({type => 'summary', severity => SEV_SECONDARY,
		     error => ['vlan_setup_failed']},
		    "Failed to compare old vlans");
	    return 1;
	}
1155
	if ($ELABINELAB || !$syncvlans) {
1156 1157
	    if (@diff) {
		print "Removing obsolete vlans @diff\n";
1158
		system("$SNMPIT $stackarg --redirect-err -f -C ".
1159
		       join(" ", map("-o $_", @diff)));
1160 1161 1162 1163 1164 1165
		if ($?) {
		    tberror({type => 'summary', severity => SEV_SECONDARY,
			     error => ['vlan_setup_failed']},
			    "Failed to remove obsolete VLANs.");
		    return 1;
		}
1166
		if (defined($perexpstack)) {
1167
		    system("$SNMPIT -S $perexpstack --redirect-err -f -C ".
1168 1169 1170 1171 1172 1173 1174 1175
			   join(" ", map("-o $_", @diff)));
		    if ($?) {
			tberror({type => 'summary', severity => SEV_SECONDARY,
				 error => ['vlan_setup_failed']},
				"Failed to remove obsolete per-experiment VLANs.");
			return 1;
		    }
		}
1176 1177 1178 1179
	    }
	}
	else {
	    print "Synchronizing VLANs.\n";
1180
	    system("$SNMPIT $stackarg --redirect-err -X $pid $eid");
1181 1182 1183
	    if ($?) {
		tberror({type => 'summary', severity => SEV_SECONDARY,
			 error => ['vlan_setup_failed']},
1184
			"Failed to synchronize VLANs.");
1185 1186
		return 1;
	    }
1187
	    if (defined($perexpstack)) {
1188
		system("$SNMPIT -S $perexpstack --redirect-err -X $pid $eid");
1189 1190 1191 1192 1193 1194 1195
		if ($?) {
		    tberror({type => 'summary', severity => SEV_SECONDARY,
			     error => ['vlan_setup_failed']},
			    "Failed to synchronize per-experiment VLANs.");
		    return 1;
		}
	    }
1196 1197 1198
	}
    }

1199 1200 1201 1202 1203 1204 1205 1206 1207
    #
    # Look for any nodes in RES_TEARDOWN. These need to be released,
    # and if a virtnode, they need to be torn down. We cannot wait for
    # the virtnodes to go down with the physnode they are hosted on,
    # so teardown and release the virtnodes first, and then do the
    # physnodes.
    #
    # Errors are fatal; no recovery or retry.
    #
1208
    if ($type == MODIFY || $type == UPDATE) {
1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229
	my $allocstate = TBDB_ALLOCSTATE_RES_TEARDOWN();
	
	$db_result =
	    DBQueryFatal("select r.node_id,nt.isvirtnode,nt.isremotenode ".
			 "  from reserved as r ".
			 "left join nodes as n on n.node_id=r.node_id ".
			 "left join node_types as nt on nt.type=n.type ".
			 "where r.pid='$pid' and r.eid='$eid' and ".
			 "      n.allocstate='$allocstate'");

	if ($db_result->numrows) {
	    my @virtnodes = ();
	    my @physnodes = ();
	    
	    print "Tearing down and releasing unused nodes\n";

	    # First teardown/release virtnodes. 
	    while (my ($node,$isvirt,$isrem) = $db_result->fetchrow_array()) {
		if ($isvirt) {
		    push(@virtnodes, $node);
		}
1230
		else {
1231 1232 1233
		    push(@physnodes, $node);
		}
	    }
1234 1235 1236
	    # See below.
	    @deleted_pnodes = @physnodes;
	    
1237 1238 1239
	    if (@virtnodes) {
		TBDebugTimeStamp("vnode_setup started");
		
1240
		if (system("vnode_setup -k $pid $eid @virtnodes")) {
1241
		    tberror "Failed to tear down unused virtnodes!\n";
1242 1243 1244 1245 1246
		    return 1;
		}
		TBDebugTimeStamp("vnode_setup finished");
		
		if (system("nfree $pid $eid @virtnodes")) {
1247
		    tberror "Failed to nfree unused virtnodes!\n";
1248 1249 1250 1251
		    return 1;
		}
	    }
	    if (@physnodes) {
1252 1253 1254
		if ($elabinelab) {
		    print "Removing nodes from inner elab.\n";
		    if (system("elabinelab -r $pid $eid @physnodes")) {
1255
			tberror "Failed to remove inner nodes!";
1256 1257
			return 1;
		    }
1258 1259 1260 1261 1262 1263
		} elsif ($plabinelab) {
		    print "Removing nodes from inner plab.\n";
		    if (system("plabinelab -r $pid $eid @physnodes")) {
			tberror "Failed to remove inner nodes!";
			return 1;
		    }
1264 1265 1266
		}

		#
1267 1268
		# If the experiment is firewalled, cleanup the nodes
		# we are releasing.
1269
		# 
1270 1271
		if ($firewalled && undoFWNodes($experiment, 1,
					       @deleted_pnodes)) {
1272 1273 1274
		    return 1;
		}
		
1275
		if (system("nfree $pid $eid @physnodes")) {
1276
		    tberror "Failed to nfree unused physnodes!\n";
1277 1278 1279 1280 1281 1282
		    return 1;
		}
	    }
	}
    }

1283 1284 1285 1286 1287 1288
    # Exit here if we are testing.
    if ($TESTMODE) {
	print "Testing run - Stopping here.\n";
	return 0;
    }

1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299
    #
    # Handle tarballs - we might need to fetch some from URLs if the user
    # asked for that.
    #
    print "Fetching tarballs and RPMs (if any) ...\n";
    TBDebugTimeStamp("tarfiles_setup started");

    if (system("tarfiles_setup $pid $eid")) {
	#
	# No recovery for now - what would we do?
	#
1300 1301 1302
	tberror({type => 'secondary', severity => SEV_SECONDARY,
		 error => ['tarfiles_setup_failed']},
		"Failed to set up tarballs.");
1303 1304 1305 1306
	return 1;
    }
    TBDebugTimeStamp("tarfiles_setup finished");

1307 1308 1309 1310
    #
    # Handle virt blobs.
    #
    if ($type >= RETRY) {
1311
	print "Creating dynamic blobs.\n";
1312 1313 1314
	$experiment->UploadBlobs(0);
    }
    elsif ($type == MODIFY) {
1315
	print "Updating dynamic blobs.\n";
1316 1317 1318
	$experiment->UploadBlobs(1);
    }

1319 1320 1321 1322
    #
    # If there are any Plab dslice nodes in the experiment, create the
    # dslice now
    #
1323
    if (0 && $type > MODIFY_RECOVER) {
1324 1325 1326
	# Are there any Plab nodes?  First get a list of node types in the exp;
	# if any are types hosted by any of the PLCs we know about, create
	# all slices necessary for the experiment in a single plabslice call.
1327
	$db_result =
1328 1329 1330 1331 1332 1333 1334
	    DBQueryFatal("select nt.type,ppi.plc_name from nodes as n ".
			 "  left join node_types as nt on n.type = nt.type ".
			 "  left join reserved as r on r.node_id = n.node_id ".
			 "  left join plab_plc_info as ppi ".
			 "    on nt.type = ppi.node_type".
			 " where r.pid='$pid' and r.eid='$eid'".
			 "    and ppi.node_type is not NULL".
1335
			 " group by nt.type,ppi.plc_name");
1336 1337

	if ($db_result->numrows) {
1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348
	    my $info_str = "";
	    while (my ($nt,$plc) = $db_result->fetchrow_array()) {
		$info_str .= " $plc($nt)";
	    }
	    print "Configuring Slices for $info_str.\n";
	    TBDebugTimeStamp("plabslice started");
	    if (system("plabslice create $pid $eid")) {
		tberror({type => 'secondary', severity => SEV_SECONDARY,
			 error => ['plabslice_create_failed']},
			"Failed to configure Slices.");
		return 3;
1349
	    }
1350
	    TBDebugTimeStamp("plabslice finished");
1351 1352 1353
	}
    }

1354
    # Check cancel flag before continuing. No retry, 
1355
    TBGetCancelFlag($pid, $eid, \$canceled);
1356 1357 1358 1359
    if ($canceled) {
	tbreport(SEV_IMMEDIATE, 'cancel_flag');
	return 1
    }
1360

1361 1362 1363 1364 1365 1366
    #
    # These things need to get started before the nodes come up, so we'll
    # do them before the os_setup. Everything else can done in parallel with
    # os_setup. (Actually, these probably can too, since they should finish
    # long before the nodes reboot, but better safe than sorry)
    #
1367 1368
    print "Locking down arp entries\n";
    TBDebugTimeStamp("arplockdown started");
1369
    if (system("arplockdown ")) {
1370 1371 1372 1373 1374 1375 1376
	tberror({type => 'secondary', severity => SEV_SECONDARY,
		 error => ['arplockdown_setup_failed']},
		"Failed to lockdown arp entries");
	return 1;
    }
    TBDebugTimeStamp("arplockdown finished");
    
1377 1378 1379
    print "Setting up mountpoints.\n";
    TBDebugTimeStamp("mountpoints started");
    if (system("exports_setup")) {
1380 1381 1382
	tberror({type => 'secondary', severity => SEV_SECONDARY,
		 error => ['mountpoints_setup_failed']},
		"Failed to setup mountpoints.");
1383 1384 1385
	return 1;
    }
    TBDebugTimeStamp("mountpoints finished");
1386

1387 1388 1389
    TBDebugTimeStamp("named started");
    print "Setting up named maps.\n";
    if (system("named_setup")) {
1390
	tbwarn "Failed to add node names to named map.";
1391 1392
	#
	# This is a non-fatal error.
1393
	#
1394 1395
    }
    TBDebugTimeStamp("named finished");
1396

1397 1398 1399 1400 1401 1402 1403
    #
    # Determine the distribution of per-experiment root private/public keys
    # to the experiment nodes.
    #
    print "Determining root keypair distribution.\n";
    $experiment->InitKeyDist();

1404 1405 1406 1407
    if ($NFSTRACESUPPORT) {
	print "Cleaning NFS traces.\n";
	TBDebugTimeStamp