parallel: bug #41964: Remote sleep is now a perl script.

This commit is contained in:
Ole Tange 2014-04-01 09:50:38 +02:00
parent 8078bda2bb
commit d11e6478c0

View file

@ -186,7 +186,7 @@ if($Global::semaphore) {
$sem->release(); $sem->release();
} }
for(keys %Global::sshmaster) { for(keys %Global::sshmaster) {
kill 9, $_; kill "TERM", $_;
} }
::debug("Halt\n"); ::debug("Halt\n");
if($opt::halt_on_error) { if($opt::halt_on_error) {
@ -359,9 +359,7 @@ sub nindex {
# See if string is in buffer N times # See if string is in buffer N times
# Returns: # Returns:
# the position where the Nth copy is found # the position where the Nth copy is found
my $buf_ref = shift; my ($buf_ref, $str, $n) = @_;
my $str = shift;
my $n = shift;
my $i = 0; my $i = 0;
for(1..$n) { for(1..$n) {
$i = index($$buf_ref,$str,$i+1); $i = index($$buf_ref,$str,$i+1);
@ -602,8 +600,7 @@ sub get_options_from_array {
# true if parsing worked # true if parsing worked
# false if parsing failed # false if parsing failed
# @array is changed # @array is changed
my $array_ref = shift; my ($array_ref, @keep_only) = @_;
my @keep_only = @_;
# A bit of shuffling of @ARGV needed as GetOptionsFromArray is not # A bit of shuffling of @ARGV needed as GetOptionsFromArray is not
# supported everywhere # supported everywhere
my @save_argv; my @save_argv;
@ -633,7 +630,7 @@ sub get_options_from_array {
sub parse_options { sub parse_options {
# Returns: N/A # Returns: N/A
# Defaults: # Defaults:
$Global::version = 20140326; $Global::version = 20140401;
$Global::progname = 'parallel'; $Global::progname = 'parallel';
$Global::infinity = 2**31; $Global::infinity = 2**31;
$Global::debug = 0; $Global::debug = 0;
@ -877,7 +874,7 @@ sub parse_options {
} }
sub env_quote { sub env_quote {
my $v = shift; my $v = $_[0];
$v =~ s/([\\])/\\$1/g; $v =~ s/([\\])/\\$1/g;
$v =~ s/([\[\] \#\'\&\<\>\(\)\;\{\}\t\"\$\`\*\174\!\?\~])/\\$1/g; $v =~ s/([\[\] \#\'\&\<\>\(\)\;\{\}\t\"\$\`\*\174\!\?\~])/\\$1/g;
$v =~ s/\n/"\n"/g; $v =~ s/\n/"\n"/g;
@ -3828,9 +3825,6 @@ sub sshcommand_of_sshlogin {
my $control_path = $self->control_path_dir()."/ssh-%r@%h:%p"; my $control_path = $self->control_path_dir()."/ssh-%r@%h:%p";
$sshcmd = "ssh -S ".$control_path; $sshcmd = "ssh -S ".$control_path;
$serverlogin = $self->{'string'}; $serverlogin = $self->{'string'};
# OpenSSH_3.6.1p2 gives 'tcgetattr: Invalid argument' with -tt
# 2>/dev/null to ignore "process_mux_new_session: tcgetattr: Invalid argument"
my $master = "ssh -tt -MTS $control_path $serverlogin sleep 1000000000 2>/dev/null";
if(not $self->{'control_path'}{$control_path}++) { if(not $self->{'control_path'}{$control_path}++) {
# Master is not running for this control_path # Master is not running for this control_path
# Start it # Start it
@ -3838,9 +3832,16 @@ sub sshcommand_of_sshlogin {
if($pid) { if($pid) {
$Global::sshmaster{$pid} ||= 1; $Global::sshmaster{$pid} ||= 1;
} else { } else {
::debug($master,"\n"); $SIG{'TERM'} = undef;
`$master </dev/null`; # OpenSSH_3.6.1p2 gives 'tcgetattr: Invalid argument' with -tt
::wait_and_exit(0); # STDERR >/dev/null to ignore "process_mux_new_session: tcgetattr: Invalid argument"
open(STDERR,">","/dev/null");
open(STDIN,"<","/dev/null");
# Run a sleep that outputs data, so it will discover if the ssh connection closes.
my $sleep = ::shell_quote_scalar('$|=1;while(1){sleep 1;print "foo\n"}');
my @master = ("ssh", "-MTS", $control_path, $serverlogin, "perl", "-e", $sleep);
::debug("@master\n");
exec(@master);
} }
} }
} else { } else {
@ -4075,7 +4076,7 @@ sub cattail {
# clear EOF # clear EOF
seek(IN,0,1); seek(IN,0,1);
my $writer_running = kill 0, $writerpid; my $writer_running = kill 0, $writerpid;
$read = sysread(IN,$buf,1_000_000); $read = sysread(IN,$buf,32768);
if($read) { if($read) {
# We can unlink the file now: The writer has written something # We can unlink the file now: The writer has written something
-e $unlink_file and unlink $unlink_file; -e $unlink_file and unlink $unlink_file;
@ -5082,7 +5083,7 @@ sub print {
$buf =~ s/^tcgetattr: Invalid argument\n//; $buf =~ s/^tcgetattr: Invalid argument\n//;
print $out_fd $buf; print $out_fd $buf;
} }
while(sysread($in_fh,$buf,1_000_000)) { while(sysread($in_fh,$buf,32768)) {
print $out_fd $buf; print $out_fd $buf;
} }
} }