- Timestamp:
- Sep 29, 2007 5:45:48 PM (17 years ago)
- Branches:
- axis_example, compt_changes, info-ops, master, version-1.30, version-2.00, version-3.01, version-3.02
- Children:
- e06b224
- Parents:
- d53dda5
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
fedkit/splitter.pl
rd53dda5 r5479c80 30 30 my $tclsh; # tclsh to call directly (changed during devel) 31 31 my @tarfiles; # Tarfiles in use by this experiment 32 my $timeout; # The timeout to use for experiment swap ins 32 33 my %opts; # Parsed options 33 34 … … 158 159 # command to execute, and a prefix to be placed on a message generated if the 159 160 # command fails. On failure print a warning if a warning prefix was given and 160 # return false. 161 # return false. If timeout is given fork a process and set an alarm of that 162 # many seconds. Timeouts also return 0; 161 163 sub ssh_cmd { 162 my($user, $host, $cmd, $wname) = @_; 163 164 # XXX system with a relative pathname is sort of gross 165 system ("ssh $user\@$host $cmd"); 166 if ($?) { 167 warn "$wname failed $?\n" if $wname; 168 return 0; 169 } 170 else { return 1; } 164 my($user, $host, $cmd, $wname, $timeout) = @_; 165 my $pid; # Child pid 166 167 if ( $timeout ) { 168 if ( $pid = fork () ) { 169 # Parent process 170 # The eval acts as a signal catcher. If the alarm goes off inside 171 # the eval, the die will put "alarm\n" into $@, otherwise the 172 # return value of the execution in the child process will be used. 173 my $rv = eval { 174 local $SIG{'ALRM'} = sub{ die "alarm\n"; }; 175 my $rv; 176 177 alarm $timeout; 178 $rv = waitpid($pid, 0); 179 alarm 0; 180 $rv; 181 }; 182 183 # If the eval succeeded, $@ will be null and we can use $rv, which 184 # is the return code from the subprocess. If the eval timed out, 185 # print a warning and assume the best. 186 if ($@ eq "alarm\n" ) { 187 warn "$wname timed out - pid $pid still live\n"; 188 return 1; 189 } 190 else { 191 return $rv; 192 } 193 } 194 else { 195 # Child process 196 # XXX system with a relative pathname is sort of gross 197 exec("ssh $user\@$host $cmd"); 198 exit 0; 199 } 200 } 201 else { 202 # No timeout, do all the work here. 203 # XXX system with a relative pathname is sort of gross 204 system ("ssh $user\@$host $cmd"); 205 if ($?) { 206 warn "$wname failed $?\n" if $wname; 207 return 0; 208 } 209 else { return 1; } 210 } 171 211 } 172 212 … … 220 260 # messages are printed. 221 261 sub start_segment { 222 my($tb, $eid, $tbparams) = @_; # testbed, experiment ID, and 223 # per-testbed parameters 262 my($tb, $eid, $tbparams, $timeout) = @_;# testbed, experiment ID, 263 # per-testbed parameters and remote 264 # swap-in timeout 224 265 my $host = # Host name of remote ops (FQDN) 225 266 $tbparams->{$tb}->{'host'} . $tbparams->{$tb}->{'domain'}; … … 280 321 print "Modifying $eid in place on $tb\n" if $verbose; 281 322 &ssh_cmd($user, $host, "/usr/testbed/bin/modexp -r -s -w $pid " . 282 "$eid $tclfile", "modexp" ) || return 0;323 "$eid $tclfile", "modexp", $timeout) || return 0; 283 324 return 1; 284 325 } … … 304 345 # Now start up 305 346 &ssh_cmd($user, $host, "/usr/testbed/bin/swapexp -w $pid $eid in", 306 "swapexp" ) || return 0;347 "swapexp", $timeout) || return 0; 307 348 return 1; 308 349 } … … 330 371 print "Swapping $eid in on $tb\n" if $verbose; 331 372 &ssh_cmd($user, $host, "/usr/testbed/bin/swapexp -w $pid $eid in", 332 "swapexp" ) || return 0;373 "swapexp", $timeout) || return 0; 333 374 return 1; 334 375 } … … 364 405 # keep our changes to the parser minimal. 365 406 # Argument processing. 366 getopts(' c:f:ndvN', \%opts);407 getopts('t:c:f:ndvN', \%opts); 367 408 $splitter_config = $opts{'c'} || "./splitter.conf"; 368 409 $debug = $opts{'d'}; … … 374 415 375 416 $startem = $opts{'n'} ? 0 : 1; # If true, start the sub-experiments 417 $timeout = $opts{'t'} || $opts{'timeout'}; 376 418 $eid = $opts{'experiment'}; # Experiment ID 377 419 $tcl = $opts{'f'} || shift; # The experiment description … … 541 583 $cc->close(); 542 584 } 543 else { warn "No control gateway for $gateways? "; }585 else { warn "No control gateway for $gateways?\n"; } 544 586 545 587 $gateways = 0; … … 695 737 for my $tb (keys %allocated) { 696 738 if ($tb ne $master) { 697 if (&start_segment($tb, $eid, $tbparams )) { $started{$tb}++; }739 if (&start_segment($tb, $eid, $tbparams, $timeout)) { $started{$tb}++; } 698 740 else { last TESTBED; } 699 741 } … … 701 743 702 744 # Now the master 703 if (&start_segment($master, $eid, $tbparams )) {745 if (&start_segment($master, $eid, $tbparams, $timeout)) { 704 746 $started{$master}++; 705 747 }
Note: See TracChangeset
for help on using the changeset viewer.