I've found a script on the web that uses fork to run several pings in parallel. It works fine on a Linux box running perl 5.00x but it does not work on RedHat 8 with perl 5.8. Is it due to the new multi threading architecture in 5.8 ?
Moreover, I've read on this forum that you can not push results to an array within a fork because each child process is going to create a copy of this array: this tends to be confirmed when I tried to debug this under 5.8, however this script (that does push to an array) works very well on 5.00x
So how to have this working on 5.8 ?
Here is the script:
(PS: I have tried to do this using Parallel::ForkManager and I have the same issue.)
sub ping_a_host {
my $host = shift;
`ping -i 1 -c 1 $host 2>/dev/null` =~ /0 packets rec/ ? 0 : 1;
}
my %pid_to_host;
my %host_result;
sub wait_for_a_kid {
my $pid = wait;
return 0 if $pid < 0;
my $host = delete $pid_to_host{$pid}
or warn("Why did I see $pid ($?)\n"
, next;
warn "reaping $pid for $host\n";
$host_result{$host} = $? ? 0 : 1;
1;
}
my @hosts = map "10.0.1.$_", "001".."254";
for (@hosts) {
wait_for_a_kid() if keys %pid_to_host > 10;
if (my $pid = fork) {
## parent does...
$pid_to_host{$pid} = $_;
warn "$pid is processing $_\n";
} else { # child does
## child does...
exit !ping_a_host($_);
}
}
## final reap:
1 while wait_for_a_kid();
for (sort keys %host_result) {
print "$_ is ", ($host_result{$_} ? "good" : "bad"
, "\n";
}
Moreover, I've read on this forum that you can not push results to an array within a fork because each child process is going to create a copy of this array: this tends to be confirmed when I tried to debug this under 5.8, however this script (that does push to an array) works very well on 5.00x
So how to have this working on 5.8 ?
Here is the script:
(PS: I have tried to do this using Parallel::ForkManager and I have the same issue.)
sub ping_a_host {
my $host = shift;
`ping -i 1 -c 1 $host 2>/dev/null` =~ /0 packets rec/ ? 0 : 1;
}
my %pid_to_host;
my %host_result;
sub wait_for_a_kid {
my $pid = wait;
return 0 if $pid < 0;
my $host = delete $pid_to_host{$pid}
or warn("Why did I see $pid ($?)\n"
warn "reaping $pid for $host\n";
$host_result{$host} = $? ? 0 : 1;
1;
}
my @hosts = map "10.0.1.$_", "001".."254";
for (@hosts) {
wait_for_a_kid() if keys %pid_to_host > 10;
if (my $pid = fork) {
## parent does...
$pid_to_host{$pid} = $_;
warn "$pid is processing $_\n";
} else { # child does
## child does...
exit !ping_a_host($_);
}
}
## final reap:
1 while wait_for_a_kid();
for (sort keys %host_result) {
print "$_ is ", ($host_result{$_} ? "good" : "bad"
}