Parallel execution of command using Parallel::ForkManager

Question

I want to know whether my understanding is right or not for the below script/logic.

I have list of nodes and I need to run a certain command on each of the node by utilizing number of servers which I have by doing SSH to the servers, means the process should happen parallelly.

I have node_list.txt file which contains list of nodes:

node1
node2
.
.
node49
node50

I have defined number of servers in an array @hosts where I should do SSH and execute the command to each node by splitting the node_file.txt into equal number of parts(called $node_list_X.txt) in an available servers.

Once I have these files (node_list_1.txt,node_list_2.txt,node_list_3.txt,node_list_4.txt) I will be logging into each the server which is already been defined and executing certain commands on each hosts by passing node_list_X.txt file parallelly.

To execute this parallelly I am using Parallel::ForkManager Perl module.

So that, lets say in each host -

192.168.0.1 -> node_list_1.txt (13 nodes)
192.168.0.2 -> node_list_2.txt (13 nodes)
192.168.0.3 -> node_list_3.txt (12 nodes)
192.168.0.4 -> node_list_4.txt (12 nodes)

will run parallelly.

Script is below:

...
my @hosts = ("192.168.0.1", "192.168.0.2", "192.168.0.3","192.168.0.4");

open(my $node_fh, '<', $node_file)
        or die "can't open $node_file: $!";

my @lines =  <$node_fh>;

my %Files;

my $num_buckets = scalar @hosts;

my $per_bucket = int( @lines / $num_buckets );
my $num_extras =      @lines % $num_buckets;
my $path = "/home/user/vinod/test/";

for my $bucket_num (0..$num_buckets-1) {
   my $num_lines = $per_bucket;
   if ($num_extras) {
      ++$num_lines;
      --$num_extras;
   }

   last if($num_lines == 0);
   my $qfn = $path."node_list_${bucket_num}.txt";
   open(my $fh, '>', $qfn)
      or die("Can't create \"$qfn\": $!\n");

   $fh->print(splice(@lines, 0, $num_lines));
   $Files{$bucket_num} = $qfn;
}
print Dumper(\%Files);

my $command = #"defining my command here";

my $pm = Parallel::ForkManager->new(5);
my $ssh;

DATA_LOOP:
foreach my $n (0..$num_buckets-1) {
    if( exists $Files{$n} ) {
        my $pid = $pm->start and next DATA_LOOP;

        $command_to_execute = $command." ".$Files{$n};
        $ssh = SSH_Connection( $hosts[$n-1], "user", "password" );
        $result = $ssh->capture($command_to_execute);
      
        $pm->finish;       
    }
}
$pm->wait_all_children;
undef $ssh;

#SSH Connect
sub SSH_Connection {
    my ( $host, $user, $passwd ) = @_;
    my $ssh = Net::OpenSSH->new($host,
                                user => $user,
                                password => $passwd,
                                master_opts => [-o => "StrictHostKeyChecking=no"]
    );
    $ssh->error and die "Couldn't establish SSH connection: ". $ssh->error;
    return $ssh;
}

Here everything works fine.

When I am defining $pm object, parallel process set to 5.

my $pm = Parallel::ForkManager->new(5);

Does this means at a time in a particular server (Ex:192.168.0.1) it should run 5 parallel process. Means it should take 5 nodes from a node_list_1.txt (out of 13) file and execute the command?

Is my understdning correct? If not, what could be the possible solution to run the command in each server parallelly with multi-threading?

Answer 1

Does this means at a time in a perticular server (Ex:192.168.0.1) it should run 5 parallel process.

No. P::FM doesn't know anything about servers. It manages processes, and ->new(5) means ->start will wait for one of the processes it created to finish before creating a new one if 5 of them are still executing.

what could be the possible solution to run the command in each server parallelly with multi-threading?

Assuming you meant multi-tasking generally rather than multi-threading specifically (since you aren't using threads), create a process for each host could be done as follows:

my %children;
my $error = 0;
for my $host (@hosts) {
    my $pid = fork();
    if (!defined($pid)) {
       warn("Can't execute on $host: Can't fork: $!\n");
       next;
    }

    if ($pid) {
       ++$children{$pid};
       next;
    }

    if (!eval {
       do_it($host);
       return 1;  # No exception
    }) {
       warn("Error executing commands on $host: $@");
    }
}

while (%children) {
   ( my $pid = wait() ) >= 0
      or die("Can't wait: $!\n");

   delete($children{$pid});   
}

Answer 2

If you want to run jobs on a bunch of different servers, consider a proper job queue. Perl's Minion is very nice. Various servers can connect to it, ask for jobs in various ways, and send back the results.