Perl script as windows service

rockets12345 has asked for the wisdom of the Perl Monks concerning the following question:

I am beginner in perl. Following is the sample script from http://www.roth.net/perl/Daemon that I am trying to play with. I am trying to register this script as a windows service that should run every 5 seconds. I executed the the script on the commandline and it did creat a service under windows services. When I exit the command window the service doesn't run and the task I am trying to achieve is not being done. If I go and manully try to start this service under windows services I get the following error:
Error 1053: The service did not respond to the start or control request in a timely fashion
How should I make it run every five seconds as a windows service. Any help is really appreciated.

use strict;
use vars qw( %Config );
use Time::Local;
use Getopt::Long;
use Win32::Daemon;
use Win32::OLE qw( in );

%Config = (
  machine  => Win32::NodeName(),
  logfile  => "c:\\temp1\\Noname1.txt",   #( Win32::GetFullPathName( $
+0 ) =~ /^(.*)\.[^.]*$/ )[0] . ".log",
  service_name => "TESTSERVICE",
  service_alias  => "SERVALIAS",
  #user  =>  "test",
  #password  =>  "test1",
  # How much time do we sleep between polling the service state?
  # This is in milliseconds
  service_sleep_time  =>  100,
  # How often do we query the list of processes to determine if 
  # there is one to kill?
  # This is in seconds
  update_proc_list_time => 5
);
# Try to open the log file
if( open( LOG, ">>$Config{logfile}" ) )
{
  # Select the LOG filehandle...
  my $BackupHandle = select( LOG );
  # ...then turn on autoflush (no buffering)...
  $| = 1;
  # ...then restore the previous selected I/O handle
  select( $BackupHandle );
  Log( "Starting the $Config{service_name} service." );
  Log( "PID: $$" );
  Log( "Machine: " . Win32::NodeName() );
  Log( "Task: Monitoring processes on machine $Config{machine}" );
}

RemoveService();
InstallService();

sub InstallService
{
  my $ServiceConfig = GetServiceConfig();
  if( Win32::Daemon::CreateService( $ServiceConfig ) )
  {
    Log( "Linking to WMI..." );
    print "The $ServiceConfig->{display} was successfully installed.\n
+";
    # Okay, go ahead and process stuff...
    while(1) 
    {
       # delete all *.tmp files at c:\temp
       unlink( glob( "c:\\temp1\\*.txt" ) ); 
       #keep_alive();
       sleep(5); # and wait
       #last unless keep_alive();
       Log("PRINTING");
    }
  }
  else
  {
    print "Failed to add the $ServiceConfig->{display} service.\nError
+: " . GetError() . "\n";
  }
}

sub Log
{
  my( $Message ) = @_;
  print LOG "[" . localtime() . "] $Message\n" if( fileno( LOG ) );
}

sub GetServiceConfig
{
  my $ScriptPath = join( "", Win32::GetFullPathName( $0 ) );
  my %Hash = (
      name    => $Config{service_name},
      display => $Config{service_alias},
      path    => $^X,
      #user    => $Config{user},
      #pwd     => $Config{password},
      description => "Monitors processes and kills them after a config
+ured time.",
      parameters => "\"$ScriptPath\" -l \"$Config{logfile}\" -n \"$Con
+fig{service_name}\" -m $Config{machine}"
  );
  # Make sure that the display name is unique...
  $Hash{display} .= " ($Hash{name})";
  return( \%Hash );
}

sub GetError
{
  return( Win32::FormatMessage( Win32::Daemon::GetLastError() ) );
}

sub RemoveService
{
  my $ServiceConfig = GetServiceConfig();
  if( Win32::Daemon::DeleteService( $ServiceConfig->{name} ) )
  {
    print "The $ServiceConfig->{display} was successfully removed.\n";
  }
  else
  {
    print "Failed to remove the $ServiceConfig->{display} service.\nEr
+ror: " . GetError() . "\n";
  }
}

sub keep_alive {
   my $Message = Win32::Daemon::QueryLastMessage( 1 );
   Log($Message);
}
[download]

2005-03-02 Janitored by Arunbear - added readmore tags, as per Monastery guidelines

janitored by ybiC: Remove extraneous trailing "HELP NEEDED!" from node title

Comment on Perl script as windows service Download Code

Replies are listed 'Best First'.
Re: Perl script as windows service by holli (Abbot) on Mar 02, 2005 at 05:32 UTC
When I exit the command window the service doesn't run... That is the problem. The service will only be available as long as your script runs. If you want to make the command window disappear, check out Hiding the DOS window. holli, /regexed monk/	[reply]
Re: Perl script as windows service by rupesh (Hermit) on Mar 02, 2005 at 08:42 UTC
Use SRVANY and INSTSRV. Both are MS Windows' Resource Kit tools. They are simple and easy to implement, and they get the job done. Just my 2 cents... Cheers, Rupesh.	[reply]
Re: Perl script as windows service by m-rau (Scribe) on Mar 02, 2005 at 08:48 UTC
I do not think you need to remove the DOS box. This is not the issue. You use your script to install the service, I understand. You start the service within the win32 SERVICES dialog. I think. Problem is, that your script actually has neither a start hook nor a run hook! Initialize the daemon with something like `Win32::Daemon::RegisterCallbacks( { start => \&startService, stop => \&stopService, pause => \&pauseService, continue => \&continueService, running => \&runService, } );` [download] Next, define some callbacks. sub startService { # start the win32 service daemon # ------------------------------ my ($event, $context) = @_; $context -> { last_state } = SERVICE_RUNNING; Win32::Daemon::State( SERVICE_START_PENDING, 30000 ); # do what need to be done # exit Win32::Daemon::State( SERVICE_RUNNING ); } # ==================================================================== +========== sub stopService { # stop the win32 service daemon # ----------------------------- my ($event, $context) = @_; $context -> { last_state } = SERVICE_STOPPED; Win32::Daemon::State( SERVICE_STOP_PENDING, 30000 ); # do what needs to be done # exit Win32::Daemon::State( SERVICE_STOPPED ); Win32::Daemon::StopService(); } # ==================================================================== +========== sub pauseService { # let the win32 service daemon make a pause # ----------------------------------------- my ($event, $context) = @_; $context -> { last_state } = SERVICE_PAUSED; # do what needs to be done # exit Win32::Daemon::State( SERVICE_PAUSED ); } # ==================================================================== +========== sub continueService { # let the win32 service daemon exit a pause # ----------------------------------------- my ($event, $context) = @_; $context -> { last_state } = SERVICE_RUNNING; # do what needs to be done # exit Win32::Daemon::State( SERVICE_RUNNING ); } # ==================================================================== +========== sub runService { # this is the callback of by the win32 service daemon # --------------------------------------------------- my ($event, $context) = @_; if ( Win32::Daemon::State() == SERVICE_RUNNING ) { # count the number of calls (I do not know why) $context -> { count }++; } } [download] Regarding your error message I add the following comment. Your service did not respond to the start method, because there is none. If there is a start method, you need to be careful to inform the win32 service manager, how long your startup will take. See this `Win32::Daemon::State( SERVICE_STOP_PENDING, 30000 );` statement.	[reply] [d/l] [select]
Re^2: Perl script as windows service by holli (Abbot) on Mar 02, 2005 at 08:54 UTC
I did not really dig into the code, but isn´t `while(1) { # delete all .tmp files at c:\temp unlink( glob( "c:\\temp1\\.txt" ) ); #keep_alive(); sleep(5); # and wait #last unless keep_alive(); Log("PRINTING"); }` [download] the main processing loop of the service? holli, /regexed monk/	[reply] [d/l]
Re^3: Perl script as windows service by m-rau (Scribe) on Mar 02, 2005 at 09:11 UTC
Yes. Looks like. But I think he did not catch the Win32::Daemon idea. For this reason, I paste the following snippet. I tested it. It works fine on a win32 even though it does nothing!. Here, the runService method is the processor, called every five seconds. #!/usr/bin/perl $\| = 1; use strict; use Getopt::Long; use Win32; use Win32::Daemon; 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 ); } my %serviceConfig = ( name => 'mytest', display => 'mytest', description => 'this is my test description', machine => '', path => $^X, parameters => ( sprintf '"e:/dia/temp/service.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, 5000 ); } 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', $servic +eConfig { 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', $serviceC +onfig { 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) = @_; $context -> { last_state } = SERVICE_STOPPED; Win32::Daemon::State( SERVICE_STOP_PENDING, 30000 ); &debug( 'Stopping the service' ); Win32::Daemon::State( SERVICE_STOPPED ); Win32::Daemon::StopService(); } # ==================================================================== +========== 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) = @_; if ( Win32::Daemon::State() == SERVICE_RUNNING ) { # count the number of calls (I do not know why) $context -> { count }++; } } sub debug { my ($fmt, @data) = @_; my $message = sprintf $fmt, @data; open( FILE, ">>e:/dia/temp/service.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() ) ); } # ==================================================================== +========== __END__ [download]	[reply] [d/l]
Re^4: Perl script as windows service by rockets12345 (Novice) on Mar 09, 2005 at 20:30 UTC
Re^5: Perl script as windows service by m-rau (Scribe) on Mar 10, 2005 at 12:21 UTC
Re^4: Perl script as windows service by polettix (Vicar) on Oct 11, 2005 at 17:07 UTC
Re^4: Perl script as windows service by rockets12345 (Novice) on Mar 09, 2005 at 07:58 UTC
Re^5: Perl script as windows service by m-rau (Scribe) on Mar 09, 2005 at 13:17 UTC