Arden,
Thanks for the reply. Here is my startup code:
sub Startup {
report("Info: $Config{ServiceName} Starting");
Initialize();
while (ContinueRun()) {
# EVENT LOOP
if ($shared_memory_server) {
# Maintain Worker Threads
$shared_memory_server->service_worker_procs();
# Service Unique Id Requests
$shared_memory_server->service_unique_id_requests();
# Reap Old Results Out Of The System
if (sleptfor("reap_old_results",10)) {
$shared_memory_server->reap_old_results();
}
if (sleptfor("reload_config",60)) {
if ((-M "$base_dir\\Mail_Daemon.conf") < $config_file_
+modify_info) {
$config_file_modify_info = (-M "$base_dir\\Mail_Da
+emon.conf");
report("Info: $Config{ServiceName} Configuration U
+pdated ... Reloading");
$shared_memory_server->reload_configuration();
}
}
if (sleptfor("read_status",5)) {
if ($shared_memory_server->read_directive() eq "DIE")
+{
$shared_memory_server->set_directive("DIE_PROCS");
# Need To Wait For All Processes To Die Before Dyi
+ng Myself
report("Info: $Config{ServiceName} Killing Myself
+... Waiting For Workers To Die");
$proc_kill_timeout = time + 30;
while (not $shared_memory_server->no_workers_left(
+)) {
# Put check in here ... if the procs are not d
+ead with 30 seconds
# kill forcefully
Win32::Sleep(500);
if (time > $proc_kill_timeout) {
report("Info: $Config{ServiceName} Process
+es Hung ... Hard Killing Processes");
$shared_memory_server->DESTROY(-1);
}
}
report("Info: $Config{ServiceName} All Processes D
+ead. Exiting");
exit;
}
}
Win32::Sleep(100);
}
}
# Report how long the service is going to take to close
PerlSvc::ReportStatus(PerlSvc::SERVICE_STOP_PENDING(), 35);
report("Info: $Config{ServiceName} Stop Request Granted ... Waitin
+g For Workers To Die");
$shared_memory_server->set_directive("DIE_PROCS");
$proc_kill_timeout = time + 30;
while (not $shared_memory_server->no_workers_left()) {
# Put check in here ... if the procs are not dead with 30 seco
+nds
# kill forcefully
Win32::Sleep(500);
if (time > $proc_kill_timeout) {
report("Info: $Config{ServiceName} Processes Hung ... Hard
+ Killing Processes.");
$shared_memory_server->DESTROY(-1);
}
}
report("Info: $Config{ServiceName} Stopping");
exit;
}
Basically, my service launches a bunch of subprocesses that communicate via a shared memory dll I wrote. When the ContinueRun function returns false my the DIE_PROCS communication tells those processes to die. They do die successfully. The server even dies (I see the $Config{ServiceName} Stopping message in the event logs. When it dies however I get the error. I thought the PerlSvc::ReportStatus command told the service manager how long to expect to wait for the service to end.
I am using version 5.6.1 of Perl and the newest version of the PDK. I have tried this in Windows 2000 and XP with the same result. I have run it in interactive and non-interactive mode with the same result. It takes about 10 seconds to stop the service.
Best Regards
Mike |