Hi,
Here is a patch against the SVN head.
Changes:
- fixes incompatibility with fork() : END {} block executed only in the main
thread.
- fixes white spaces in POD
- changes to go towards 'strict' mode
Olivier Mengué
[email protected]
Index: Daemon.pm
===================================================================
--- Daemon.pm (revision 485)
+++ Daemon.pm (working copy)
@@ -3,12 +3,14 @@
#// Daemon.pm
#// Win32::Daemon Perl extension package file
#//
-#// Copyright (c) 1998-2002 Dave Roth
+#// Copyright (c) 1998-2008 Dave Roth
#// Courtesy of Roth Consulting
#// http://www.roth.net/
#//
-#// This file may be copied or modified only under the terms of either
-#// the Artistic License or the GNU General Public License, which may
+#// Copyright (c) 2009 Olivier Mengue
+#//
+#// This file may be copied or modified only under the terms of either
+#// the Artistic License or the GNU General Public License, which may
#// be found in the Perl 5.0 source kit.
#//
#// 2008.03.24 :Date
@@ -17,21 +19,25 @@
package Win32::Daemon;
-$PACKAGE = $Package = "Win32::Daemon";
-$VERSION = 20080324;
+#use strict;
+#use warnings;
+our $PACKAGE = $Package = "Win32::Daemon";
+
+our $VERSION = 20080324;
require Exporter;
require DynaLoader;
+use vars qw( $AUTOLOAD );
my @OSVerInfo = Win32::GetOSVersion();
my $OSVersion = "$OSVerInfo[1].$OSVerInfo[2]";
my $RECOGNIZED_CONTROLS;
-...@isa= qw( Exporter DynaLoader );
+our @ISA= qw( Exporter DynaLoader );
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
-...@export = qw(
+our @EXPORT = qw(
SERVICE_CONTROL_USER_DEFINED
SERVICE_NOT_READY
@@ -60,7 +66,7 @@
SERVICE_CONTROL_SESSIONCHANGE
SERVICE_CONTROL_USER_DEFINED
SERVICE_CONTROL_RUNNING
- SERVICE_CONTROL_PRESHUTDOWN
+ SERVICE_CONTROL_PRESHUTDOWN
SERVICE_CONTROL_TIMER
SERVICE_CONTROL_START
@@ -82,8 +88,8 @@
SERVICE_ACCEPT_STOP
SERVICE_ACCEPT_PAUSE_CONTINUE
- SERVICE_ACCEPT_SHUTDOWN
- SERVICE_ACCEPT_PARAMCHANGE
+ SERVICE_ACCEPT_SHUTDOWN
+ SERVICE_ACCEPT_PARAMCHANGE
SERVICE_ACCEPT_NETBINDCHANGE
SERVICE_WIN32_OWN_PROCESS
@@ -109,12 +115,11 @@
);
-...@export_ok = qw(
-);
+our @EXPORT_OK = ();
-bootstrap $Package;
+bootstrap(__PACKAGE__);
-sub AUTOLOAD
+sub AUTOLOAD
{
# This AUTOLOAD is used to 'autoload' constants from the constant()
# XS function. If a constant is not found then control is passed
@@ -138,9 +143,8 @@
# $Result == 1 if the constant is valid but not defined
# that is, the extension knows that the constant exists but for
# some wild reason it was not compiled with it.
- $pack = 0;
- ($pack,$file,$line) = caller;
- print "Your vendor has not defined $Package macro $constname, used in
$file at line $line.";
+ my ($pack,$file,$line) = caller;
+ print "Your vendor has not defined ".__PACKAGE__." macro $Constant,
used in $file at line $line.";
}
elsif( 2 == $Result )
{
@@ -160,7 +164,8 @@
END
{
- Win32::Daemon::StopService();
+ # Stop the service only if we are in the main thread (not in a forked
process)
+ Win32::Daemon::StopService() if $$ > 0;
}
__END__
@@ -237,7 +242,7 @@
This function queries (and optionally sets) the current list of controls that
the service registers for.
By registering for a control the script is notifying the SCM that it is
accepting the specified
control messages. For example, if you specify the
C<SERVICE_ACCEPT_PAUSE_CONTINUE> control then
-the SCM knows that the script will accept and process any attempt to pause and
continue (resume
+the SCM knows that the script will accept and process any attempt to pause and
continue (resume
from paused state) the service.
Recognized accepted controls:
@@ -250,13 +255,13 @@
Following controls are only recognized on Windows 2000 and higher:
- SERVICE_ACCEPT_PARAMCHANGE........The service accepts messages notifying
it of any
+ SERVICE_ACCEPT_PARAMCHANGE........The service accepts messages notifying
it of any
parameter change made to the service.
- SERVICE_ACCEPT_NETBINDCHANGE......The service accepts messages notifying
it of any
+ SERVICE_ACCEPT_NETBINDCHANGE......The service accepts messages notifying
it of any
network binding changes.
By default all of these controls are accepted. To change this pass in a value
consisting of
-any of these values OR'ed together.
+any of these values OR'ed together.
B<NOTE> that you can query and set these controls at any time. However it is
only supported to
set them before you start the service (calling the C<StartService()> function).
@@ -268,8 +273,8 @@
that the calling of this routine will be blocked by any other callback.
If you pass in a value it will reset the timer to the specified frequency.
Passing in
-a 0 will disable all "Running" callbacks. Passing in -1 will toggle the state
between
-calling the "Running" callback subroutine and not calling it.
+a 0 will disable all "Running" callbacks. Passing in -1 will toggle the state
between
+calling the "Running" callback subroutine and not calling it.
=item CreateService ( \%Hash )
@@ -291,12 +296,12 @@
The 'display' service name; that is, the name displayed
by the services control panel or MMC plugin.
-=item path
+=item path
The full path name to the executable. This should be the path to your Perl
executable, which will normally be the contents of $^X.
-B<NOTE:> If you are using a compiled perl script (such as one
+B<NOTE:> If you are using a compiled perl script (such as one
generated with PerlApp) as opposed to a text based perl script file then this
value must point to the actual compiled script's executable (eg.
MyCompiledPerlService.exe)
instead of ($^X which usually points to perl.exe). You can specify
@@ -386,7 +391,7 @@
=item GetSecurity( $Machine, $ServiceName )
This will return a binary Security Descriptor (SD) that is associated with the
-specified service on the specified machine.
+specified service on the specified machine.
The SD is in self-relative format. It can be imported into a Win32::Perms
object using
the Win32::Perms object's Import() method.
@@ -399,7 +404,7 @@
service. Not all events must have callbacks registered.
If only a reference to a subroutine is passed in then it will be called for
each and every
-event. You can pass in a hash containing particular key names (listed below)
with
+event. You can pass in a hash containing particular key names (listed below)
with
code references.
Possible hash key names:
@@ -424,7 +429,7 @@
power_event..............A power event has occured (eg change to battery
power).
session_change...........There has been a change in session.
user_defined.............A user defined event has been sent to the service.
-
+
NOTE: The 'Stop' state. When a service calls into the registered "stop"
callback routine
the script should call the C<StopService()> function. This tells the service
to terminate
and return back to the Perl script. This is the only way for the service to
know that it
@@ -433,7 +438,7 @@
Note: The 'Running' state. Periodically the extension will call into a
registered
"Running" subroutine. This allows the script to process data. This routine
should be fast
and return quickly otherwise it will block other callback events from being
run. The
-frequency of calling the "Running" subroutine is dictated by the callback
timer value
+frequency of calling the "Running" subroutine is dictated by the callback
timer value
passed into C<StartService()> and any changes made to this value by calling
into
C<CallbackTimer()>.
@@ -463,7 +468,7 @@
=item Callback Mode
If the script has already registered callback routines (using
C<RegisterCallbacks()>) then
-the call into C<StartService()> will not return until the service has stopped.
However
+the call into C<StartService()> will not return until the service has stopped.
However
callbacks will be made for each state change and callback timer timeout (refer
to C<RegisterCallbacks()>).
=back
@@ -484,7 +489,7 @@
Pass in a non zero value to reset the pending message to
C<SERVICE_CONTROL_NONE>. This way
your script can tell when two of the same messages come in.
-Occasionally the service manager will send messages to the service. These
messages
+Occasionally the service manager will send messages to the service. These
messages
typically request the service to change from one state to another. It is
important that
the Perl script responds to each message otherwise the service manager becomes
confused
about the current state of the service. For example, if the service manager is
submits
@@ -502,11 +507,11 @@
This results in State() reporting
SERVICE_STOP_PENDING.
SERVICE_CONTROL_PAUSE.............The SCM is requesting the service to
pause.
This results in State() reporting
SERVICE_PAUSE_PENDING.
- SERVICE_CONTROL_CONTINUE..........The SCM is requesting the service to
continue from a
+ SERVICE_CONTROL_CONTINUE..........The SCM is requesting the service to
continue from a
paused state.
This results in State() reporting
SERVICE_CONTINUE_PENDING.
SERVICE_CONTROL_INTERROGATE.......The service manager is querying the
service's state
-
+
SERVICE_CONTROL_USER_DEFINED......This is a user defined control. There
are 127 of these
beginning with
SERVICE_CONTROL_USER_DEFINED as the base.
Windows 2000 specific messages:
@@ -524,7 +529,7 @@
SERVICE_CONTROL_HARDWAREPROFILECHANGE..A change has been made to the
system's hardware profile.
SERVICE_CONTROL_POWEREVENT........A power event has occured (eg change to
battery power).
SERVICE_CONTROL_SESSIONCHANGE.....There has been a change in session.
-
+
Windows Vista + specific messages:
SERVICE_CONTROL_PRESHUTDOWN ......The machine is about to shut down. This
provides the service
much more time to shutdown than
SERVICE_CONTROL_SHUTDOWN.
@@ -534,8 +539,8 @@
B<Note:> When the system shuts down it will send a C<SERVICE_CONTROL_SHUTDOWN>
message. The
Perl script has approximately 20 seconds to perform any shutdown activities
before the
Control Manger stops the service. If more time is needed call the C<State()>
function
-passing in the C<SERVICE_STOP_PENDING> control message along with how many
seconds it will
-take to shutdown the service. This time value is only an estimate. When the
service is
+passing in the C<SERVICE_STOP_PENDING> control message along with how many
seconds it will
+take to shutdown the service. This time value is only an estimate. When the
service is
finally ready to stop it must submit the C<SERVICE_STOPPED> message as in:
if( SERVICE_CONTROL_SHUTDOWN == State() )
@@ -558,7 +563,7 @@
for 30 seconds for the script to change the service's state before deciding
that the
script is non responsive.
-If you are setting/updating the state instead of passing in the state and wait
hint you could
+If you are setting/updating the state instead of passing in the state and wait
hint you could
pass in a hash reference. This allows you to specify the state, wait hint and
error state. You
can use the following keys:
@@ -566,7 +571,7 @@
--------
state..........Valid service state (see table below).
waithint.......A wait hint explained above. This is in milliseconds.
- error..........Any 32 bit error code. This is what will be reported if an
application
+ error..........Any 32 bit error code. This is what will be reported if an
application
queries the error state of the service. It is also what is
reported if
a call to start the services fails.
To reset an error state pass in NO_ERROR.
@@ -585,7 +590,7 @@
---------------------
SERVICE_NOT_READY..........The SCM has not yet been initialized. If the
SCM is slow or busy
then this value will result from a call to
State().
- If you get this value, just keep calling
State() until you get
+ If you get this value, just keep calling
State() until you get
SERVICE_START_PENDING.
SERVICE_STOPPED............The service is stopped
SERVICE_RUNNING............The service is running
@@ -601,15 +606,15 @@
Callbacks were introduced in version v20030617.
-The Win32::Daemon supports the concept of event callbacks. This allows a
script to
+The Win32::Daemon supports the concept of event callbacks. This allows a
script to
register a particular subroutine with a particular event. When the event
occurs it
will call the Perl subroutine registered with that event. This can make it
very simple
to write scripts.
You register a callback subroutine by calling into the C<RegisterCallbacks()>
function.
You can pass in a code reference or a hash. A code reference will register the
specified
-subroutine with all events. A hash allows you to pick which events you want to
-register for which subroutines. You do not have to register all events. If an
event is
+subroutine with all events. A hash allows you to pick which events you want to
+register for which subroutines. You do not have to register all events. If an
event is
not registered for a subroutine then the script will not be notified when the
event
occurs.
@@ -623,14 +628,14 @@
that it is offically paused.
Once callback subroutines are registered the script enters the service mode by
calling
-C<StartService()>. This will being the process of calling the event callback
routines.
-Note that when callback routines are registered the C<StartService()> function
will not
+C<StartService()>. This will being the process of calling the event callback
routines.
+Note that when callback routines are registered the C<StartService()> function
will not
return until a callback routine calls C<StopService()> (typically the 'Stop'
event callback
would call C<StopService()>.
When calling into C<StartService()> you can pass in a hash reference. This
reference is known as
a "context" hash. For every callback the hash will be passed into the callback
routine. This enables
-a script to query and set data in the hash--essentially letting you pass
information across to
+a script to query and set data in the hash--essentially letting you pass
information across to
different callback events. This context hash is not required.
When a callback is made it always passes two parameters in: $State and
$Context. $State is simply
@@ -644,9 +649,9 @@
{
my( $Event, $Context ) = @_;
$Context->{last_event} = $Event;
-
+
# ...do some work here...
-
+
# Tell the service manager that we have now
# entered the running state.
Win32::Daemon::State( SERVICE_RUNNING );
@@ -659,31 +664,31 @@
=head1 Compiled Perl Applications
Many users like to compile their perl scripts into executable programs. This
way it is much easier to copy them around
-from machine to machine since all necessary files, packages and binaries are
compiled into one .exe file. These compiled
+from machine to machine since all necessary files, packages and binaries are
compiled into one .exe file. These compiled
perl scripts are compatible with Win32::Deamon as long as you install it
correctly.
-If you are going to compile your Win32::Daemon based perl script into an .exe
there is nothing unique you need to do
+If you are going to compile your Win32::Daemon based perl script into an .exe
there is nothing unique you need to do
to your Win32::Daemon code with one single exception of the call into
Win32::Daemon::C<CreateService()>. When passing in
the 'path' and 'parameters' values into C<CreateService()> observe the
following simple rules:
=over 4
1) If using a Perl script
- path........The full path to the Perl interpeter (perl.exe).
+ path........The full path to the Perl interpeter (perl.exe).
This is typically:
c:\perl\bin\perl.exe
-
- parameter...This value MUST start with the full path to the
+
+ parameter...This value MUST start with the full path to the
perl script file and append any parameters
that you want passed into the service. For
example:
c:\scripts\myPerlService.pl -param1 -param2 "c:\\Param2Path"
2) If using a compiled Perl application
- path........The full path to the compiled Perl application.
+ path........The full path to the compiled Perl application.
For example:
c:\compiledscripts\myPerlService.exe
-
+
parameter...This value is just the list of parameters
that you want passed into the service. For
example:
@@ -768,7 +773,7 @@
{
# The service is running as normal...
# ...add the main code here...
-
+
}
else
{
@@ -806,17 +811,17 @@
=head2 Example 3: Install the service
-For the 'path' key the $^X equates to the full path of the
+For the 'path' key the $^X equates to the full path of the
perl executable.
Since no user is specified it defaults to the LocalSystem.
- use Win32::Daemon;
- # If using a compiled perl script (eg. myPerlService.exe) then
+ use Win32::Daemon;
+ # If using a compiled perl script (eg. myPerlService.exe) then
# $ServicePath must be the path to the .exe as in:
# $ServicePath = 'c:\CompiledPerlScripts\myPerlService.exe';
# Otherwise it must point to the Perl interpreter (perl.exe) which
# is conviently provided by the $^X variable...
- my $ServicePath = $^X;
+ my $ServicePath = $^X;
# If using a compiled perl script then $ServiceParams
# must be the parameters to pass into your Perl service as in:
@@ -878,7 +883,7 @@
# ... note that here there is no need to
# change the state
- }
+ }
elsif( SERVICE_START_PENDING == $Event )
{
# Initialization code
@@ -951,7 +956,7 @@
# ... note that here there is no need to
# change the state
}
- }
+ }
sub Callback_Start
{
@@ -1020,6 +1025,13 @@
=head1 HISTORY:
+ - 20091028 Olivier Mengue
+ -Disabled END {} in non-main threads to fix bug RT#50020
+ -Changes to go to 'strict' mode.
+ -Fixed white spaces in POD.
+
+ - 20080321 rothd
+
- 20011205 rothd
-Fixed bug where "invalid service state 80" is reported in the Win32
event log.
-Added initial support for SCM request callbacks (this is not
implemented fully and
@@ -1038,11 +1050,11 @@
SERVICE_ACCEPT_SESSIONCHANGE
- 20011221 [email protected]
- - Fixed bug where service doesn't work properly with Windows NT 4. We
were
- defaulting by acccepting the SERVICE_ACCEPT_PARAMCHANGE and
- SERVICE_ACCEPT_NETBINDCHANGE controls. However, they were introduced
in
+ - Fixed bug where service doesn't work properly with Windows NT 4. We
were
+ defaulting by acccepting the SERVICE_ACCEPT_PARAMCHANGE and
+ SERVICE_ACCEPT_NETBINDCHANGE controls. However, they were introduced
in
Win2k so NT 4 coughed up blood with them.
-
+
- 20020108 [email protected]
- Fixed another bug wwhere servie wouldn't work on Win2k machines. We
were treating Win2k (version 5.0) the same as WinXP (version 5.1) and
@@ -1050,15 +1062,15 @@
start, pause or stop. Fix was only in the Daemon.pm file.
- 20020114 [email protected]
- - Fixed another bug where service wouldn't work on WinXP machines.
Variable
- recognized_controls was wrongly initialized for WinXP systems. This
- rendered the service unable to start, pause or stop. Fix was only in
+ - Fixed another bug where service wouldn't work on WinXP machines.
Variable
+ recognized_controls was wrongly initialized for WinXP systems. This
+ rendered the service unable to start, pause or stop. Fix was only in
the Daemon.pm file.
- 20020605 [email protected]
- Added support for reporting service errors. You can now pass in a
hash reference into State(). More details in the POD docs.
-
+
- 20030617 [email protected]
- Added support for querying and setting service security. This
includes
DACL and SACL support. Due to complexity and failures you can not set
@@ -1067,7 +1079,7 @@
- SetSecurity()
- Finished incorporating callback routines.
- Added a few more events.
-
+
- 20080321 [email protected]
-Callbacks can now return a state value. This is the functional
equivilent of calling
Win32::Daemon::State( $NewState ) before returning:
@@ -1089,11 +1101,8 @@
-Callback timer works correctly!
-CALLBACK_RUNNING has been depreciated and replaced with
CALLBACK_TIMER. It is only called
when the timer (set by CallbackTimer()) has expired. Use this as a
heartbeat. You only need
- to set it once either with CallbackTimer() or passing in the timer
value when calling into
+ to set it once either with CallbackTimer() or passing in the timer
value when calling into
StartService().
Set the callback using "timer" as the callback name. Using "running"
will also work but it
is mapped to "timer". If you specify both, only "timer" will be
registered.
-
-
-
\ No newline at end of file
===================================================================
