Re: POE::Wheel::Run::Win32 and Win32::Daemon

Andrew Feren <[email protected]> Tue, 13 Oct 2009 15:38:45 -0400

Newsgroups	gmane.comp.lang.perl.poe
Message-ID	<[email protected]>

I took some time at lunch today and got Win32::Daemon functional on my 
system.  I've attached a slightly hacked up version of your original 
script that "works" with fork().  I would, however,  suggest that 
Olivier MenguÃ©'s work around described earlier in this thread is saner 
than what I have done.  I would also take to heart his comment in rt bug 
31458 that "reliance on Win32::Daemon would be adventurous".

More comments inline below...

Andreas Altergott wrote:
> Hi,
>
> Andrew Feren wrote:
>   
>> Andreas Altergott wrote:
>> Did you try the suggested change?
>>     
>
> Yes, I did.  It did not work for me.
>   
Sure enough once I got Win32::Daemon working I found that even the 
corrected fork implementation failed after one iteration.
>> I tried very briefly to get Win32::Daemon working, but it didn't want to
>> work for me, so I can't speak to Win32::Daemon issues.  That said your
>> original service is exiting after 10 seconds because the *parent* not
>> the child is calling exit.  The child is returning immediately because
>> it has nothing to wait() for.
>>     
>
> Hmmm...  Yes, the child ends, but I don't understand why the parent
> should terminate.  It is running in an never ending while loop, until it
> gets a termination request from the service control manager.  This
> should happen when the system goes down, or if a user initiates a
> service stop.  Maybe there might be other cases I don't know, but it
> should not simply terminate after one loop.
>   
I removed the calls to exit() and the service started working as 
expected.  Calling exit() from the child resulting from perl's pseudo 
fork is supposed to work (and often does).  Unfortunately it has been my 
experience that sometimes the results are a catastrophic  failure.

https://rt.cpan.org/Ticket/Display.html?id=48237
https://rt.cpan.org/Ticket/Display.html?id=43902
 
>> From the docs you cited (emphasis mine):
>>
>>    To the Perl program that called fork(), all this is designed to be
>>    transparent. The *parent returns* from the fork() with a
>>    *pseudo-process ID* that can be subsequently used in any process
>>    manipulation functions; the /*child returns*/ from the fork() with a
>>    /*value of |0|*/ to signify that it is the child pseudo-process.
>>
>> The service control manager has every right to think the service is
>> terminated.  You terminate it when you exit after a 10 second wait.
>>     
>
> Yes, it will terminate the parent, if it does not distinguish between
> the parent and the child.  It sees a thread terminated, but somehow it
> still is alive, so it calls it to terminate.  This seems to be logical,
> if it does not distinguish between the parent and it's children.
>
> But if you do use threads instead of fork, then this does not happen.
> The same happens using system() or creating children by `` or exec().
How did you use exec()?  calling exec() after the fork() failed for me 
in the same way as calling exit.

I'm not really sure, but I'd guess that the Daemon module isn't 
copying/cloning something that it should.  As a result 
Win32::Daemon::StopService(); is getting called unexpectedly in a 
DESTROY or END block when the child exits.

-Andrew

daemon.pl (text/x-perl, 4.2 KB)

use strict;
use warnings;

use threads;

use Win32;
use Win32::Daemon;

use Getopt::Long qw(GetOptions);

my %service_info = (
  name    =>  'PerlTest',
  display =>  'Perl is a service. Oh my!',
  path    =>  'c:\perl\bin\perl.exe',
  user    =>  '',
  pwd     =>  '',
  parameters => __FILE__,	# use the full path C:\...\file.pl when running
  );

my %cmdline = ( 'install', \&install,
		'remove', \&remove,
  );

my $thr;
my $pid;

Getopt::Long::GetOptions(%cmdline) or return;


my $SERVICE_SLEEP_TIME = 20;
my $PrevState = SERVICE_START_PENDING;

Win32::Daemon::StartService();

# Wait until the service manager is ready for us to continue...
while( SERVICE_START_PENDING != Win32::Daemon::State() )
{
  sleep( 1 );
}

# Now let the service manager know that we are running...
Win32::Daemon::State( SERVICE_RUNNING );

open(FOUT, '>', 'C:/delme-parent.txt');

while (SERVICE_STOPPED != (my $State = Win32::Daemon::State())) {
    if (SERVICE_START_PENDING == $State) {
        print(FOUT "start pending ($$)\n");
        Win32::Daemon::State(SERVICE_RUNNING);
        $PrevState = SERVICE_RUNNING;
    } elsif ( SERVICE_STOP_PENDING == $State ) {
        print(FOUT "stop pending ($$)\n");
        Win32::Daemon::State(SERVICE_STOPPED);
    } elsif (SERVICE_PAUSE_PENDING == $State) {
        print(FOUT "pause pending ($$)\n");
        Win32::Daemon::State(SERVICE_PAUSED);
        $PrevState = SERVICE_PAUSED;
        next;
    } elsif (SERVICE_CONTINUE_PENDING == $State) {
        print(FOUT "continue pending ($$)\n");
        Win32::Daemon::State(SERVICE_RUNNING);
        $PrevState = SERVICE_RUNNING;
        next;
    } elsif (SERVICE_STOP_PENDING == $State) {
        print(FOUT "stop pending ($$)\n");
        Win32::Daemon::State(SERVICE_STOPPED);
        $PrevState = SERVICE_STOPPED;
        next;
    } elsif (!$State || (SERVICE_RUNNING == $State)) {
	if (0) {
	  # Runs as it should run :-)
	  unless ($thr) {
            print(FOUT "creating thread ($$)\n");
            $thr = threads->create('thread');
	    print(FOUT "running thread (".$thr->tid.")\n");
	  }
	  if ($thr->is_joinable()) {
            print(FOUT "thread returned " . $thr->join() . "\n");
            $thr = undef;
	  }
	} else {
	  if($pid = fork()) {
	    print(FOUT "running fork (".$pid.")\n");
	    wait();
	  } else {
	    thread();
	    last;		# exit is taking the parent with it...
	  }
	}
        # Runs perfectly, but freezes the parent process.
        #system("C:/Perl/bin/perl.exe C:/kid.pl");
    } else {
        print(FOUT "unknown request ($$)\n");
        Win32::Daemon::State($PrevState);
    }

    if (SERVICE_CONTROL_NONE != (my $Message =
            Win32::Daemon::QueryLastMessage(1))) {
        if (SERVICE_CONTROL_INTERROGATE == $Message) {
            print(FOUT "request received ($$)\n");
            Win32::Daemon::State($PrevState);
        } elsif (SERVICE_CONTROL_SHUTDOWN == $Message) {
            print(FOUT "shutdown!!! ($$)\n");
            Win32::Daemon::State(SERVICE_STOP_PENDING, 25000);
        }
    }

    Win32::Sleep( $SERVICE_SLEEP_TIME );
}


if ($pid == 0) {
  # oddly this shows up in the output file ahead of the parent output
  print(FOUT "exiting forked child (".$$.")\n");
}

close(FOUT);

# stuff that the child shouldn't do.
if ($pid != 0) {
  Win32::Daemon::StopService();
  exit (0);
} else {
  # exit () takes the parent with it, but falling off the end when
  # terminating is OK?  weird!
  # exit (0);
}


##############################################################################
##############################################################################
##############################################################################


sub install () {
  if( Win32::Daemon::CreateService( \%service_info ) ) {
    print "Successfully added.\n";
  } else {
    print "Failed to add service: "
      . Win32::FormatMessage( Win32::Daemon::GetLastError() ) . "\n";
  }
  exit (0);
}

sub remove () {
  if( Win32::Daemon::DeleteService( $service_info{name} ) ) {
    print "Successfully removed.\n";
  } else {
    print "Failed to remove service: "
      . Win32::FormatMessage( Win32::Daemon::GetLastError() ) . "\n";
  }
  exit (0);
}

sub thread {
    return(system("C:/Perl/bin/perl.exe C:/kid.pl"));
}