如何停止以 Win32::Daemon 启动的 Win32 服务?
How to stop a Win32 service started with Win32::Daemon?
我可以使用以下脚本在 Windows 10(Strawberry perl 版本 5.30.1)上成功启动 Win32 服务:
package Win32::XYZService;
use feature qw(say);
use strict;
use warnings;
use File::Spec;
use Win32;
use Win32::Daemon;
{
die "Bad arguments" if @ARGV != 1;
my $action = shift @ARGV;
my $xyz = Win32::XYZService->new();
$xyz->action( $action );
}
sub new {
my ( $class, %args ) = @_;
$args{name} = 'xyz_service2';
my ($bin, $scriptname) = Win32::GetFullPathName( [=11=] );
$args{bin} = $bin;
$args{scriptname} = $scriptname;
$args{log_fn} = File::Spec->catfile( $bin, 'log.txt' );
$args{time_interval} = 2000; # callback timer interval in milliseconds
my $self = bless \%args, $class;
return $self;
}
sub action {
my ($self, $action) = @_;
if ($self->can($action)) {
return $self->$action();
}
else {
$self->log("Unknown command: $action");
$self->log("Valid commands are: create, start, stop, delete");
return undef;
}
}
sub start {
my ($self) = @_;
$self->log("starting service..");
system("net", "start", $self->{name});
}
sub stop {
my ($self) = @_;
$self->log("trying to stop service..");
system("net", "stop", $self->{name});
}
sub _scm_start {
my ($self) = @_;
Win32::Daemon::RegisterCallbacks( {
start => \&_callback_start,
timer => \&_callback_timer,
stop => \&_callback_stop,
pause => \&_callback_pause,
continue => \&_callback_continue,
} );
Win32::Daemon::StartService( $self, $self->{time_interval} );
}
sub _callback_continue {
my ( $event, $self) = @_;
$self->log("callback continue");
Win32::Daemon::State( SERVICE_RUNNING );
}
sub _callback_pause {
my ( $event, $self) = @_;
$self->log("callback pause");
Win32::Daemon::State( SERVICE_PAUSED );
}
sub _callback_stop {
my ( $event, $self) = @_;
$self->log("callback stop");
Win32::Daemon::State( SERVICE_STOPPED );
Win32::Daemon::StopService();
}
sub _callback_timer {
my ( $event, $self) = @_;
$self->log("callback timer");
}
sub _callback_start {
my ( $event, $self) = @_;
$self->log("callback start");
Win32::Daemon::State( SERVICE_RUNNING );
}
sub log {
my ($self, $msg) = @_;
chomp $msg;
open(my $fh, ">>", $self->{log_fn})
or warn("Can't append to log \"$self->{log_fn}\": $!\n"), return;
say $fh "[PID $$] [" . localtime . "] : $msg";
say $msg if -t STDIN;
}
sub delete {
my ($self) = @_;
if (Win32::Daemon::DeleteService("", $self->{name})) {
$self->log("Successfully removed service $self->{name}");
}
else {
$self->log("Failed to remove service: " . Win32::FormatMessage( Win32::Daemon::GetLastError()));
}
}
sub create {
my ($self) = @_;
my $service_path = $^X;
my $service_params = File::Spec->catfile($self->{bin}, $self->{scriptname});
$service_params .= ' _scm_start'; # Service control manager start
my %service_info = (
name => $self->{name},
display => 'xyz_display',
path => $service_path,
description => 'xyz_description',
parameters => $service_params,
service_type => SERVICE_WIN32_OWN_PROCESS,
start_type => SERVICE_AUTO_START
);
if (Win32::Daemon::CreateService( \%service_info)) {
$self->log("Successfully added service $service_info{name}");
}
else {
$self->log("Failed to add service: " . Win32::FormatMessage( Win32::Daemon::GetLastError()));
}
}
如果我以管理员身份从命令提示符 运行 此脚本:
>perl xyz_service.pl create
Successfully added service xyz_service2
>perl xyz_service.pl start
starting service..
The xyz_display service is starting.
The xyz_display service was started successfully.
>type log.txt
[PID 8844] [Wed Jul 1 11:33:05 2020] : Successfully added service xyz_service2
[PID 10552] [Wed Jul 1 11:33:42 2020] : starting service..
[PID 12076] [Wed Jul 1 11:33:42 2020] : callback start
[PID 12076] [Wed Jul 1 11:33:44 2020] : callback timer
[PID 12076] [Wed Jul 1 11:33:46 2020] : callback timer
[PID 12076] [Wed Jul 1 11:33:48 2020] : callback timer
[PID 12076] [Wed Jul 1 11:33:50 2020] : callback timer
[PID 12076] [Wed Jul 1 11:33:52 2020] : callback timer
[PID 12076] [Wed Jul 1 11:33:54 2020] : callback timer
>perl xyz_service.pl stop
stopping service..
The requested pause, continue, or stop is not valid for this service.
More help is available by typing NET HELPMSG 2191.
如何停止服务?
该模块应该使用 SetServiceStatus
向 Windows 发出它可以处理关闭事件的信号。在 Windows 的旧版本中也是如此。但是,它无法在 Windows 10(及更新版本)和 Windows Server 2016(及更新版本)中执行此操作。
此失败是由于 Demon.xs
中模块的 DllMain
中的 switch
statement 中缺少默认子句造成的。由于这个问题,gdwControlsAccepted
以不正确的值结束。
更正后的switch
:
switch( gsOSVerInfo.dwMajorVersion )
{
default:
// We have Windows Vista or newer
// The following constants only work on Vista and higher:
// SERVICE_ACCEPT_PRESHUTDOWN
//
#ifdef SERVICE_CONTROL_PRESHUTDOWN
gdwControlsAccepted |= SERVICE_ACCEPT_PRESHUTDOWN;
#endif // SERVICE_CONTROL_PRESHUTDOWN
case 5:
// We have Windows 2000 or XP
// The following constants only work on Win2k and higher:
// SERVICE_ACCEPT_PARAMCHANGE
// SERVICE_ACCEPT_NETBINDCHANGE
//
gdwControlsAccepted |= SERVICE_ACCEPT_PARAMCHANGE
| SERVICE_ACCEPT_NETBINDCHANGE;
case 4:
case 3:
case 2:
case 1:
case 0:
// NT 4.0
gdwControlsAccepted |= SERVICE_ACCEPT_STOP
| SERVICE_ACCEPT_PAUSE_CONTINUE
| SERVICE_ACCEPT_SHUTDOWN;
}
我还没有测试过这个。请测试并提交错误报告。
我可以使用以下脚本在 Windows 10(Strawberry perl 版本 5.30.1)上成功启动 Win32 服务:
package Win32::XYZService;
use feature qw(say);
use strict;
use warnings;
use File::Spec;
use Win32;
use Win32::Daemon;
{
die "Bad arguments" if @ARGV != 1;
my $action = shift @ARGV;
my $xyz = Win32::XYZService->new();
$xyz->action( $action );
}
sub new {
my ( $class, %args ) = @_;
$args{name} = 'xyz_service2';
my ($bin, $scriptname) = Win32::GetFullPathName( [=11=] );
$args{bin} = $bin;
$args{scriptname} = $scriptname;
$args{log_fn} = File::Spec->catfile( $bin, 'log.txt' );
$args{time_interval} = 2000; # callback timer interval in milliseconds
my $self = bless \%args, $class;
return $self;
}
sub action {
my ($self, $action) = @_;
if ($self->can($action)) {
return $self->$action();
}
else {
$self->log("Unknown command: $action");
$self->log("Valid commands are: create, start, stop, delete");
return undef;
}
}
sub start {
my ($self) = @_;
$self->log("starting service..");
system("net", "start", $self->{name});
}
sub stop {
my ($self) = @_;
$self->log("trying to stop service..");
system("net", "stop", $self->{name});
}
sub _scm_start {
my ($self) = @_;
Win32::Daemon::RegisterCallbacks( {
start => \&_callback_start,
timer => \&_callback_timer,
stop => \&_callback_stop,
pause => \&_callback_pause,
continue => \&_callback_continue,
} );
Win32::Daemon::StartService( $self, $self->{time_interval} );
}
sub _callback_continue {
my ( $event, $self) = @_;
$self->log("callback continue");
Win32::Daemon::State( SERVICE_RUNNING );
}
sub _callback_pause {
my ( $event, $self) = @_;
$self->log("callback pause");
Win32::Daemon::State( SERVICE_PAUSED );
}
sub _callback_stop {
my ( $event, $self) = @_;
$self->log("callback stop");
Win32::Daemon::State( SERVICE_STOPPED );
Win32::Daemon::StopService();
}
sub _callback_timer {
my ( $event, $self) = @_;
$self->log("callback timer");
}
sub _callback_start {
my ( $event, $self) = @_;
$self->log("callback start");
Win32::Daemon::State( SERVICE_RUNNING );
}
sub log {
my ($self, $msg) = @_;
chomp $msg;
open(my $fh, ">>", $self->{log_fn})
or warn("Can't append to log \"$self->{log_fn}\": $!\n"), return;
say $fh "[PID $$] [" . localtime . "] : $msg";
say $msg if -t STDIN;
}
sub delete {
my ($self) = @_;
if (Win32::Daemon::DeleteService("", $self->{name})) {
$self->log("Successfully removed service $self->{name}");
}
else {
$self->log("Failed to remove service: " . Win32::FormatMessage( Win32::Daemon::GetLastError()));
}
}
sub create {
my ($self) = @_;
my $service_path = $^X;
my $service_params = File::Spec->catfile($self->{bin}, $self->{scriptname});
$service_params .= ' _scm_start'; # Service control manager start
my %service_info = (
name => $self->{name},
display => 'xyz_display',
path => $service_path,
description => 'xyz_description',
parameters => $service_params,
service_type => SERVICE_WIN32_OWN_PROCESS,
start_type => SERVICE_AUTO_START
);
if (Win32::Daemon::CreateService( \%service_info)) {
$self->log("Successfully added service $service_info{name}");
}
else {
$self->log("Failed to add service: " . Win32::FormatMessage( Win32::Daemon::GetLastError()));
}
}
如果我以管理员身份从命令提示符 运行 此脚本:
>perl xyz_service.pl create
Successfully added service xyz_service2
>perl xyz_service.pl start
starting service..
The xyz_display service is starting.
The xyz_display service was started successfully.
>type log.txt
[PID 8844] [Wed Jul 1 11:33:05 2020] : Successfully added service xyz_service2
[PID 10552] [Wed Jul 1 11:33:42 2020] : starting service..
[PID 12076] [Wed Jul 1 11:33:42 2020] : callback start
[PID 12076] [Wed Jul 1 11:33:44 2020] : callback timer
[PID 12076] [Wed Jul 1 11:33:46 2020] : callback timer
[PID 12076] [Wed Jul 1 11:33:48 2020] : callback timer
[PID 12076] [Wed Jul 1 11:33:50 2020] : callback timer
[PID 12076] [Wed Jul 1 11:33:52 2020] : callback timer
[PID 12076] [Wed Jul 1 11:33:54 2020] : callback timer
>perl xyz_service.pl stop
stopping service..
The requested pause, continue, or stop is not valid for this service.
More help is available by typing NET HELPMSG 2191.
如何停止服务?
该模块应该使用 SetServiceStatus
向 Windows 发出它可以处理关闭事件的信号。在 Windows 的旧版本中也是如此。但是,它无法在 Windows 10(及更新版本)和 Windows Server 2016(及更新版本)中执行此操作。
此失败是由于 Demon.xs
中模块的 DllMain
中的 switch
statement 中缺少默认子句造成的。由于这个问题,gdwControlsAccepted
以不正确的值结束。
更正后的switch
:
switch( gsOSVerInfo.dwMajorVersion )
{
default:
// We have Windows Vista or newer
// The following constants only work on Vista and higher:
// SERVICE_ACCEPT_PRESHUTDOWN
//
#ifdef SERVICE_CONTROL_PRESHUTDOWN
gdwControlsAccepted |= SERVICE_ACCEPT_PRESHUTDOWN;
#endif // SERVICE_CONTROL_PRESHUTDOWN
case 5:
// We have Windows 2000 or XP
// The following constants only work on Win2k and higher:
// SERVICE_ACCEPT_PARAMCHANGE
// SERVICE_ACCEPT_NETBINDCHANGE
//
gdwControlsAccepted |= SERVICE_ACCEPT_PARAMCHANGE
| SERVICE_ACCEPT_NETBINDCHANGE;
case 4:
case 3:
case 2:
case 1:
case 0:
// NT 4.0
gdwControlsAccepted |= SERVICE_ACCEPT_STOP
| SERVICE_ACCEPT_PAUSE_CONTINUE
| SERVICE_ACCEPT_SHUTDOWN;
}
我还没有测试过这个。请测试并提交错误报告。