如何停止以 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;
            }

我还没有测试过这个。请测试并提交错误报告。