parallel: Implemented --ctrlc which will send SIGINT to remote tasks.

This commit is contained in:
Ole Tange 2013-04-08 20:35:57 +02:00
parent 02bd84afe9
commit 23636ee688

View file

@ -455,6 +455,11 @@ sub write_record_to_pipe {
} }
$job->write($header_ref); $job->write($header_ref);
$job->write($record_ref); $job->write($record_ref);
if($opt::ctrlc) {
# Print a CTRL-D to mark EOF
my $ctrld = sprintf("%c",4);
$job->write(\$ctrld);
}
my $fh = $job->stdin(); my $fh = $job->stdin();
close $fh; close $fh;
exit(0); exit(0);
@ -548,6 +553,7 @@ sub options_hash {
"cleanup" => \$opt::cleanup, "cleanup" => \$opt::cleanup,
"basefile|bf=s" => \@opt::basefile, "basefile|bf=s" => \@opt::basefile,
"B=s" => \$opt::retired, "B=s" => \$opt::retired,
"ctrlc|ctrl-c" => \$opt::ctrlc,
"workdir|wd=s" => \$opt::workdir, "workdir|wd=s" => \$opt::workdir,
"W=s" => \$opt::retired, "W=s" => \$opt::retired,
"tmpdir=s" => \$opt::tmpdir, "tmpdir=s" => \$opt::tmpdir,
@ -1630,8 +1636,7 @@ sub terminal_columns {
sub get_job_with_sshlogin { sub get_job_with_sshlogin {
# Returns: # Returns:
# next command to run with ssh command wrapping if remote # next job object for $sshlogin if any available
# next command to run with no wrapping (clean_command)
my $sshlogin = shift; my $sshlogin = shift;
if($::oodebug and $Global::JobQueue->empty()) { if($::oodebug and $Global::JobQueue->empty()) {
@ -3798,17 +3803,33 @@ sub sshlogin_wrap {
. q{ setenv PARALLEL_PID '$PARALLEL_PID' } . q{ setenv PARALLEL_PID '$PARALLEL_PID' }
. q{ || echo PARALLEL_SEQ='$PARALLEL_SEQ'\;export PARALLEL_SEQ\; } . q{ || echo PARALLEL_SEQ='$PARALLEL_SEQ'\;export PARALLEL_SEQ\; }
. q{ PARALLEL_PID='$PARALLEL_PID'\;export PARALLEL_PID` ;' }); . q{ PARALLEL_PID='$PARALLEL_PID'\;export PARALLEL_PID` ;' });
if($opt::workdir) { my $remote_pre = "";
$self->{'sshlogin_wrap'} = my $ssh_options = "";
($pre . "$sshcmd $serverlogin $parallel_env " if($opt::ctrlc) {
. ::shell_quote_scalar("mkdir -p ".$self->workdir()."; ") # Propagating CTRL-C to kill remote jobs requires
. ::shell_quote_scalar("cd ".$self->workdir()." && ") # remote jobs to be run with a terminal.
. ::shell_quote_scalar($next_command_line).";".$post); # That means input cannot be 8-bit clean, but
} else { # must be Base64-encoded.
$self->{'sshlogin_wrap'} = # TODO this currently does not work, so --ctrlc cannot
($pre . "$sshcmd $serverlogin $parallel_env " # read from stdin (e.g. with --pipe)
. ::shell_quote_scalar($next_command_line).";".$post); $ssh_options = "-tt -oLogLevel=quiet";
# stty:
# -onlcr - make output 8-bit clean
# isig - pass CTRL-C as signal
# -echo - do not echo input
$remote_pre .= ::shell_quote_scalar('stty isig -onlcr -echo;');
} }
if($opt::workdir) {
$remote_pre .=
::shell_quote_scalar("mkdir -p ".$self->workdir()."; "
. "cd ".$self->workdir()." && ");
}
$self->{'sshlogin_wrap'} =
($pre
. "$sshcmd $ssh_options $serverlogin $parallel_env "
. $remote_pre
. ::shell_quote_scalar($next_command_line) . ";"
. $post);
} }
} }
return $self->{'sshlogin_wrap'}; return $self->{'sshlogin_wrap'};
@ -4050,6 +4071,7 @@ sub start {
# Returns: # Returns:
# job-object or undef if job not to run # job-object or undef if job not to run
my $job = shift; my $job = shift;
# Get the shell command to be executed (possibly with ssh infront).
my $command = $job->sshlogin_wrap(); my $command = $job->sshlogin_wrap();
if($Global::interactive or $Global::stderr_verbose) { if($Global::interactive or $Global::stderr_verbose) {