mirror of
https://git.savannah.gnu.org/git/parallel.git
synced 2024-11-25 23:47:53 +00:00
parallel: bug #41964: Remote sleep is now a perl script.
This commit is contained in:
parent
8078bda2bb
commit
d11e6478c0
33
src/parallel
33
src/parallel
|
@ -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;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
Loading…
Reference in a new issue