promd has asked for the wisdom of the Perl Monks concerning the following question:

Hello Perl-Pros.
I'm trying to write a Windows Service using Win32::Daemon and yes, I've used Super Search before writing this.
However, I am quite confused by the behavior of this module, and I wanted to a) share my observations and b) ask you for any experience in the areas I am dealing with.
First of all: Installing a service, as well as starting and stopping - all that works fine. But, due to the nature of my project, I am very interested in fetching the Messages that SCM sends, in particular SERVICE_CONTROL_SESSIONCHANGE and SERVICE_CONTROL_SHUTDOWN.
All Tests have been made on WindowsVista. Perl Version is 5.8, Win32::Daemon is Version 20030617.
I was not able to install 20080324, because it is looking for some *.al files (those are linked to XS, right?), which were not part of the sources that I've downloaded. I am happy about any hint on that as well.
The Skeleton that I've used is from the 20080324 Version.
The first thing that I had to learn was that the defined Constants were not all matching the documented ones from MSDN.
That's not really an issue, I've re-declared them and I'll include them here in case you find them useful: 
use constant SERVICE_CONTROL_STOP       => 0x00000001;
use constant SERVICE_CONTROL_PAUSE      => 0x00000002;
use constant SERVICE_CONTROL_CONTINUE   => 0x00000003;
use constant SERVICE_CONTROL_INTERROGATE=> 0x00000004;
use constant SERVICE_CONTROL_SHUTDOWN   => 0x00000005;
use constant SERVICE_CONTROL_PARAMCHANGE=> 0x00000006;
use constant SERVICE_CONTROL_NETBINDADD => 0x00000007;
use constant SERVICE_CONTROL_NETBINDREMOVE => 0x00000008;
use constant SERVICE_CONTROL_NETBINDENABLE => 0x00000009;
use constant SERVICE_CONTROL_NETBINDDISABLE=> 0x0000000A;
use constant SERVICE_CONTROL_DEVICEEVENT=> 0x0000000B;
use constant SERVICE_CONTROL_HARDWAREPROFILECHANGE => 0x0000000C;
use constant SERVICE_CONTROL_POWEREVENT   => 0x0000000D;
use constant SERVICE_CONTROL_SESSIONCHANGE=> 0x0000000E;
use constant SERVICE_CONTROL_PRESHUTDOWN  => 0x0000000F;
# Next 2 are not supported in Win2k and XP
use constant SERVICE_CONTROL_TIMECHANGE   => 0x00000010; 
use constant SERVICE_CONTROL_TGIGGEREVENT => 0x00000020;

use constant SERVICE_STOPPED       => 0x00000001;
use constant SERVICE_START_PENDING => 0x00000002;
use constant SERVICE_STOP_PENDING  => 0x00000003;
use constant SERVICE_RUNNING       => 0x00000004;
use constant SERVICE_CONTINUE_PENDING => 0x00000005;
use constant SERVICE_PAUSE_PENDING => 0x00000006;
use constant SERVICE_PAUSED        => 0x00000007;

[download]

This brings me to the next thing that I find somehow misleading documented: The Communication of SCM with Win32::Daemon.
I am not sure if I understand this completely, please correct me if I am wrong:

As you can see above, we do have 2 classes of constants, One set represents Messages (SERVICE_CONTROL_*),
the second group defines Service States.
Controls can be fetched using
Win32::Daemon::QueryLastMessage(),
States can be set and fetched using Win32::Daemon::State().
If you hand over a non-zero value to Win32::Daemon::QueryLastMessage(), it will re-set the last Message.
The watch out here is that the function does return the reset value in this case, and not - as the documentation indicates - the last set Message !
Another Watch out is, that the Callback Function will still get the last Message that has been set, no matter if you reset it or not, it seems to be buffered "elsewhere".
Knowing all that I assumed the following flow:
1.) Win32::Daemon hands in a Control (= Message).
2.) The Script is responsible to act on this control and
3.) Sets the correct Status if needed.

BUT, as you may have noticed, there's no code for "SERVICE_CONTROL_START" (not at all, it's not defined in SCM documentation).
Which means, the Startup is indicated to you with the Status "SERVICE_START_PENDING".


Ok, got that. This means that a "STOP" is indicated by a "SERVICE_STOP_PENDING" - right?
To answer the question myself: yes, right. If you do a "net stop myservice", the Script gets this status, but it also gets a "SERVICE_CONTROL_STOP".
It's your decision which one to pick up.
Now we are coming to the things I am most interested in:
The other Controls.
To cut this story short: I don't get any of them.
Certainly I have used AcceptedControls() to subscribe them: 
Win32::Daemon::AcceptedControls(
&SERVICE_CONTROL_STOP| &SERVICE_CONTROL_PAUSE|
&SERVICE_CONTROL_CONTINUE| SERVICE_CONTROL_INTERROGATE|    &SERVICE_CO
+NTROL_SHUTDOWN| &SERVICE_CONTROL_PARAMCHANGE|
&SERVICE_CONTROL_NETBINDADD|&SERVICE_CONTROL_NETBINDREMOVE|           
+     &SERVICE_CONTROL_NETBINDENABLE| &SERVICE_CONTROL_NETBINDDISABLE|
&SERVICE_CONTROL_DEVICEEVENT| &SERVICE_CONTROL_HARDWAREPROFILECHANGE |
&SERVICE_CONTROL_POWEREVENT|&SERVICE_CONTROL_SESSIONCHANGE|
&SERVICE_CONTROL_PRESHUTDOWN|&SERVICE_CONTROL_TIMECHANGE|
&SERVICE_CONTROL_TGIGGEREVENT );

[download]
But, I am ignored :-)

These are the ones I get: SERVICE_CONTROL_STOP, SERVICE_CONTROL_INTERROGATE, SERVICE_CONTROL_PAUSE, SERVICE_CONTROL_CONTINUE
(BTW: STOP, PAUSE and CONTINUE do all come along with the "PENDING" states set.)

These are the ones I have not tested:
SERVICE_CONTROL_PARAMCHANGE, SERVICE_CONTROL_NETBIND*, SERVICE_CONTROL_HARDWAREPROFILECHANGE, SERVICE_CONTROL_POWEREVENT, SERVICE_CONTROL_TGIGGEREVENT

And I did not get anything for:
SERVICE_CONTROL_SHUTDOWN, SERVICE_CONTROL_SESSIONCHANGE, SERVICE_CONTROL_TIMECHANGE, SERVICE_CONTROL_DEVICEEVENT

I am mainly interested in any experience you might have in capturing SERVICE_CONTROL_SHUTDOWN, SERVICE_CONTROL_SESSIONCHANGE - Is it supposed to work ???
From what I see so far, I think it has never been tested.
And yes, I know the module is old - and maybe Perl is not the perfect language to write a Service.
My Product normally uses a C++ core as Service, but Perl is so much faster for Prototyping :-)

Here's the complete code for your reference:
use Win32::Daemon;

use constant SERVICE_CONTROL_STOP                  => 0x00000001;
use constant SERVICE_CONTROL_PAUSE                 => 0x00000002;
use constant SERVICE_CONTROL_CONTINUE              => 0x00000003;
use constant SERVICE_CONTROL_INTERROGATE           => 0x00000004;
use constant SERVICE_CONTROL_SHUTDOWN              => 0x00000005;
use constant SERVICE_CONTROL_PARAMCHANGE           => 0x00000006;
use constant SERVICE_CONTROL_NETBINDADD            => 0x00000007;
use constant SERVICE_CONTROL_NETBINDREMOVE         => 0x00000008;
use constant SERVICE_CONTROL_NETBINDENABLE         => 0x00000009;
use constant SERVICE_CONTROL_NETBINDDISABLE        => 0x0000000A;
use constant SERVICE_CONTROL_DEVICEEVENT           => 0x0000000B;
use constant SERVICE_CONTROL_HARDWAREPROFILECHANGE => 0x0000000C;
use constant SERVICE_CONTROL_POWEREVENT            => 0x0000000D;
use constant SERVICE_CONTROL_SESSIONCHANGE         => 0x0000000E;
use constant SERVICE_CONTROL_PRESHUTDOWN           => 0x0000000F;
use constant SERVICE_CONTROL_TIMECHANGE            => 0x00000010; # XP
+ & Vista: Not Supported
use constant SERVICE_CONTROL_TGIGGEREVENT          => 0x00000020; # XP
+ & Vista: Not Supported

use constant SERVICE_STOPPED                       => 0x00000001;
use constant SERVICE_START_PENDING                 => 0x00000002;
use constant SERVICE_STOP_PENDING                  => 0x00000003;
use constant SERVICE_RUNNING                       => 0x00000004;
use constant SERVICE_CONTINUE_PENDING              => 0x00000005;
use constant SERVICE_PAUSE_PENDING                 => 0x00000006;
use constant SERVICE_PAUSED                        => 0x00000007;

my %List;
my $START_TIME = time();
my $DEFAULT_CALLBACK_TIMER = 5000;

my ( $SCRIPT_DIR, $SCRIPT_FILE_NAME ) = ( Win32::GetFullPathName( $0 )
+ =~ /^(.*)\\([^\\]*)$/ );
$| = 1;

my $LOG_FILE = 'C:\RothExample.log';

if( open( LOG, ">$LOG_FILE" ) ){
    my $StartTime = localtime( $START_TIME );

    my $BackupHandle = select( LOG );
    $| = 1;
    select( $BackupHandle );
}    

Win32::Daemon::RegisterCallbacks( \&CallbackRoutine );

Log( "Starting service" );
my %Context = (
    last_state => SERVICE_STOPPED,
    count      =>  0,
    start_time => time(),
);
Win32::Daemon::AcceptedControls(&SERVICE_CONTROL_STOP        |
                                &SERVICE_CONTROL_PAUSE        |
                                &SERVICE_CONTROL_CONTINUE    |
                                &SERVICE_CONTROL_INTERROGATE|
                                &SERVICE_CONTROL_SHUTDOWN    |
                                &SERVICE_CONTROL_PARAMCHANGE|
                                &SERVICE_CONTROL_NETBINDADD |
                                &SERVICE_CONTROL_NETBINDREMOVE |
                                &SERVICE_CONTROL_NETBINDENABLE | 
                                &SERVICE_CONTROL_NETBINDDISABLE|
                                &SERVICE_CONTROL_DEVICEEVENT   |
                                &SERVICE_CONTROL_HARDWAREPROFILECHANGE
+ |
                                &SERVICE_CONTROL_POWEREVENT        |
                                &SERVICE_CONTROL_SESSIONCHANGE  |
                                &SERVICE_CONTROL_PRESHUTDOWN    |
                                &SERVICE_CONTROL_TIMECHANGE        |
                                &SERVICE_CONTROL_TGIGGEREVENT );

Win32::Daemon::StartService( \%Context, $DEFAULT_CALLBACK_TIMER );

Log( "."x60 );
Log( "Shutting down the service." );
Log( "Start time: " . localtime( $Context{start_time} ) );
Log( "End time: " . localtime() );
Log( "Total running callback count: $Context{count}\n" );

#
#  Define the callback routine
#
sub CallbackRoutine {
    my( $Event, $Context ) = @_;
    my $Event_debug = Win32::Daemon::QueryLastMessage();
    Win32::Daemon::QueryLastMessage(1); # Reset the Event
    my $State = Win32::Daemon::State();
    Log( "---------- Entering Loop with Status/Event: $State/$Event ($
+Event_debug)" );

    # Evaluate STATE
    if( SERVICE_RUNNING == $State ) {
        $Context->{count}++;
        Log( "Running!!! Count=$Context->{count}. Timer:".Win32::Daemo
+n::CallbackTimer() );
    } elsif( SERVICE_START_PENDING == $State ) {
        # Initialization code
        $Context->{last_state} = SERVICE_RUNNING;
        Win32::Daemon::State( SERVICE_RUNNING );
        Log( "Service initialized. Setting state to Running." );
    } elsif( SERVICE_PAUSE_PENDING == $State ) {
        $Context->{last_state} = SERVICE_PAUSED;
        Win32::Daemon::State( SERVICE_PAUSED );
        Win32::Daemon::CallbackTimer( 0 );
        Log( "Pausing." );
    } elsif( SERVICE_CONTINUE_PENDING == $State ) {
        $Context->{last_state} = SERVICE_RUNNING;
        Win32::Daemon::State( SERVICE_RUNNING );
        Win32::Daemon::CallbackTimer( $DEFAULT_CALLBACK_TIMER );
        Log( "Resuming from paused state." );
    } else {
        Log( "Service got an unknown STATE: $State" );    
    }
    
    # Evaluate CONTROLS / Events
    if( SERVICE_CONTROL_STOP == $Event ) {
        $Context->{last_state} = SERVICE_STOPPED; # eigentlich STOP_PE
+NDING ???
        Win32::Daemon::State( [ state => SERVICE_STOPPED, error => 123
+4 ] );
        Log( "Stopping service." );
        
        # We need to notify the Daemon that we want to stop callbacks 
+and the service.
        Win32::Daemon::StopService();
    } elsif( SERVICE_CONTROL_SHUTDOWN == $Event ) {
        Log( "Event: SHUTTING DOWN!  *** Stopping this service ***" );
        # We need to notify the Daemon that we want to stop callbacks 
+and the service.
        Win32::Daemon::StopService();
    } elsif( SERVICE_CONTROL_PRESHUTDOWN == $Event ) {
        Log( "Event: Preshutdown!" );
    } elsif( SERVICE_CONTROL_INTERROGATE == $Event ) {
        Log( "Event: Interrogation!" );
    } elsif( SERVICE_CONTROL_NETBINDADD == $Event )    {
        Log( "Event: Adding a network binding!" );
    } elsif( SERVICE_CONTROL_NETBINDREMOVE == $Event ) {
        Log( "Event: Removing a network binding!" );
    } elsif( SERVICE_CONTROL_NETBINDENABLE == $Event ) {
        Log( "Event: Network binding has been enabled!" );
    } elsif( SERVICE_CONTROL_NETBINDDISABLE == $Event )    {
        Log( "Event: Network binding has been disabled!" );
    } elsif( SERVICE_CONTROL_DEVICEEVENT == $Event ) {
        Log( "Event: A device has issued some event of some sort!" );
    } elsif( SERVICE_CONTROL_HARDWAREPROFILECHANGE == $Event ) {
        Log( "Event: Hardware profile has changed!" );
    } elsif( SERVICE_CONTROL_POWEREVENT == $Event ) {
        Log( "Event: Some power event has occured!" );
    } elsif( SERVICE_CONTROL_SESSIONCHANGE == $Event ) {
        Log( "Event: User session has changed!" );
    } else {
        # Take care of unhandled states by setting the State()
        # to whatever the last state was we set...
        Win32::Daemon::State( $Context->{last_state} );
        Log( "Got an unknown EVENT: $Event" );
    }
    return();
}

sub Log{
    my( $Message ) = @_;
    if( fileno( LOG ) ){
        print LOG "[" . localtime() . "] $Message\n";
    }   
}

[download]

Replies are listed 'Best First'.
Re: Win32::Daemon Experience offered/requested
by promd (Initiate) on Feb 03, 2009 at 08:23 UTC
    It seems I'm the only one crazy enough to try this...
[reply]
      Me again... if someone ever reads that :-) After spending quite some time with this extension, I can ensure to you that it is not working as documented on Windows XP, Vista and 7 (beta). It will work perfectly if your intention is to only use start, stop, pause and continue. For most of the cases, this is perfectly enough, but if you need more... None of the other controls are working, including shutdown! You will notice that none of the examples that come with the module is using these controls. IF you do have a snipped that proofs it is working, post it!
      Also see my other (dead) posting at: http://www.roth.net/forums/topic.php?id=251
[reply]
        Thank You for all the work you have done. I don't have your level of knowledge with Services, but I do have to create some functionality around this, and your work helps. I too think the documentation is a bit lacking and was looking for a very simple stripped down to its simplest script to help me understand to processes going on in background. I was able to make your code into a service but very shortly after I start the service, I get Error 1053, The service did not respond to the start or control request in a timely fashion. Anyway, thought you'd like to know that someone out there was interrested in your work ;-). Thanks, Dan
[reply]
Re: Win32::Daemon Experience offered/requested
by zoom (Initiate) on Apr 17, 2009 at 14:53 UTC
    Thank you so much for your work investigating this module.

    How would I handle a "while()" loop in the "SERVICE_RUNNING" state? I tried to do modify your code to do this:

    # Evaluate STATE
if( SERVICE_RUNNING == $State ) {
  $Context->{count}++;
  Log( "Running!!! Count=$Context->{count}. Timer:".Win32::Daemon::Cal
+lbackTimer() );
  my $x = 1;
  while( $State != SERVICE_STOP_PENDING && $State != SERVICE_STOPPED )
+ {
    Log($x);
    $x++;
    sleep 2;
  }
}

    [download]


    However, when I attempt to stop the service, the Windows Service Manager does not stop it. It eventually times out after 2-3 minutes and complains that it couldn't stop it.

    Do I have to fork() my while loop as a child process? Or are my while() loop conditions just wrong?
[reply]
[d/l]
      You must update $state inside your loop: 
      $state = Win32::Daemon::State();

      [download]
      Or better, just put only your job timeslice inside the $state == SERVICE_RUNNING condition as there is already a loop outside.
[reply]
[d/l]
[select]
        Neither of those solutions work because it is still waiting for the sleep() to finish. This is apparent when I increase the sleep from 2 seconds to 500 seconds, which better emulates the time-intensive function that my program is doing (enumerating all files on the hard drive and adding their sizes). Any other ideas on how to handle this?
[reply]
Use LastControlMessage() with 20080324
by dolmen (Beadle) on Sep 23, 2009 at 15:27 UTC

    In version 20080324 of Win32::Daemon (which AFIK is only available in binary, without source) QueryLastMessage() has been replaced by LastControlMessage().

[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom