Multithreading Perl script and crontab/init script

Question

I have an issue with a Perl script using thread.

It works fine when I launch it manually but when I launch it using crontab I have this feedback:

Perl exited with active threads:

    0 running and unjoined
    1 finished and unjoined
    0 running and detached

The PATH variable and SHELL variable are correct on the crontad.

I try to make a init script (to launch as a service) and same error:

Feb 24 08:04:48 SERVER kernel: perl[103293]: segfault at 4a8 ip 00007f6cfd075dd9 sp 00007fffb93437c0 error 4 in libperl.so[7f6cfcfdf000+183000] Feb 24 08:04:49 SERVER test_ping[102238]: Perl exited with active threads: Feb 24 08:04:49 SERVER test_ping[102238]: 0 running and unjoined Feb 24 08:04:49 SERVER test_ping[102238]: 1 finished and unjoined Feb 24 08:04:49 SERVER test_ping[102238]: 0 running and detached

So I have also tried to modified the perl with:

for my $thread (threads->list) {                                                                                                                
$thread->join();                                                                               
}

Instead of

for my $thread (threads->list) {                                                                                                                
$thread->detach();                                                                               
}

And after this modification when I launch manually the script, this one seems to be stuck/freezing.

So to resume this is all my check:

Executed manually it work
Via crontab it doesn't work, check of PATH variable and SHELL variable are ok
Via init script, doesn't work
Try to modify the perl script to join all thread but it the script is freezing after that.

Anyone has a suggestion ? Something else to check/do ?

Thk

 use lib '/usr/local/perf/lib';
use lib '/usr/share/perl5';
use threads;
use Thread::Queue;
use SNMP::Persist qw(&define_oid &start_persister &define_subtree);
use Schedule::ByClock;
use Time::HiRes qw( usleep ualarm gettimeofday tv_interval );

use strict;
#use warnings;
use constant DEBUG => 0;
use constant DEBUG2 => 1;

if ($#ARGV + 1 != 2) {
 print "usage: test_ping.pl OUTPUTFILE INPUTFILE \n";
 exit;
}

my $output_file=$ARGV[0];
my $data_file=$ARGV[1];
shift @ARGV;
shift @ARGV;

#start the thread serving answers
start_persister();

#create queue for processing commands
my $q_queue = new Thread::Queue;
my $r_queue = new Thread::Queue;

#create threads for processing queues
for(my $i= 0; $i < $thread_num; $i++) {
        threads->create(\&process) -> detach();
}
        my $datestring=localtime();

        my %subtree;
        my @raw_data;

        my ($q_line, @q_split);
        my ($r_line, @r_split);
        my $index=0;

        # open file to get data
        open(DAT, $data_file) || die("Could not open file!");
        @raw_data=<DAT>;
        close(DAT);

        # enqueue all lines to be process by threads
        foreach $q_line (@raw_data) {
                chomp($q_line);
                $q_line =~ s/^\s+//;
                $q_line =~ s/\s+$//;
                next if ($q_line =~ /^#.*/);
                next if ($q_line eq "");
                next if ($q_line =~ /^\|/);

                @q_split=split(/\|/,$q_line);
                next if (!($q_split[0] eq "icmp" || $q_split[0] eq "tcp" || $q_split[0] eq "ldap" || $q_split[0] eq "dig" ));

                $q_queue->enqueue(++$index ."|". $q_line);
        }

        while ($index != 0 && ($r_line = $r_queue->dequeue)) {

                open(my $fh, '>>', $output_file) or die "Could not open file '$output_file' $!";
                print $fh $datestring."|";
                print $fh $r_line."\n";
                close $fh;
                @r_split=split(/\|/,$r_line);
                $index--;
        }

        for my $thread (threads->list) {                                                                                                                
            $thread->detach();                                                                               
    }

Below the process fonction:

sub process {
    # my @hotefqdn = split(/\./, `hostname`);
    # my $hote=$hotefqdn[0];
    my ($q_line,@q_split,$q_index,$q_query);
    my ($q_module,$q_type,$q_name,$q_host,$q_port,$q_ssl,$q_send,$q_expect,$q_quit);
    my ($q_lookup,$q_record);
    my ($q_base_dn,$q_attr,$q_binddn,$q_password,$q_warn_time,$q_crit_time,$q_timeout);
    my ($r_tab);

    while ($q_line = $q_queue->dequeue) { 

            @q_split=split(/\|/,$q_line);

            $q_index=$q_split[0];
            $q_module=$q_split[1];

            if ($q_module eq "icmp") {
                    $q_type=$q_split[2];
                    $q_name=$q_split[3];
                    $q_host=$q_split[4];
                    $q_query="$q_host (ping)";
                    print "query=$q_query\n" if(DEBUG);
                    $r_tab=icmp_query($q_host);
            }
            elsif ($q_module eq "tcp") {
                    $q_type=$q_split[2];
                    $q_name=$q_split[3];
                    $q_query="$q_host ($q_type:$q_port)";
                    print "query=$q_query\n" if(DEBUG);
                    $r_tab=tcp_query($q_host,$q_port,$q_ssl,$q_send,$q_expect,$q_quit);
            }
            elsif ($q_module eq "ldap") {
                    $q_type=$q_split[2];
                    $q_name=$q_split[3];
                    print "query=$q_query\n" if(DEBUG);
                    $r_tab=ldap_query($q_host,$q_base_dn,$q_port,$q_attr,$q_binddn,$q_password,$q_warn_time,$q_crit_time,$q_timeout);
            }
            elsif ($q_module eq "dig") {
                    $q_type=$q_split[2];
                    $q_name=$q_split[3];
                    $q_query="$q_lookup($q_record) @".$q_host;
                    print "query=$q_query\n" if(DEBUG);
                    $r_tab=dig_query($q_host,$q_port,$q_lookup,$q_record,$q_expect);
            }

            $r_queue->enqueue($q_index."|".$q_name."|".$q_type."|".$q_query."|".$r_tab->{'min'}."|".$r_tab->{'med'}."|".$r_tab->{'avg'}."|".$r_tab->{'max'}."|".$r_tab->{'dev'}."|".$r_tab->{'loss'}."|".$r_tab->{'err'});
    }

}

It would be really helpful if you could come up with a minimal, compilable code snippet that reproduces the problem you're having. — Tanktalus
And that's why I asked for a minimal snippet that still reproduces the problem. Because the problem likely has something to do with the code. — Tanktalus

ikegami ikegami · Accepted Answer · 2017-02-24T18:00:08

First of all, don't detach your threads. When you do, you can't wait for them to finish.

for (my $i= 0; $i < $thread_num; $i++) {
    threads->create(\&process) -> detach();
}

...

for my $thread (threads->list) {
    $thread->detach();
}

should be

for (1..$thread_num) {
    threads->create(\&process);
}

...

... Tell the threads to finish up ...

for my $thread (threads->list) {
    $thread->join();
}

Now on the question: Why don't your threads finish? Well, you never tell them to exit, so they never do! You need to ask to them to exit, and that can be achieved by adding the following:

$q_queue->end();

What follows is what you get after you apply the above fixes. I've also moved all thread-related code out of process, since it doesn't belong there. Finally, I removed the reliance on $index by moving the output code into its own thread.

sub process {
   my ($q_line) = @_;
   ...
   return join("|", $q_index, $q_name, $q_type, $q_query, @$r_tab{qw( min med avg max dev loss err )});
}

my $request_q  = Thread::Queue->new();
my $response_q = Thread::Queue->new();

my @worker_threads;
for (1..$thread_num) {
   push @worker_threads, async {
      while (defined( my $request = $request_q->dequeue() )) {
         $response_q->enqueue( process($request) );
      }
   };
}

my $output_thread = do {
   my $datestring = localtime();

   open(my $fh, '>', $output_file)
      or die("Can't create file \"$output_file\": $!\n");

   async {
      while (defined( my $response = $response_q->dequeue() )) {
         print($fh "$datestring|$response\n");
      }
   }
};

{    
   my %protos = map { $_ => 1 } qw( icmp tcp ldap dig );

   open(my $fh, '<', $data_file)
      or die("Can't open file \"$data_file\": $!\n");

   my $index = 0;
   while (<$fh>) {
      s/^\s+//;
      s/\s+\z//;
      next if $_ eq "" || /^#/;

      my ($proto) = split /\|/;
      next if !$protos{$proto};

      $request_q->enqueue(++$index ."|". $_);
   }
}

$request_q->end();
$_->join() for @worker_threads;

$response_q->end();
$output_threads->join();

Multithreading Perl script and crontab/init script

1 Answers