Hi,
these past days I looked at possibilities of making the integration
daemon run as a genuine windows service. Today I got it working, so I'd
like to contribute the proof-of-concept here. The attached script
contains both the service-code and functions to install and remove the
service.
To make the service work, a few lines need to be commented out in Daemon.pm:
Comment out in spawn_connection_thread:
thread_connection->join();
Comment out in daemonize:
defined (my $pid = fork) or log_fatal_error ( $DAEMON_ERROR_FORK_ERROR,
"Can't fork: $!\n" );
exit if $pid;
The first change is needed so that a call to the start-service callback
returns. The other change avoids the service from being shutdown
prematurely; the exit() causes the entire service to be shut down (not
good).
To use:
- Install Win32-Daemon and Win32-EventLog-Message.
Both can be found and installed from Dave Roth's site. To install for
Activeperl 5.8:
ppm install http://www.roth.net/perl/packages/win32-daemon.ppd
ppm install http://www.roth.net/perl/packages/win32-eventlog-message.ppd
- Make the required changes to Daemon.pm
- Put the script somewhere reasonable,
for example in C:\Program Files\Scmbug\sbin\
- To install the service, run from the command line:
scmbug_service.pl --install --config <location of daemon.conf>
- The service starts automatically during startup, or you can run
'net start scmbugsvc' from the command line or alternatively run
services.msc for the MMC application
- To remove the service, first stop the service using
'net stop scmbugsvc' (or through services.msc). Next run from the
command line:
scmbug_service.pl --remove
That's it!
Kind regards,
Roger Karis
#!/usr/bin/perl
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
# Scmbug daemon service. Processes integration requests from an
# SCM tool with bugtracking
use strict;
use Win32;
use Win32::Daemon;
use Win32::EventLog::Message;
use Getopt::Long;
use lib "C:/Program Files/Scmbug/share/scmbug/lib";
use Scmbug::Daemon::Daemon;
Win32::Daemon::RegisterCallbacks( {
start => \&Callback_Start,
running => \&Callback_Running,
stop => \&Callback_Stop,
pause => \&Callback_Pause,
continue => \&Callback_Continue
} );
my $svcinfo = {
name => 'scmbugsvc',
display => 'Scmbug Service'
};
sub Callback_Start {
EventLog("$svcinfo->{display} starting");
my( $Event, $Context ) = @_;
my (@arguments) = ($Context->{config});
my $daemon = Scmbug::Daemon::Daemon->new();
$daemon->start_daemon( @arguments );
Win32::Daemon::State( SERVICE_RUNNING );
}
sub Callback_Running {
if( SERVICE_RUNNING == Win32::Daemon::State() )
{
# do nothing (periodically)
}
}
sub Callback_Stop {
EventLog("$svcinfo->{display} stopping");
Win32::Daemon::State( SERVICE_STOPPED );
Win32::Daemon::StopService();
}
sub Callback_Pause {
EventLog("$svcinfo->{display} does not support pausing");
Win32::Daemon::State( SERVICE_RUNNING );
}
sub Callback_Continue {
EventLog("$svcinfo->{display} does not support resuming");
Win32::Daemon::State( SERVICE_RUNNING );
}
sub EventLog {
my ($msg) = @_;
my $EventLog = Win32::EventLog->new( 'Application' );
$EventLog->Report({
Source => $svcinfo->{display},
EventType => Win32::EventLog::EVENTLOG_INFORMATION_TYPE(),
Category => 0,
EventID => 0,
Strings => $msg,
Data => ""
});
}
sub GetError {
return( Win32::FormatMessage( Win32::Daemon::GetLastError() ) );
}
sub InstallService {
my $daemonconfig = shift;
my $parameters = '"'.join( '', Win32::GetFullPathName( $0 ) ).'"'."
--config \"$daemonconfig\"";
my $serviceconfig = {
name => $svcinfo->{name},
display => $svcinfo->{display},
path => $^X,
parameters => $parameters,
user => '',
pwd => '',
machine => '',
description => "Service which runs the Scmbug integration daemon",
service_type => SERVICE_WIN32_OWN_PROCESS | SERVICE_INTERACTIVE_PROCESS
};
Win32::EventLog::Message::RegisterSource( 'Application',
$serviceconfig->{display});
if ( Win32::Daemon::CreateService( $serviceconfig ) ) {
print "The $svcinfo->{display} was successfully installed.\n";
} else {
print "Failed to add the $svcinfo->{display} service.\nError: " .
GetError;
}
}
sub RemoveService {
if( Win32::Daemon::DeleteService( $svcinfo->{name} ) ) {
print "The $svcinfo->{display} was successfully removed.\n";
} else {
print "Failed to remove the $svcinfo->{display} service.\nError: " .
GetError;
}
Win32::EventLog::Message::UnRegisterSource( 'Application',
$svcinfo->{display});
}
my %cmdopts = {};
my $result = GetOptions(\%cmdopts, "install|i", "remove|r", "config=s");
if ($cmdopts{install}) {
if ($cmdopts{config}) {
InstallService($cmdopts{config});
} else {
print "Missing configuration file\n";
}
exit 0;
} elsif ($cmdopts{remove}) {
RemoveService();
exit 0;
}
my $initcontext = {
config => $cmdopts{config}
};
my $service = Win32::Daemon::StartService($initcontext);_______________________________________________
scmbug-users mailing list
[email protected]
http://lists.mkgnu.net/cgi-bin/mailman/listinfo/scmbug-users
