Hi all,

I have built a couple of Windows Services using Win32::Daemon. Individually, these services work very well over many days of operation. The problem occurs when I have both services installed on the same machine - After a few hours one (or, very rarely, both) of these services stops running.

Upon investigation, it appears the running callback stops being called after a random amount of time (usually between 5 and 8 hours) and usually only for the second service that was installed (usually the first service installed, whichever one that is, will continue to function normally).

When the running callback stops being called, the service is still functional (it completes any work it is currently doing and also responds correctly to the pause, continue and stop callbacks), however in order for it to start working again, the service must be stopped and restarted.

I would really appreciate any assistance / advice regarding this issue, thanks.

Please find simplified example code here that exhibits the same problem:

use strict;
use warnings;
use Win32::Daemon;

use constant SERVICE_POLL_RATE => 1E3;

if (my $opt = shift @ARGV){
    my %serviceSettings = (
        name    => 'MyExampleService',
        #name    => 'MyExampleService2',
        display => 'My Example Service',
        #display => 'My Example Service 2',
        path    => $^X,
        parameters => $0,
    );
    if ($opt eq '-i')       { installService(%serviceSettings); }
        elsif ($opt eq '-r'){ deleteService(%serviceSettings); }
    exit;
}

my %Context = (
    last_state => SERVICE_STOPPED,
    start_time => time,
);

my $logFile = $0;
$logFile    =~ s/\w+$/log/;
open STDOUT, ">", $logFile;
$|=1;

print "Register callbacks\n";

Win32::Daemon::RegisterCallbacks( {
    start    => \&callbackStart,
    stop     => \&callbackStop,
    running  => \&callbackRunning,
    pause    => \&callbackPause,
    continue => \&callbackContinue,
} );

print "Start service\n";

Win32::Daemon::StartService( \%Context, SERVICE_POLL_RATE );

print "Service finished, cleaning up\n";

close STDOUT;

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

sub deleteService
{
    my (%serviceSettings) = @_;
    Win32::Daemon::DeleteService('', $serviceSettings{name}) or die "D
+elete service failed, error:\n\t".Win32::Daemon::GetLastError().": ".
+Win32::FormatMessage(Win32::Daemon::GetLastError());
    print "Service deleted\n";
}

sub installService
{
    my (%serviceSettings) = @_;
    Win32::Daemon::CreateService(\%serviceSettings) or die "Install se
+rvice failed, error:\n\t".Win32::Daemon::GetLastError().": ".Win32::F
+ormatMessage(Win32::Daemon::GetLastError());
    print "Service created\n";
}

sub callbackContinue
{
    my ($event, $Context)  = @_;
    print "Event $event: Continue ...\n";
    $Context->{last_state} = SERVICE_RUNNING;
    Win32::Daemon::State( SERVICE_RUNNING );
}

sub callbackPause
{
    my ($event, $Context)  = @_;
    print "Event $event: Pause ...\n";
    $Context->{last_state} = SERVICE_PAUSED;
    Win32::Daemon::State( SERVICE_PAUSED );
}

sub callbackRunning
{
    my ($event, $Context)  = @_;

    return Win32::Daemon::State() if SERVICE_PAUSED eq Win32::Daemon::
+State();

    if (SERVICE_RUNNING eq Win32::Daemon::State())
    {
        my ($ss, $mm, $hh, $dd, $nn, $yy) = gmtime;
        my $timestamp                     = sprintf("%04d%02d%02d %02d
+:%02d:%02d", $yy + 1900, $nn + 1, $dd, $hh, $mm, $ss);
        print "$timestamp: Running ...\n" if (time % 60);
    }
    Win32::Daemon::State();
}

sub callbackStart
{
    my ($event, $Context)  = @_;
    print "Event $event: Start ...\n";
    $Context->{last_state} = SERVICE_RUNNING;
    Win32::Daemon::State( SERVICE_RUNNING );
}

sub callbackStop
{
    my ($event, $Context)  = @_;
    print "Event $event: Stopped ...\n";
    $Context->{last_state} = SERVICE_STOPPED;
    Win32::Daemon::State( SERVICE_STOPPED );
    Win32::Daemon::StopService();
}

[download]

In reply to Running callback stops working in Win32::Daemon by SimonPratt

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.