Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

Nasty MultiThread problem

by JFarr (Sexton)
on Nov 18, 2005 at 21:26 UTC ( #509960=perlquestion: print w/ replies, xml ) Need Help??
JFarr has asked for the wisdom of the Perl Monks concerning the following question:

Hello Monks,

I've been killing myself on an issue here for almost 9 days now. I've implemented all sorts of thread routines, some worked to some extent, most failed miserably.

I need to shut down processes in parallel on multiple machines in multiple locations. The problem I am having is that if there is ANY delay on a machine responding to my thread call, once the other threads finish, the parent thread exits and I get the nasty "thread exited when X threads still running" or something like that.

So basically I have a loop to search for host, which spawns the first thread, on the host thread, I search for the services and spawn the second thread, to shut the services down in parallel.

If anyone has know of a way to do this, or a better way to do this help would be greatly appreciated. I'm at a loss at this point.

In the code, I've put comments #PERL MONKS.

#!/usr/bin/perl use lib '..\\modules'; use Win32; use Win32::Service; use threads; use threads::shared; our @output :shared; our @additionalServices :shared; my $version = "1.4.0"; # Runtime defaults my $timeout = 1; my $interval = 1; our $failsvclist :shared; our @failstack :shared; our @ServicesToClose; my %threads; $| = 1; GetOptions ( "help" => \$help, "system=s" => \$mapfile, "self" => \$self_flag, "timeout=i" => \$timeout, "retry=i" => \$interval, "include=s" => \$incfile, "exclude=s" => \$excfile, "processing=s"=> \$serParProcessing, "owsag=s" => \$owsagProcessing ); # Display usage if requested if ( $help ne "" ) { usage(); die } # Make sure you have a valid lab.hosts file if ( $mapfile ){ if ( -e $mapfile ){ @syshosts = HostMap::read($mapfile); } else { die "$mapfile does not exist.\n"; } } elsif($self_flag) { $self_host = new Host(); $self_host->set_type("Self"); push @syshosts, $self_host; } else { die "No system map specified.\n"; } # Read in include.services file and produce a list of include strings # to search for in the list of all services. By default, is # used in addition to any in the include file. if ( $incfile ) { if ( -e $incfile ){ @incstrings = ServiceFile::read($incfile); } else { die "$incfile does not exist.\n"; } } push @incstrings, "Res21"; # Read in exclude.services file if ( $excfile ) { if ( -e $excfile ){ @excstrings = ServiceFile::read($excfile); } else { die "$incfile does not exist.\n"; } } undef %failsvclist; my $threadLocalHost = shift; my $i = shift; print "Stopping Rescue21 services ...\n\n"; if( $serParProcessing eq "P" ) { if( $owsagProcessing eq "P" ) { my $id = 1; #PERL MONKS # Here is where the first problem is. # If a returned process has a delay, the thread exits and dumps the re +st of the code # How do I keep the thread(s) alive until the remaining processes comp +lete their task. # Thread call 1, there are 7 host names in @syshosts # This must be done in parallel so I can shutdown the processes in a m +inimal amount of time. foreach $host (@syshosts) ) { $threads = threads->new(\&locateSysHost_Parallel, $hos +t); } # # allow the services a couple of seconds to die # # gracefully and then go in with the hammer. # $grace = 2; sleep ($grace); # print "\n\nSearch and destroy any surviving processes ...\n\n" +; # #PERL MONKS # This is thread call 3 # Here I need to go back to the host machines, searc of a list of proc +ess that are still alive # and kill them, this must be done in parallel so the shutdown time is + small. foreach $host ( @syshosts ) { push @threads, threads->new(\&stopReaminingServices, $host +); } #$_->join for @thre; sleep(1); &SummaryReport; #************* #************* # Subroutines #************* #************* # # Locate each System host # sub locateSysHost_Parallel:locked { my ($host, @extra) = @_; $cname = Host::get_cname($host); $hostip = Host::get_ip($host); my $timestring = `time \/t`; chomp $timestring; print "======================================================== +==========\n"; print "HOST = $cname\n"; print "IP = $hostip\n"; print "TIME = $timestring\n"; print "======================================================== +==========\n"; # Get a list of all the registered services on the host undef %regservices; Win32::Service::GetServices(${$host}{ip}, \%regservices); @allservices = values %regservices; undef @incservices; undef @r21services; for $i ( @incstrings ) { if (!($i =~ /Res21/i)) { foreach $j (@allservices) { if ($j eq $i) { push @incservices, $j; } } } else { @incservices = grep /^$i.*/, @allservices; } push @r21services, @incservices; undef @incservices; } # Remove from this list, all services specified in the exclude. +services file. foreach $string ( @excstrings ) { $index = 0; while ( $r21services[$index] ) { if ( $r21services[$index] =~ /$string/i ) { splice @r21services, $index, 1; } else { $index++; } } } # Now go through the list and stop them undef @failstack; #Shut down each service on the node my @filetolookfor = shift; #PERL MONKS # This is the second thread call # Once again this must be done in parallel to minimize shutdown time # foreach $j(@r21services) { push @threadService, threads->new(\&stopR21Services, $host, $j +); } $_->join for threads->list; # #Stop each service on each node # sub stopR21Services : locked { my($host, $i, @extra) = @_; # Determine initial state Win32::Service::GetStatus(${$host}{ip}, $i, \%servicestatus); # If the services is running, shut it down if ($servicestatus{CurrentState} ne 1 ) { # Request the service to be stopped Win32::Service::StopService(${$host}{ip}, $i); } } # #Kill the remaining services that my not have been stopped the first t +ime around #this will be those services still running or applicatiosn on our list + that were not services. sub stopReaminingServices { my($host, @extra) = @_; $cname = Host::get_cname($host); $hostip = Host::get_ip($host); my $timestring = `time \/t`; chomp $timestring; print "======================================================== +==========\n"; print "HOST = $cname\n"; print "IP = $hostip\n"; print "TIME = $timestring\n"; print "======================================================== +==========\n"; # This is the MS recommended way to check OS type. For referenc +e, see: # http://msdn.microsoft.com/library/default.asp?url=/library/en +-us/shellcc/platform/shell/reference/enums/csidl.asp $csidl_system = 0x0025; $win32dir = Win32::GetFolderPath($csidl_system); ($drive, $osname, $sysname) = split(/\\/, $win32dir); if ($osname eq "WINDOWS") { winXP(); } if ($osname eq "WINNT") { win2K(); } } sub SummaryReport { ## Give summary report print "\n\n"; print "=========================================================== +=====\n"; print " Shutdown\n"; print " Summary Report\n"; print " --------------\n"; print "\n"; print "Shutdown completed.\n"; print "\n"; @errhosts = keys %failsvclist; if ($#errhosts >= 0 ) { print "Unable to shutdown the following services:\n"; foreach $i (@errhosts) { print " $i with @{ $failsvclist{$i} }\n"; } } yield; } # These two subroutines, one for Windows XP OS and one for # Windows 2000 OS sequence through the process list searching # for and terminating all Rescue21 processes and their children # that survived the service stoppage phase. sub winXP { #print "winXP\n"; @proclist = `tasklist /s $hostip`; foreach $r21exe (@r21_processes) { if ($r21exe) { chomp $r21exe; @found = grep s/$r21exe( *)/$r21exe:/i, @proclist; if (@found) { foreach $process (@found) { ($pname, $pid) = split(/:/, $process); ($pid, $string) = split(/ /, $pid); system "taskkill /s $hostip /f /pid $pid /t"; } } } } } sub win2K:locked { print "winn2K\n"; @proclist = `tlist`; if (@proclist) { foreach $r21exe (@r21_processes) { if ($r21exe) { chomp $r21exe; @found = grep s/ $r21exe/:$r21exe/i, @proclist; if (@found) { foreach $process (@found) { ($pid, $pname) = split(/:/, $process); system "kill -f $pid"; } } } } } } # This subroutine is provided simply to make the state more readable # when displayed # 1 = stopped, 4 = started sub trstate : locked{ my $state = shift; if ($state eq 1) {return "OFF"} elsif ($state eq 4) {return "ON"} else {return "-"}; }

READMORE tags added by Arunbear

Comment on Nasty MultiThread problem
Download Code
Re: Nasty MultiThread problem
by BrowserUk (Pope) on Nov 18, 2005 at 21:54 UTC

    The solution is to call threads::join on each thread handle before exiting the main thread. This will ensure that all threads have finished before your main thread terminates.

    You have this line in your code

    #$_->join for @thre;

    Why have you commented it out?


    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    Lingua non convalesco, consenesco et abolesco. -- Rule 1 has a caveat! -- Who broke the cabal?
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.
      I had used that. That did not stop the thread from exiting. I had a 3 second delay from an AnalogGateway, and the thread terminated. Thanks for the reply.
        I had used that. That did not stop the thread from exiting.

        Then you must be calling it at the wrong place in the code.

        It is difficult to try to help further as the code you have posted has at least twothree missing close braces.

        Neither of these if statement bodies are closed.

        if( $serParProcessing eq "P" ) { if( $owsagProcessing eq "P" ) {

        Nor is this subroutine.

        sub locateSysHost_Parallel:locked {


        Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
        Lingua non convalesco, consenesco et abolesco. -- Rule 1 has a caveat! -- Who broke the cabal?
        "Science is about questioning the status quo. Questioning authority".
        In the absence of evidence, opinion is indistinguishable from prejudice.
        Then you're probably not joining all active threads, either from not storing hem correctly or for some other reason (I did not look at your code). One way of ensuring that you close all threads:
        $_->join for threads->list();
        According to the pod of "threads"
        threads->list();
                   This will return a list of all non joined, non detached threads.
        
        Hope this helps.
Re: Nasty MultiThread problem
by zentara (Archbishop) on Nov 19, 2005 at 12:51 UTC
    Hi, your code is kind of long, and the wrong OS, for me to test; but I think you may be running into the common misconception that $thread->join forces a thread to terminate. It dosn't as the following code shows:
    #!/usr/bin/perl use warnings; use strict; use threads; # join() does three things: it waits for a thread to exit, # cleans up after it, and returns any data the thread may # have produced. my $thr = threads->new(\&sub1); my $return = $thr->join; print "Thread returned @$return\n"; #hold for key input <>; ########################################################## sub sub1 { my @values = ('1',2, 'ten'); print "@values\n"; while(1){sleep 1} return \@values; }

    If you can't be sure that all your threads have reached the end of their code block, before you try to join them, you can force them to die with a shared variable. See how this minor modification will force the thread to return early, and thus be joinable.

    #!/usr/bin/perl use warnings; use strict; use threads; use threads::shared; # join() does three things: it waits for a thread to exit, # cleans up after it, and returns any data the thread may # have produced. my $die : shared = 0; my $thr = threads->new(\&sub1); #hold for key input <>; $die=1; my $return = $thr->join; print "Thread returned @$return\n"; #hold for key input <>; ########################################################## sub sub1 { my @values = ('1',2, 'ten'); print "@values\n"; while(1){ sleep 1; if($die){return \@values } } return \@values; }

    I'm not really a human, but I play one on earth. flash japh

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://509960]
Approved by Old_Gray_Bear
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others romping around the Monastery: (11)
As of 2014-10-23 17:39 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    For retirement, I am banking on:










    Results (126 votes), past polls