I have set up a script to run as a service using Win32 Daemon. I use some skeleton code I found on perlmonks. The script runs fine, and will respond to the windows SCM without any problems, except one.
The one gotcha is that if the service is running the "RunService" sub and I attempt to stop it the service will hang while stopping. I added some debug statements to the StopService sub and it does not appear to run at all.
If I do a stop service between the time when the RunService sub is finished and the next callback it stops without any problem.
I have tried to add some code to cause the stop service sub to wait until running was over, but it does not do any good. The script in question is below: (I have added a sleep statement in RunService so I can test stopping it while I know it is in operation)
#!/usr/bin/perl
$| = 1;
use strict;
use Getopt::Long;
use Win32;
use Win32::Daemon;
push @INC, "\\\\lexccbld01\\bart\\Scripts\\SkyMod";
require SKYDatabase;
use Mail::Sendmail;
use Time::Local;
use XML::Simple;
my %InitData;
my $Thingy;
my %opt;
GetOptions (
\%opt,
"run",
"install",
"remove",
"start",
"stop",
"restart",
"pause",
"resume|continue",
);
my @currDir = split /\//, $0;
my $script = $0;
my $scriptPath = ".";
if (scalar @currDir > 1)
{
$script = pop @currDir;
$scriptPath = join "/", @currDir;
chdir( $scriptPath );
}
%InitData = &FindConfig(%InitData);
my $CallbackInt = $InitData{Config}->{Interval};
my %serviceConfig = (
name => 'Scheduler',
display => 'Scheduler',
description => 'This is a perl script which checks regularly for products scheduled to build.',
machine => '',
path => $^X,
parameters => ( sprintf '"E:/perltest/servicemon/ServiceSchedLoop.pl" --run',
$scriptPath,
$script ),
start_type => SERVICE_AUTO_START,
);
Win32::Daemon::RegisterCallbacks(
{
start => \&startService,
stop => \&stopService,
pause => \&pauseService,
continue => \&continueService,
running => \&runService,
}
);
# ==============================================================================
# main
# ==============================================================================
if( $opt { install } )
{
&installService();
exit();
}
elsif( $opt { remove } )
{
&removeService();
exit();
}
elsif( $opt { status } )
{
&serviceStatus();
exit();
}
elsif( $opt { run } )
{
my %context = {
last_state => SERVICE_STOPPED,
count => 0,
start_time => time(),
};
Win32::Daemon::StartService( \%context, $CallbackInt );
}
elsif( $opt { start } )
{
my $cmd = sprintf 'net start %s', $serviceConfig { name };
system( $cmd );
exit();
}
elsif( $opt { stop } )
{
my $cmd = sprintf 'net stop %s', $serviceConfig { name };
system( $cmd );
exit();
}
elsif( $opt { pause } )
{
my $cmd = sprintf 'net pause %s', $serviceConfig { name };
system( $cmd );
exit();
}
elsif( $opt { resume } )
{
my $cmd = sprintf 'net continue %s', $serviceConfig { name };
system( $cmd );
exit();
}
elsif( $opt { restart } )
{
my $cmd = sprintf 'net stop %s', $serviceConfig { name };
system( $cmd );
$cmd = sprintf 'net start %s', $serviceConfig { name };
system( $cmd );
exit();
}
else
{
die "Nothing to do\n";
}
# ==============================================================================
# SERVICE SETUP
# ==============================================================================
sub installService
{
# installs the win32 service daemon
# ---------------------------------
if( Win32::Daemon::CreateService( \%serviceConfig ) )
{
&debug( 'The service [%s] was successfully installed', $serviceConfig { display } );
}
else
{
&debug( 'Failed to install the service [%s]: %s',
$serviceConfig { display },
GetError() );
}
}
# ==============================================================================
sub removeService
{
# removes the win32 service daemon
# --------------------------------
if( Win32::Daemon::DeleteService( $serviceConfig { name } ) )
{
&debug( 'The service [%s] was successfully removed', $serviceConfig { display } );
}
else
{
&debug( 'Failed to remove the service [%s]: %s',
$serviceConfig { display },
GetError() );
}
}
# ==============================================================================
# CALLBACK ROUTINES
# ==============================================================================
sub startService
{
# start the win32 service daemon
# ------------------------------
my ($event, $context) = @_;
$context -> { last_state } = SERVICE_RUNNING;
Win32::Daemon::State( SERVICE_START_PENDING, 30000 );
&debug( 'Starting the service' );
# let's go
Win32::Daemon::State( SERVICE_RUNNING );
}
# ==============================================================================
sub stopService
{
# stop the win32 service daemon
# -----------------------------
my ($event, $context) = @_; my $WaitCount;
$context -> { last_state } = SERVICE_STOPPED;
Win32::Daemon::State( SERVICE_STOP_PENDING, 30000 );
$Thingy = $context -> { running_state };
&debug( "State in Stopping: $Thingy\n");
my $MyVal = $context -> { running_state };
&debug( "Current State $MyVal\n" );
while ($MyVal eq 'running' && $WaitCount < 20 ) {
sleep 1;
$WaitCount++;
$MyVal = $context -> { running_state };
&debug( "running state = $MyVal\n" );
}
&debug( 'Stopping the service' );
Win32::Daemon::State( SERVICE_STOPPED );
Win32::Daemon::StopService();
&debug( 'Service Stopped' );
}
# ==============================================================================
sub pauseService
{
# let the win32 service daemon make a pause
# -----------------------------------------
my ($event, $context) = @_;
&debug( 'Pausing the service' );
$context -> { last_state } = SERVICE_PAUSED;
Win32::Daemon::State( SERVICE_PAUSED );
}
# ==============================================================================
sub continueService
{
# let the win32 service daemon exit a pause
# -----------------------------------------
my ($event, $context) = @_;
&debug( 'Resuming the service' );
$context -> { last_state } = SERVICE_RUNNING;
Win32::Daemon::State( SERVICE_RUNNING );
}
# ==============================================================================
sub runService
{
# this is the callback of by the win32 service daemon
# ---------------------------------------------------
my ($event, $context) = @_;
my %Data; my ($CurrentTime, $Line, $Timer);
$context -> { running_state } = 'running';
#for $Line ( keys %$context ) {my $MyVal = $context -> { $Line }; &debug( "event $event and Context has keys $Line with values $MyVal\n", $serviceConfig { display } );}
if ( Win32::Daemon::State() == SERVICE_RUNNING )
{
$Data{Location}->{DSNCM2} = "Driver={SQL SERVER}; server=lexcpddb03\\scmtools; database=CMTransfer2; UID=buildprocess; PASS=;";
$Data{Location}->{DSNSkyDB} = "Driver={SQL SERVER}; server=lexcpddb03\\scmtools; database=SkyDB; UID=buildprocess; PASS=;";
$Data{Location}->{DSN} = $Data{Location}->{DSNCM2};
my $BigCount = $context -> { count };
$CurrentTime = localtime(time);
$Data{Arguments}->{Debug} = 1;
%Data = &FindConfig(%Data);
#%Data = &GetFutureList(%Data);
#%Data = &GetUnsignedOff(%Data);
#%Data = &DiffFutureUnsigned(%Data);
#%Data = &CheckProductForToday(%Data);
my $FindCommand = "perl FindBuilds.pl $Data{Time}->{Min} $Data{Time}->{Max}";
&debug( "Running : $FindCommand at $CurrentTime", $serviceConfig { display } );
my @FindOutput = $FindCommand;
&debug( "Valid builds \n @FindOutput", $serviceConfig { display } );
foreach (@FindOutput) {
#print "Line : $_\n";
if ($_ =~ /Product : (\S+)/) {
my $WriteCommand = "perl WriteJob.pl $1";
&debug( "Running : $WriteCommand\n", $serviceConfig { display } );
my @WriteOutput = $WriteCommand;
print "@WriteOutput";
}
}
#%Data = &Time(%Data);
#sleep $Data{Config}->{Interval};
chomp($Data{Config}->{Interval});
&debug( "Old timer : $Data{Config}->{Interval}\n", $serviceConfig { display } );
#my $CurrentTimer = Win32::Daemon::CallbackTimer( $Data{Config}->{Interval} );
#&debug( "Current timer : $CurrentTimer\n", $serviceConfig { display } );
#print "Continue : $Continue\n";
#$Data{BuildData}->{XMLFile} = 'Thingy.xml';
for ($Timer = 1; $Timer < 6; $Timer++) {sleep 1; &debug( "$Timer\n");}
$context -> { running_state } = 'complete';
$Thingy = $context -> { running_state };
&debug( "State in Running: $Thingy\n");
}
}
sub debug
{
my ($fmt, @data) = @_;
my $message = sprintf $fmt, @data;
open( FILE, ">>E:/perltest/servicemon/ServiceSchedLoop.log" );
print FILE "$message\n";
close( FILE );
if (-t STDOUT && -t STDIN)
{
print "$message\n";
}
}
# ==============================================================================
sub GetError
{
# returns win32 daemon errors
# ---------------------------
return( Win32::FormatMessage( Win32::Daemon::GetLastError() ) );
}
# ==============================================================================
sub FindConfig {
undef my %Data;
%Data = @_;
my ($Line);
my $ConfigReadCommand = "type $scriptPath\\Sched.cfg";
s/\//\\/g for $ConfigReadCommand;
#&debug( "Finding Config : $ConfigReadCommand", $serviceConfig { display } );
$Data{Config}->{Interval} = 15;
my @ConfigInfo;
if (-e 'Sched.cfg') {@ConfigInfo = $ConfigReadCommand;}
else {
&debug( "Config not found at $scriptPath\\Sched.cfg, stopping.", $serviceConfig { display } );
my $cmd = sprintf 'net stop %s', $serviceConfig { name };
system( $cmd );
exit();
}
#&debug( "Config info : @ConfigInfo \n", $serviceConfig { display } );
foreach $Line (@ConfigInfo) {
$Line = lc($Line);
chomp($Line);
print "$Line\n";
#if ($Line =~ /loop status = (\S+)/) {$Continue = $1; print "Found Status : $Continue\n";}
if ($Line =~ /loop interval = (\S+)/) {
$Data{Config}->{Interval} = $1;
#&debug( "Interval : $Interval\n", $serviceConfig { display } );
}
if ($Line =~ /look ahead time = (\d+):(\d+)/) {$Data{Time}->{Min} = $1; $Data{Time}->{Max} = $2; &debug( "Look ahead Time Min : $Data{Time}->{Min}\n Time Max : $Data{Time}->{Max}\n", $serviceConfig { display } );}
if ($Line =~ /look ahead time = -(\d+):(\d+)/) {$Data{Time}->{Min} = $1 * (-1); $Data{Time}->{Max} = $2; print "Look ahead Time Min : $Data{Time}->{Min}\n Time Max : $Data{Time}->{Max}\n";}
}
return(%Data);
}
__END__