Index: fedkit/splitter.pl
===================================================================
--- fedkit/splitter.pl	(revision bc01820e50eefa5a492fd2974bb5985b9ab1a3fc)
+++ fedkit/splitter.pl	(revision e06b224874a3a79af314dde1704f9ec9842e8743)
@@ -30,4 +30,5 @@
 my $tclsh;			# tclsh to call directly (changed during devel)
 my @tarfiles;			# Tarfiles in use by this experiment
+my $timeout;			# The timeout to use for experiment swap ins
 my %opts;			# Parsed options
 
@@ -158,15 +159,54 @@
 # command to execute, and a prefix to be placed on a message generated if the
 # command fails.   On failure print a warning if a warning prefix was given and
-# return false.
+# return false.  If timeout is given fork a process and set an alarm of that
+# many seconds.  Timeouts also return 0;
 sub ssh_cmd {
-    my($user, $host, $cmd, $wname) = @_;
-
-    # XXX system with a relative pathname is sort of gross
-    system ("ssh $user\@$host $cmd");
-    if ($?) {
-	warn "$wname failed $?\n" if $wname;
-	return 0;
-    }
-    else { return 1; }
+    my($user, $host, $cmd, $wname, $timeout) = @_;
+    my $pid;		    # Child pid
+
+    if ( $timeout ) {
+	if ( $pid = fork () ) {
+	    # Parent process
+	    # The eval acts as a signal catcher.  If the alarm goes off inside
+	    # the eval, the die will put "alarm\n" into $@, otherwise the
+	    # return value of the execution in the child process will be used.
+	    my $rv = eval {
+		local $SIG{'ALRM'} = sub{ die "alarm\n"; };
+		my $rv;
+
+		alarm $timeout;
+		$rv = waitpid($pid, 0);
+		alarm 0;
+		$rv;
+	    };
+
+	    # If the eval succeeded, $@ will be null and we can use $rv, which
+	    # is the return code from the subprocess.  If the eval timed out,
+	    # print a warning and assume the best.
+	    if ($@ eq "alarm\n" ) {
+		warn "$wname timed out - pid $pid still live\n";
+		return 1;
+	    }
+	    else {
+		return $rv;
+	    }
+	}
+	else {
+	    # Child process
+	    # XXX system with a relative pathname is sort of gross
+	    exec("ssh $user\@$host $cmd");
+	    exit 0;
+	}
+    }
+    else {
+	# No timeout, do all the work here.
+	# XXX system with a relative pathname is sort of gross
+	system ("ssh $user\@$host $cmd");
+	if ($?) {
+	    warn "$wname failed $?\n" if $wname;
+	    return 0;
+	}
+	else { return 1; }
+    }
 }
 
@@ -220,6 +260,7 @@
 # messages are printed.
 sub start_segment {
-    my($tb, $eid, $tbparams) = @_;	    # testbed, experiment ID, and 
-					    # per-testbed parameters
+    my($tb, $eid, $tbparams, $timeout) = @_;# testbed, experiment ID, 
+					    # per-testbed parameters and remote
+					    # swap-in timeout
     my $host =				    # Host name of remote ops (FQDN)
 	$tbparams->{$tb}->{'host'} . $tbparams->{$tb}->{'domain'};
@@ -280,5 +321,5 @@
 	print "Modifying $eid in place on $tb\n" if $verbose;
 	&ssh_cmd($user, $host, "/usr/testbed/bin/modexp -r -s -w $pid " . 
-	    "$eid $tclfile", "modexp") || return 0;
+	    "$eid $tclfile", "modexp", $timeout) || return 0;
 	return 1;
     }
@@ -304,5 +345,5 @@
 	# Now start up
 	&ssh_cmd($user, $host, "/usr/testbed/bin/swapexp -w $pid $eid in", 
-	    "swapexp") || return 0;
+	    "swapexp", $timeout) || return 0;
 	return 1;
     }
@@ -330,5 +371,5 @@
 	print "Swapping $eid in on $tb\n" if $verbose;
 	&ssh_cmd($user, $host, "/usr/testbed/bin/swapexp -w $pid $eid in", 
-	    "swapexp") || return 0;
+	    "swapexp", $timeout) || return 0;
 	return 1;
     }
@@ -364,5 +405,5 @@
 				    # keep our changes to the parser minimal.
 # Argument processing.
-getopts('c:f:ndvN', \%opts);
+getopts('t:c:f:ndvN', \%opts);
 $splitter_config = $opts{'c'} || "./splitter.conf";
 $debug = $opts{'d'};
@@ -374,4 +415,5 @@
 
 $startem = $opts{'n'} ? 0 : 1;		# If true, start the sub-experiments
+$timeout = $opts{'t'} || $opts{'timeout'};
 $eid = $opts{'experiment'};		# Experiment ID
 $tcl = $opts{'f'} || shift;		# The experiment description
@@ -541,5 +583,5 @@
 	    $cc->close();
 	}
-	else { warn "No control gateway for $gateways?"; }
+	else { warn "No control gateway for $gateways?\n"; }
 	    
 	$gateways = 0;
@@ -695,5 +737,5 @@
 for my $tb  (keys %allocated) {
     if ($tb ne $master) {
-	if (&start_segment($tb, $eid, $tbparams)) { $started{$tb}++; }
+	if (&start_segment($tb, $eid, $tbparams, $timeout)) { $started{$tb}++; }
 	else { last TESTBED; }
     }
@@ -701,5 +743,5 @@
 
 # Now the master
-if (&start_segment($master, $eid, $tbparams)) { 
+if (&start_segment($master, $eid, $tbparams, $timeout)) { 
     $started{$master}++;
 }
