Changeset e863014d6fca050e52d87bca02cd5ac2ed404864 for fedkit

Timestamp:

10/08/07 11:30:28 (5 years ago)

Author:

Ted Faber <faber@…>

Children:

fd7a59b1f60b5ee0919cd3fdb74b62388b7c3155

Parents:

04045586ff25f1c7baf2e744523dc7ca3cb5374b

git-committer:

Ted Faber <faber@isi.edu> / 2007-10-08T18:30:28Z+0000

Message:

Allow slave testbeds to be swapped in concurrently.

-p <max_procs> sets the maximum number of subnets we can do at once.

Files:

• fedkit/splitter.pl (modified) (7 diffs)

fedkit/splitter.pl

@@ -43 +43 @@
                                 # the domain parameter of the DETER testbed.  
 my $fail_soft;                  # Do not swap failed sub-experiments out
+my $max_children=1;             # Maximum number of simultaneous swap-ins
 
 # Parse the config file.  The format is a colon-separated parameter name
@@ -421 +422 @@
                                     # keep our changes to the parser minimal.
 # Argument processing.
-getopts('Ft:c:f:ndvN', \%opts);
+getopts('Ft:c:p:f:ndvN', \%opts);
 $splitter_config = $opts{'c'} || "./splitter.conf";
 $debug = $opts{'d'};
@@ -428 +429 @@
 &parse_config("$splitter_config", \%opts) || 
     die "Cannot read config file $splitter_config: $!\n";
-$fail_soft = $opts{'F'} || $opts{'failsoft'};
 
 warn "-N does nothing now.  Only one testbeds format supported.\n"
     if $opts{'N'};
+$fail_soft = $opts{'F'} || $opts{'failsoft'};
 $startem = $opts{'n'} ? 0 : 1;          # If true, start the sub-experiments
 $timeout = $opts{'t'} || $opts{'timeout'};
@@ -440 +441 @@
 $tb_config = $opts{'testbeds'} || "./testbeds"; # testbed configurations
 $local_script_dir = $opts{'scriptdir'}; # Local scripts
+
+$max_children = $opts{'p'} || $opts{'maxchildren'} 
+    if $opts{'p'} || $opts{'maxchildren'};
 
 $smb_share = $opts{'smbshare'} ||       # Share to mount from the master
@@ -737 +741 @@
 
 my %started;                # If $started{$tb} then $tb successfully started
+my %child;                  # If $child{$pid} then a process with that pid is
+                            # working on a starting a segment
+my $nworking = 0;           # Number of children working on swapin
+my $pid;                    # Scratch variable for pids
 
 # Start up the slave sub-experiments first
 TESTBED:
 for my $tb  (keys %allocated) {
-    if ($tb ne $master) {
-        if (&start_segment($tb, $eid, $tbparams, $timeout)) { $started{$tb}++; }
-        else { last TESTBED; }
-    }
+    if ( $tb ne $master ) {
+        while ( $nworking == $max_children ) {
+            print "Waiting for a child process to complete\n" if $verbose;
+            if (($pid = wait()) != -1 ) {
+                # The $? >> 8 is the exit code of the subprocess, which is
+                # non-zero if the &start_segment routine failed.
+                my $exit_code = ($? >> 8);
+
+                print "Child $pid completed exit code ($exit_code)\n"
+                    if $verbose;
+                $nworking--;
+                $started{$child{$pid}}++ unless $exit_code;
+                if ($child{$pid} ) { delete $child{$pid}; }
+                else { warn "Reaped a pid we did not start?? ($pid)\n"; }
+                last TESTBED if $exit_code;
+            }
+            else { warn "wait returned without reaping: $!\n"; }
+        }
+        if ( $pid = fork() ) {
+            # Parent process
+            $nworking ++;
+            $child{$pid} = $tb;
+            print "Started process $pid to start testbed $tb\n"
+                if $verbose;
+        }
+        else {
+            # Child.  Note that we reverse the sense of the return code when it
+            # becomes an exit value.  Zero exit values indicate success.
+            exit(!&start_segment($tb, $eid, $tbparams, $timeout));
+        }
+    }
+}
+
+# Now wait for any still running processes.
+while ( $nworking ) {
+    print "Waiting for a child process to complete ($nworking running)\n" 
+        if $verbose;
+    if (($pid = wait()) != -1 ) {
+        # The $? >> 8 is the exit code of the subprocess, which is
+        # non-zero if the &start_segment routine failed.
+        my $exit_code = ($? >> 8);
+
+        print "Child $pid completed exit code ($exit_code)\n"
+            if $verbose;
+        $nworking--;
+        $started{$child{$pid}}++ unless $exit_code;
+        if ($child{$pid} ) { delete $child{$pid}; }
+        else { warn "Reaped a pid we did not start?? ($pid)\n"; }
+    }
+    else { warn "wait returned without reaping: $!\n"; }
 }
 
@@ -772 +826 @@
 
 B<splitter.pl> [B<-ndF>] [B<-t> I<secs>] [B<-c> F<config_file>]
-    [B<-f> F<experiment_tcl>] [F<experiment_tcl>]
+    [B<-f> F<experiment_tcl>] [B<-p> I<max_procs>] [F<experiment_tcl>]
 
 =head1 DESCRIPTION
@@ -810 +864 @@
 currently instantiated last.
 
+Slave testbeds can be swapped in in parallel by specifying the B<-p> parameter
+and the maximum number of simultaneous processes to start.
+
 Scripts to start federation (the federation kit) are copied into the local
 experiment's tmp file - e.g., F</proj/DETER/exp/simple-split/tmp>.  These are